NetNews Usenet Archive 1992 #16

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / gnu / emacs / sources / 564 < prev next >

Wrap

Text File | 1992-07-29 | 38.1 KB | 1,168 lines

Newsgroups: gnu.emacs.sources Path: sparky!uunet!cis.ohio-state.edu!d0sb10.fnal.gov!SNYDER From: SNYDER@d0sb10.fnal.gov (scott snyder) Subject: better subprocess support for vms emacs (3/4) Message-ID: <920730000116.28a0007c@D0SB10.FNAL.GOV> Sender: daemon@cis.ohio-state.edu Organization: Source only Discussion and requests in gnu.emacs.help. Distribution: gnu Date: Wed, 29 Jul 1992 19:01:16 GMT Lines: 1156 -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ V 1992 X*************** X*** 56,59 **** X--- 56,61 ---- X sys_errlist,- X sys_nerr,- X environ X+ ! if you don't have multinet, comment out the following line. X+ multinet:multinet_socket_library/share X sys$library:vaxcrtl/library X*** vmsfns.c`09Tue Feb 25 11:59:28 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Dvmsfns.c`09Mon May 18 22:52 V:08 1992 X*************** X*** 188,208 **** X static void write_to_mbx ();`09/* Writes message to string */ X static void start_mbx_input ();`09/* Queues I/O request to mailbox */ X `20 X- static int input_mbx_chan = 0;`09/* Channel to read subprocess input on */ X- static char input_mbx_name`5B20`5D; X- `09`09`09`09/* Storage for mailbox device name */ X- static struct dsc$descriptor_s input_mbx_dsc; X- `09`09`09`09/* Descriptor for mailbox device name */ X- static struct process_list * process_list = 0; X- `09`09`09`09/* Linked list of subprocesses */ X- static char mbx_buffer`5BMSGSIZE`5D; X- `09`09`09`09/* Buffer to read from subprocesses */ X- static struct mbx_iosb input_iosb; X- `09`09`09`09/* IO status block for mailbox reads */ X-`20 X- int have_process_input,`09`09/* Non-zero iff subprocess input pending */ X- process_exited;`09`09/* Non-zero iff suprocess exit pending */ X-`20 X /* List of privilege names and mask offsets */ X static struct privilege_list priv_list`5B`5D = `7B X `20 X--- 188,193 ---- X*************** X*** 277,591 **** X `7B "PROCLIST",`09vms_proclist `7D,`09/* Returns list of all PIDs on s Vystem */ X `7D; X `20 X- Lisp_Object Qdefault_subproc_input_handler; X-`20 X- extern int process_ef;`09`09/* Event flag for subprocess operations */ X-`20 X- DEFUN ("default-subprocess-input-handler", X- Fdefault_subproc_input_handler, Sdefault_subproc_input_handler, X- 2, 2, 0, X- "Default input handler for input from spawned subprocesses.") X- (name, input) X- Lisp_Object name, input; X- `7B X- /* Just insert in current buffer */ X- insert (XSTRING (input)->data, XSTRING (input)->size); X- insert ("\n", 1); X- `7D X-`20 X- DEFUN ("spawn-subprocess", Fspawn_subprocess, Sspawn_subprocess, 1, 3, 0, X- "Spawns an asynchronous VMS suprocess for command processing.") X- (name, input_handler, exit_handler) X- Lisp_Object name, input_handler, exit_handler; X- `7B X- int status; X- char output_mbx_name`5B20`5D; X- struct dsc$descriptor_s output_mbx_dsc; X- struct process_list *ptr, *p, *prev; X- static int dummy = CLI$M_NOWAIT; X-`20 X- CHECK_NUMBER (name, 0); X- if (! input_mbx_chan) X- `7B X- if (! create_mbx (&input_mbx_dsc, input_mbx_name, &input_mbx_chan, 1 V)) X- `09return Qnil; X- start_mbx_input (); X- `7D X- ptr = 0; X- prev = 0; X- while (ptr) X- `7B X- struct process_list *next = ptr->next; X- if (ptr->name == XFASTINT (name))`20 X- `09`7B X- `09 if (ptr->process_active) X- `09 return Qt; X-`20 X- `09 /* Delete this process and run its exit handler. */ X- `09 if (prev) X- `09 prev->next = next; X- `09 else X- `09 process_list = next; X- `09 if (! NULL (ptr->exit_handler)) X- `09 Feval (Fcons (ptr->exit_handler, Fcons (make_number (ptr->name), X- `09`09`09`09`09`09 Qnil))); X- `09 sys$dassgn (ptr->mbx_chan); X- `09 break; X- `09`7D X- else X- `09prev = ptr; X- ptr = next; X- `7D X- if (! ptr) X- ptr = (struct process_list *) xmalloc (sizeof (struct process_list)); X-`20 X- if (! create_mbx (&output_mbx_dsc, output_mbx_name, &ptr->mbx_chan, 2)) X- `7B X- free (ptr); X- return Qnil; X- `7D X- if (NULL (input_handler)) X- input_handler = Qdefault_subproc_input_handler; X- ptr->input_handler = input_handler; X- ptr->exit_handler = exit_handler; X- message ("Creating subprocess..."); X- status = lib$spawn (0, &output_mbx_dsc, &input_mbx_dsc, &dummy, 0, X- &ptr->process_id, 0, 0, exit_ast, &ptr->process_acti Vve); X- if (! (status & 1)) X- `7B X- sys$dassgn (ptr->mbx_chan); X- free (ptr); X- error ("Unable to spawn subprocess"); X- return Qnil; X- `7D X- ptr->name = XFASTINT (name); X- ptr->next = process_list; X- ptr->process_active = 1; X- process_list = ptr; X- message ("Creating subprocess...done"); X- return Qt; X- `7D X-`20 X- static void X- mbx_msg (ptr, msg) X- struct process_list *ptr; X- char *msg; X- `7B X- write_to_mbx (ptr, msg, strlen (msg)); X- `7D X-`20 X- DEFUN ("send-command-to-subprocess", X- Fsend_command_to_subprocess, Ssend_command_to_subprocess, 2, 2, X- "sSend command to subprocess: \nsSend subprocess %s command: ", X- "Send to VMS subprocess named NAME the string COMMAND.") X- (name, command) X- Lisp_Object name, command; X- `7B X- struct process_list * ptr; X-`20 X- CHECK_NUMBER (name, 0); X- CHECK_STRING (command, 1); X- for (ptr = process_list; ptr; ptr = ptr->next) X- if (XFASTINT (name) == ptr->name) X- `7B X- `09write_to_mbx (ptr, XSTRING (command)->data, X- `09`09 XSTRING (command)->size); X- `09return Qt; X- `7D X- return Qnil; X- `7D X-`20 X- DEFUN ("stop-subprocess", Fstop_subprocess, Sstop_subprocess, 1, 1, X- "sStop subprocess: ", "Stop VMS subprocess named NAME.") X- (name) X- Lisp_Object name; X- `7B X- struct process_list * ptr; X-`20 X- CHECK_NUMBER (name, 0); X- for (ptr = process_list; ptr; ptr = ptr->next) X- if (XFASTINT (name) == ptr->name) X- `7B X- `09ptr->exit_handler = Qnil; X- `09if (sys$delprc (&ptr->process_id, 0) & 1) X- `09 ptr->process_active = 0; X- `09return Qt; X- `7D X- return Qnil; X- `7D X-`20 X- static int X- exit_ast (active) X- int * active; X- `7B X- process_exited = 1; X- *active = 0; X- sys$setef (process_ef); X- `7D X-`20 X- /* Process to handle input on the input mailbox. X- * Searches through the list of processes until the matching PID is found, X- * then calls its input handler. X- */ X-`20 X- process_command_input () X- `7B X- struct process_list * ptr; X- char * msg; X- int msglen; X- Lisp_Object expr; X-`20 X- msg = mbx_buffer; X- msglen = input_iosb.size; X- /* Hack around VMS oddity of sending extraneous CR/LF characters for X- * some of the commands (but not most). X- */ X- if (msglen > 0 && *msg == '\r') X- `7B X- msg++; X- msglen--; X- `7D X- if (msglen > 0 && msg`5Bmsglen - 1`5D == '\n') X- msglen--; X- if (msglen > 0 && msg`5Bmsglen - 1`5D == '\r') X- msglen--; X- /* Search for the subprocess in the linked list. X- */ X- expr = Qnil; X- for (ptr = process_list; ptr; ptr = ptr->next) X- if (ptr->process_id == input_iosb.pid) X- `7B X- `09expr = Fcons (ptr->input_handler, X- `09`09 Fcons (make_number (ptr->name), X- `09`09`09 Fcons (make_string (msg, msglen), X- `09`09`09`09 Qnil))); X- `09break; X- `7D X- have_process_input = 0; X- start_mbx_input (); X- clear_waiting_for_input (); /* Otherwise Ctl-g will cause crash. JCB V */ X- if (! NULL (expr)) X- Feval (expr); X- `7D X-`20 X- /* Searches process list for any processes which have exited. Calls their X- * exit handlers and removes them from the process list. X- */ X-`20 X- process_exit () X- `7B X- struct process_list * ptr, * prev, * next; X-`20 X- process_exited = 0; X- prev = 0; X- ptr = process_list; X- while (ptr) X- `7B X- next = ptr->next; X- if (! ptr->process_active) X- `09`7B X- `09 if (prev) X- `09 prev->next = next; X- `09 else X- `09 process_list = next; X- `09 if (! NULL (ptr->exit_handler)) X- `09 Feval (Fcons (ptr->exit_handler, Fcons (make_number (ptr->name), X- `09`09`09`09`09`09 Qnil))); X- `09 sys$dassgn (ptr->mbx_chan); X- `09 free (ptr); X- `09`7D X- else X- `09prev = ptr; X- ptr = next; X- `7D X- `7D X-`20 X- /* Called at emacs exit. X- */ X-`20 X- kill_vms_processes () X- `7B X- struct process_list * ptr; X-`20 X- for (ptr = process_list; ptr; ptr = ptr->next) X- if (ptr->process_active) X- `7B X- `09sys$dassgn (ptr->mbx_chan); X- `09sys$delprc (&ptr->process_id, 0); X- `7D X- sys$dassgn (input_mbx_chan); X- process_list = 0; X- input_mbx_chan = 0; X- `7D X-`20 X- /* Creates a temporary mailbox and retrieves its device name in 'buf'. X- * Makes the descriptor pointed to by 'dsc' refer to this device. X- * 'buffer_factor' is used to allow sending messages asynchronously X- * till some point. X- */ X-`20 X- static int X- create_mbx (dsc, buf, chan, buffer_factor) X- struct dsc$descriptor_s *dsc; X- char *buf; X- int *chan; X- int buffer_factor; X- `7B X- int strval`5B2`5D; X- int status; X- static int dummy = DVI$_DEVNAM; X-`20 X- status = sys$crembx (0, chan, MSGSIZE, MSGSIZE * buffer_factor, 0, 0, 0) V; X- if (! (status & 1)) X- `7B X- message ("Unable to create mailbox. Need TMPMBX privilege."); X- return 0; X- `7D X- strval`5B0`5D = 16; X- strval`5B1`5D = (int) buf; X- status = lib$getdvi (&dummy, chan, 0, 0, strval, X- `09`09 &dsc->dsc$w_length); X- if (! (status & 1)) X- return 0; X- dsc->dsc$b_dtype = DSC$K_DTYPE_T; X- dsc->dsc$b_class = DSC$K_CLASS_S; X- dsc->dsc$a_pointer = buf; X- return 1; X- `7D`09`09`09`09/* create_mbx */ X-`20 X- /* AST routine to be called upon receiving mailbox input. X- * Sets flag telling keyboard routines that input is available. X- */ X-`20 X- static int X- mbx_input_ast () X- `7B X- have_process_input = 1; X- `7D X-`20 X- /* Issue a QIO request on the input mailbox. X- */ X- static void X- start_mbx_input () X- `7B X- sys$qio (process_ef, input_mbx_chan, IO$_READVBLK, &input_iosb, X- mbx_input_ast, 0, mbx_buffer, sizeof (mbx_buffer), X- `09 0, 0, 0, 0); X- `7D X-`20 X- /* Send a message to the subprocess input mailbox, without blocking if X- * possible. X- */ X- static void X- write_to_mbx (ptr, buf, len) X- struct process_list *ptr; X- char *buf; X- int len; X- `7B X- sys$qiow (0, ptr->mbx_chan, IO$_WRITEVBLK `7C IO$M_NOW, &ptr->iosb, X- `09 0, 0, buf, len, 0, 0, 0, 0); X- `7D X-`20 X DEFUN ("setprv", Fsetprv, Ssetprv, 1, 3, 0, X "Set or reset a VMS privilege. First arg is privilege name.\n\ X Second arg is t or nil, indicating whether the privilege is to be\n\ X--- 262,267 ---- X*************** X*** 699,706 **** X static int dummy = JPI$_PID; X `20 X if (NULL (pid) X! `7C`7C XTYPE (pid) == Lisp_String && XSTRING (pid)->size == 0 X! `7C`7C XTYPE (pid) == Lisp_Int && XFASTINT (pid) == 0) X `7B X code = owner ? JPI$_OWNER : JPI$_PID; X status = lib$getjpi (&code, 0, 0, &id); X--- 375,382 ---- X static int dummy = JPI$_PID; X `20 X if (NULL (pid) X! `7C`7C (XTYPE (pid) == Lisp_String && XSTRING (pid)->size == 0) X! `7C`7C (XTYPE (pid) == Lisp_Int && XFASTINT (pid) == 0)) X `7B X code = owner ? JPI$_OWNER : JPI$_PID; X status = lib$getjpi (&code, 0, 0, &id); X*************** X*** 960,982 **** X `0C X init_vmsfns () X `7B X- process_list = 0; X- input_mbx_chan = 0; X `7D X `20 X syms_of_vmsfns () X `7B X- defsubr (&Sdefault_subproc_input_handler); X- defsubr (&Sspawn_subprocess); X- defsubr (&Ssend_command_to_subprocess); X- defsubr (&Sstop_subprocess); X defsubr (&Ssetprv); X #ifdef VMS4_4 X defsubr (&Svms_system_info); X defsubr (&Sshrink_to_icon); X #endif /* VMS4_4 */ X- Qdefault_subproc_input_handler = intern ("default-subprocess-input-handl Ver"); X- staticpro (&Qdefault_subproc_input_handler); X `7D X #endif /* VMS */ X `20 X--- 636,650 ---- X*** vmsmap.c`09Tue Feb 25 11:59:28 1992 X--- sb12:`5Bscratch.snyder.gnu.emacs-18_58.src`5Dvmsmap.c`09Mon May 18 22:52 V:08 1992 X*************** X*** 136,141 **** X--- 136,147 ---- X `09`09 fab.fab$l_stv, 0, map_data.datablk, 0, 0); X if (! (status & 1)) X lib$stop (status); X+`20 X+ /* lose stale cached environment data */ X+ `7B X+ extern char **my_environ; X+ my_environ = 0; X+ `7D X `7D X `20 X /* Writes the data and alloc area to the map file. $ CALL UNPACK SRC.DIFFS;2 762974686 $ create 'f' X*** compile.el`09Thu Jun 25 05:41:28 1992 X--- compile.el`09Thu Jul 2 10:43:12 1992 X*************** X*** 80,95 **** X (compilation-forget-errors) X (setq compilation-error-list t) X (setq compilation-error-message error-message) X! (setq compilation-process X! `09(start-process "compilation" "*compilation*" X! `09`09 shell-file-name X! `09`09 "-c" (concat "exec " command))) X! (with-output-to-temp-buffer "*compilation*" X! (princ "cd ") X! (princ default-directory) X! (terpri) X! (princ command) X! (terpri)) X (set-process-sentinel compilation-process 'compilation-sentinel) X (let* ((thisdir default-directory) X `09 (outbuf (process-buffer compilation-process)) X--- 80,114 ---- X (compilation-forget-errors) X (setq compilation-error-list t) X (setq compilation-error-message error-message) X!`20 X! (if (eq system-type 'vax-vms) X! (progn X! `09(let ((process-connection-type nil)) X! `09 (setq compilation-process X! `09`09(start-process "compilation" "*compilation*" ""))) X! `09(with-output-to-temp-buffer "*compilation*" X! `09 (princ "$ set default ") X! `09 (princ default-directory) X! `09 (terpri) X! `09 (princ "$ ") X! `09 (princ command) X! `09 (terpri)) X! `09(process-send-string compilation-process X! `09`09`09 (concat "set default " default-directory)) X! `09(process-send-string compilation-process command) X! `09(process-send-string compilation-process "eoj")) X!`20 X! (setq compilation-process X! `09 (start-process "compilation" "*compilation*" X! `09`09`09 shell-file-name X! `09`09`09 "-c" (concat "exec " command))) X! (with-output-to-temp-buffer "*compilation*" X! (princ "cd ") X! (princ default-directory) X! (terpri) X! (princ command) X! (terpri))) X!`20 X (set-process-sentinel compilation-process 'compilation-sentinel) X (let* ((thisdir default-directory) X `09 (outbuf (process-buffer compilation-process)) X*************** X*** 152,164 **** X "Kill the process made by the \\`5Bcompile`5D command." X (interactive) X (if compilation-process X! (interrupt-process compilation-process))) X `20 X (defun kill-grep () X "Kill the process made by the \\`5Bgrep`5D command." X (interactive) X (if compilation-process X! (interrupt-process compilation-process))) X `20 X (defun next-error (&optional argp) X "Visit next compilation error message and corresponding source code. X--- 171,187 ---- X "Kill the process made by the \\`5Bcompile`5D command." X (interactive) X (if compilation-process X! (if (eq system-type 'vax-vms) X! `09 (kill-process compilation-process) X! `09(interrupt-process compilation-process)))) X `20 X (defun kill-grep () X "Kill the process made by the \\`5Bgrep`5D command." X (interactive) X (if compilation-process X! (if (eq system-type 'vax-vms) X! `09 (kill-process compilation-process) X! `09(interrupt-process compilation-process)))) X `20 X (defun next-error (&optional argp) X "Visit next compilation error message and corresponding source code. X*** lpr.el`09Thu Jun 25 05:41:38 1992 X--- lpr.el`09Thu Jul 2 11:02:00 1992 X*************** X*** 21,28 **** X ;(defconst lpr-switches nil X ; "*List of strings to pass as extra switch args to lpr when it is invoke Vd.") X `20 X! (defvar lpr-command (if (eq system-type 'usg-unix-v) X! `09`09`09"lp" "lpr") X "Shell command for printing a file") X `20 X (defun lpr-buffer () X--- 21,29 ---- X ;(defconst lpr-switches nil X ; "*List of strings to pass as extra switch args to lpr when it is invoke Vd.") X `20 X! (defvar lpr-command (cond ((eq system-type 'usg-unix-v) "lp") X! `09`09`09 ((eq system-type 'vax-vms) "print/delete") X! `09`09`09 (t "lpr")) X "Shell command for printing a file") X `20 X (defun lpr-buffer () X*************** X*** 62,71 **** X `09 (setq tab-width width) X `09 (untabify (point-min) (point-max)) X `09 (setq start (point-min) end (point-max)))) X! (apply 'call-process-region X! `09 (nconc (list start end lpr-command X! `09`09`09 nil nil nil) X! `09`09 (nconc (and (eq system-type 'berkeley-unix) X! `09`09`09 (list "-J" name "-T" name)) X! `09`09`09 switches))) X (message "Spooling...done")))) X--- 63,80 ---- X `09 (setq tab-width width) X `09 (untabify (point-min) (point-max)) X `09 (setq start (point-min) end (point-max)))) X! (if (eq system-type 'vax-vms) X! `09 (progn X! `09 (write-region start end "sys$scratch:emacs_print.tmp") X! `09 (call-process lpr-command X! `09`09`09 nil nil nil (concat "sys$scratch:emacs_print.tmp " X! `09`09`09`09`09 (if switches X! `09`09`09`09`09`09 switches X! `09`09`09`09`09`09"")))) X! (apply 'call-process-region X! `09 (nconc (list start end lpr-command X! `09`09`09 nil nil nil) X! `09`09 (nconc (and (eq system-type 'berkeley-unix) X! `09`09`09`09 (list "-J" name "-T" name)) X! `09`09`09 switches)))) X (message "Spooling...done")))) X*** shell.el`09Thu Jun 25 05:41:48 1992 X--- shell.el`09Thu Jul 2 10:01:30 1992 X*************** X*** 154,171 **** X (if (memq status '(run stop)) X `09 nil X `09(if proc (delete-process proc)) X! `09(setq proc (apply 'start-process name buffer X! `09`09`09 (concat exec-directory "env") X! `09`09`09 (format "TERMCAP=emacs:co#%d:tc=unknown:" X! `09`09`09`09 (screen-width)) X! `09`09`09 "TERM=emacs" X! `09`09`09 "EMACS=t" X! `09`09`09 "-" X! `09`09`09 (or program explicit-shell-file-name X! `09`09`09 (getenv "ESHELL") X! `09`09`09 (getenv "SHELL") X! `09`09`09 "/bin/sh") X! `09`09`09 switches)) X `09(cond (startfile X `09 ;;This is guaranteed to wait long enough X `09 ;;but has bad results if the shell does not prompt at all X--- 154,175 ---- X (if (memq status '(run stop)) X `09 nil X `09(if proc (delete-process proc)) X! `09(if (not (eq system-type 'vax-vms)) X! `09 (setq proc (apply 'start-process name buffer X! `09`09`09 (concat exec-directory "env") X! `09`09`09 (format "TERMCAP=emacs:co#%d:tc=unknown:" X! `09`09`09`09 (screen-width)) X! `09`09`09 "TERM=emacs" X! `09`09`09 "EMACS=t" X! `09`09`09 "-" X! `09`09`09 (or program explicit-shell-file-name X! `09`09`09`09 (getenv "ESHELL") X! `09`09`09`09 (getenv "SHELL") X! `09`09`09`09 "/bin/sh") X! `09`09`09 switches)) X! `09 (setq proc (apply 'start-process name buffer program switches)) X! `09 (if (not process-connection-type) X! `09 (process-send-string proc "on severe_error then continue"))) X `09(cond (startfile X `09 ;;This is guaranteed to wait long enough X `09 ;;but has bad results if the shell does not prompt at all X*************** X*** 271,277 **** X `09`09(cd (getenv "HOME"))) X `09 ((memq (char-after (match-end 0)) '(?\ ?\t)) X `09`09(let (dir) X! `09`09 (forward-char 3) X `09`09 (skip-chars-forward " \t") X `09`09 (if (file-directory-p X `09`09`09(setq dir X--- 275,283 ---- X `09`09(cd (getenv "HOME"))) X `09 ((memq (char-after (match-end 0)) '(?\ ?\t)) X `09`09(let (dir) X! `09`09 (if (eq system-type 'vax-vms) X! `09`09 (goto-char (match-end 0)) X! `09`09 (forward-char 3)) X `09`09 (skip-chars-forward " \t") X `09`09 (if (file-directory-p X `09`09`09(setq dir X*** telnet.el`09Mon May 18 22:50:01 1992 X--- telnet.el`09Mon Jun 29 00:03:46 1992 X*************** X*** 78,84 **** X `20 X (defun telnet-initial-filter (proc string) X ;For reading up to and including password; also will get machine type. X! (cond ((string-match "No such host" string) X `09 (kill-buffer (process-buffer proc)) X `09 (error "No such host.")) X `09((string-match "passw" string) X--- 78,85 ---- X `20 X (defun telnet-initial-filter (proc string) X ;For reading up to and including password; also will get machine type. X! (cond ((or (string-match "No such host" string) X! `09 (string-match "?Unknown INTERNET host" string)) X `09 (kill-buffer (process-buffer proc)) X `09 (error "No such host.")) X `09((string-match "passw" string) X*************** X*** 156,165 **** X (interactive "sOpen telnet connection to host: ") X (require 'shell) X (let ((name (concat arg "-telnet" ))) X! (switch-to-buffer (make-shell name "telnet")) X (set-process-filter (get-process name) 'telnet-initial-filter) X (erase-buffer) X! (send-string name (concat "open " arg "\n")) X (telnet-mode) X (setq telnet-count -16))) X `20 X--- 157,169 ---- X (interactive "sOpen telnet connection to host: ") X (require 'shell) X (let ((name (concat arg "-telnet" ))) X! (if (eq system-type 'vax-vms) X! `09(switch-to-buffer (make-shell name "telnet" nil arg)) X! (switch-to-buffer (make-shell name "telnet"))) X (set-process-filter (get-process name) 'telnet-initial-filter) X (erase-buffer) X! (if (not (eq system-type 'vax-vms)) X! `09(send-string name (concat "open " arg "\n"))) X (telnet-mode) X (setq telnet-count -16))) X `20 X*** version.el`09Mon May 18 22:50:05 1992 X--- version.el`09Thu Jun 25 04:34:05 1992 X*************** X*** 33,39 **** X (interactive) X (if (interactive-p) X (message "%s" (emacs-version)) X! (format "GNU Emacs %s of %s %s on %s (%s)" X `09 emacs-version X `09 (substring emacs-build-time 0 X `09`09 (string-match " *`5B0-9`5D*:" emacs-build-time)) X--- 33,39 ---- X (interactive) X (if (interactive-p) X (message "%s" (emacs-version)) X! (format "GNU Emacs %s of %s %s on %s (%s) (sss hacked version)" X `09 emacs-version X `09 (substring emacs-build-time 0 X `09`09 (string-match " *`5B0-9`5D*:" emacs-build-time)) X*** vms-patch.el`09Mon May 18 22:50:06 1992 X--- vms-patch.el`09Wed Jun 24 13:29:45 1992 X*************** X*** 82,84 **** X--- 82,98 ---- X nil) X `20 X (setq suspend-hook 'vms-suspend-hook) X+`20 X+ ;;; variable settings to get shell mode to work X+`20 X+ (setq explicit-shell-file-name "") X+ (setq shell-cd-regexp X+ "cd\\`7Csd\\`7Cset +\$default\\`7Cdefaul\\`7Cdefau\\`7Cdefa\\`7Cdef V\$") X+ (setq explicit--args '("")) X+ (setq shell-prompt-pattern "\\$") X+`20 X+ ;;; additional automodes for vms X+`20 X+ (setq auto-mode-alist X+ (cons '("\\.for$" . fortran-mode) auto-mode-alist)) X+`20 $ CALL UNPACK LISP.DIFFS;8 958870403 $ create 'f' X/* X * s-vms5-4.h X */ X X#include "s-vms.h" X#define VMS5_4 X#define VMS4_4 X X#define HAVE_VMS_PTYS $ CALL UNPACK S-VMS5-4.H;1 591162484 $ create 'f' X;;; Missing: P command, sorting, setting file modes. X;;; Dired buffer containing multiple directories gets totally confused X;;; Implement insertion of subdirectories in situ --- tree dired X;;; Added `5B22-Oct-88`5D: support for VAX VMS X X;; DIRED commands for Emacs X;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. X X;; This file is part of GNU Emacs. X X;; GNU Emacs is distributed in the hope that it will be useful, X;; but WITHOUT ANY WARRANTY. No author or distributor X;; accepts responsibility to anyone for the consequences of using it X;; or for whether it serves any particular purpose or works at all, X;; unless he says so in writing. Refer to the GNU Emacs General Public X;; License for full details. X X;; Everyone is granted permission to copy, modify and redistribute X;; GNU Emacs, but only under the conditions described in the X;; GNU Emacs General Public License. A copy of this license is X;; supposed to have been given to you along with GNU Emacs so you X;; can know your rights and responsibilities. It should be in a X;; file named COPYING. Among other things, the copyright notice X;; and this notice must be preserved on all copies. X X X;In loaddefs.el X;(defvar dired-listing-switches "-al" X; "Switches passed to ls for dired. MUST contain the 'l' option. X;CANNOT contain the 'F' option.") X X(defvar dired-directory-command X "DIRECTORY/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)" X "Directory command for dired") X X(if (eq system-type 'vax-vms) X (setq dired-listing-switches "")) X X(defun dired-readin (dirname buffer) X (save-excursion X (message "Reading directory %s..." dirname) X (set-buffer buffer) X (let ((buffer-read-only nil)) X (widen) X (erase-buffer) X`09 (dired-read-directory dirname buffer) X (goto-char (point-min)) X (while (not (eobp)) X`09(insert " ") X`09(forward-line 1)) X (goto-char (point-min))) X (message "Reading directory %s...done" dirname))) X X(defun dired-read-directory (dirname buffer) X (if (eq system-type 'vax-vms) X (progn X;`09(subprocess-command-to-buffer (concat X;`09`09`09`09 dired-directory-command " " X;`09`09`09`09 dirname) buffer) X`09(call-process dired-directory-command nil buffer nil dirname) X`09(save-excursion X`09 (replace-regexp " *$" ""))) X ;; otherwise UNIX style X (setq dirname (expand-file-name dirname)) X (if (file-directory-p dirname) X`09(call-process "ls" nil buffer nil X`09`09 dired-listing-switches dirname) X (let ((default-directory (file-name-directory dirname))) X`09(call-process shell-file-name nil buffer nil X`09`09 "-c" (concat "ls " dired-listing-switches " " X`09`09`09`09 (file-name-nondirectory dirname)))))) X ) X X(defun dired-find-buffer (dirname) X (let ((blist (buffer-list)) X`09found) X (while blist X (save-excursion X (set-buffer (car blist)) X`09(if (and (eq major-mode 'dired-mode) X`09`09 (equal dired-directory dirname)) X`09 (setq found (car blist) X`09`09 blist nil) X`09 (setq blist (cdr blist))))) X (or found X`09(create-file-buffer (directory-file-name dirname))))) X X(defun dired (dirname) X "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. XDired displays a list of files in DIRNAME. XYou can move around in it with the usual commands. XYou can flag files for deletion with C-d Xand then delete them by typing `60x'. XType `60h' after entering dired for more info." X (interactive (list (read-file-name "Dired (directory): " X`09`09`09`09 nil default-directory nil))) X (switch-to-buffer (dired-noselect dirname))) X X(defun dired-other-window (dirname) X "\"Edit\" directory DIRNAME. Like M-x dired but selects in another window V." X (interactive (list (read-file-name "Dired in other window (directory): " X`09`09`09`09 nil default-directory nil))) X (switch-to-buffer-other-window (dired-noselect dirname))) X X(defun dired-noselect (dirname) X "Like M-x dired but returns the dired buffer as value, does not select it. V" X;;; (or dirname (setq dirname default-directory)) X;;; (setq dirname (expand-file-name (directory-file-name dirname))) X;;; (if (file-directory-p dirname) X;;; (setq dirname (file-name-as-directory dirname))) X (setq dirname (dired-fix-directory dirname)) X (let ((buffer (dired-find-buffer dirname))) X (save-excursion X (set-buffer buffer) X (dired-readin dirname buffer) X (dired-move-to-filename) X (dired-mode dirname)) X buffer)) X X(defun dired-fix-directory (dirname) X "Fix up dirname to be a valid directory name and return it" X (or dirname (setq dirname default-directory)) X (if (eq system-type 'vax-vms) X (progn X`09(or dirname (setq dirname default-directory)) X`09(setq dirname (expand-file-name dirname))) X ;; else UNIX style X (if (string-match "./$" dirname) X`09(setq dirname (substring dirname 0 -1))) X (setq dirname (expand-file-name dirname)) X (and (not (string-match "/$" dirname)) X`09 (file-directory-p dirname) X`09 (setq dirname (concat dirname "/"))) X dirname X )) X X(defun dired-revert (&optional arg noconfirm) X (let ((opoint (point)) X`09(ofile (dired-get-filename t t)) X`09(buffer-read-only nil)) X (erase-buffer) X (dired-readin dired-directory (current-buffer)) X (or (and ofile (re-search-forward (concat " " (regexp-quote ofile) "$") X`09`09`09`09 nil t)) X`09(goto-char opoint)) X (beginning-of-line))) X X(defvar dired-match-date X `09 "\$Jan\\`7CFeb\\`7CMar\\`7CApr\\`7CMay\\`7CJun\\`7CJul\\`7CAug\\`7CS Vep\\`7COct\\`7CNov\\`7CDec\$`5B `5D+`5B0-9`5D+" X`09 "Regexp to match the date on a filename") X X(defvar dired-mode-map nil "Local keymap for dired-mode buffers.") X(if dired-mode-map X nil X (setq dired-mode-map (make-keymap)) X (suppress-keymap dired-mode-map) X (define-key dired-mode-map "r" 'dired-rename-file) X (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted) X (define-key dired-mode-map "d" 'dired-flag-file-deleted) X (define-key dired-mode-map "v" 'dired-view-file) X (define-key dired-mode-map "e" 'dired-find-file) X (define-key dired-mode-map "f" 'dired-find-file) X (define-key dired-mode-map "o" 'dired-find-file-other-window) X (define-key dired-mode-map "u" 'dired-unflag) X (define-key dired-mode-map "x" 'dired-do-deletions) X (define-key dired-mode-map "\177" 'dired-backup-unflag) X (define-key dired-mode-map "?" 'dired-summary) X (define-key dired-mode-map "c" 'dired-copy-file) X (define-key dired-mode-map "#" 'dired-flag-auto-save-files) X (define-key dired-mode-map "`7E" 'dired-flag-backup-files) X (define-key dired-mode-map "." 'dired-clean-directory) X (define-key dired-mode-map "h" 'describe-mode) X (define-key dired-mode-map " " 'dired-next-line) X (define-key dired-mode-map "\C-n" 'dired-next-line) X (define-key dired-mode-map "\C-p" 'dired-previous-line) X (define-key dired-mode-map "n" 'dired-next-line) X (define-key dired-mode-map "p" 'dired-previous-line) X (define-key dired-mode-map "g" 'revert-buffer) X (define-key dired-mode-map "C" 'dired-compress) X (define-key dired-mode-map "U" 'dired-uncompress) X (define-key dired-mode-map "B" 'dired-byte-recompile) X (define-key dired-mode-map "M" 'dired-chmod) X (define-key dired-mode-map "G" 'dired-chgrp) X (define-key dired-mode-map "O" 'dired-chown)) X X X;; Dired mode is suitable only for specially formatted data. X(put 'dired-mode 'mode-class 'special) X X(defun dired-mode (&optional dirname) X "Mode for \"editing\" directory listings. XIn dired, you are \"editing\" a list of the files in a directory. XYou can move using the usual cursor motion commands. XLetters no longer insert themselves. XInstead, type d to flag a file for Deletion. XType u to Unflag a file (remove its D flag). X Type Rubout to back up one line and unflag. XType x to eXecute the deletions requested. XType f to Find the current line's file X (or Dired it, if it is a directory). XType o to find file or dired directory in Other window. XType # to flag temporary files (names beginning with #) for Deletion. XType `7E to flag backup files (names ending with `7E) for Deletion. XType . to flag numerical backups for Deletion. X (Spares dired-kept-versions or its numeric argument.) XType r to rename a file. XType c to copy a file. XType v to view a file in View mode, returning to Dired when done. XType g to read the directory again. This discards all deletion-flags. XSpace and Rubout can be used to move down and up by lines. XAlso: C -- compress this file. U -- uncompress this file. X B -- byte compile this file. X M, G, O -- change file's mode, group or owner. X\\`7Bdired-mode-map`7D" X (interactive) X (kill-all-local-variables) X (make-local-variable 'revert-buffer-function) X (setq revert-buffer-function 'dired-revert) X (setq major-mode 'dired-mode) X (setq mode-name "Dired") X (make-local-variable 'dired-directory) X (setq dired-directory (or dirname default-directory)) X (if dirname X (setq default-directory X`09 (if (file-directory-p dirname) X`09`09dirname (file-name-directory dirname)))) X (setq mode-line-buffer-identification '("Dired: %17b")) X (setq case-fold-search nil) X (setq buffer-read-only t) X (use-local-map dired-mode-map) X (run-hooks 'dired-mode-hook)) X`0C X(defun dired-repeat-over-lines (arg function) X (beginning-of-line) X (while (and (> arg 0) (not (eobp))) X (setq arg (1- arg)) X (save-excursion X (beginning-of-line) X (and (bobp) (looking-at " total") X`09 (error "No file on this line")) X (funcall function)) X (forward-line 1) X (dired-move-to-filename)) X (while (and (< arg 0) (not (bobp))) X (setq arg (1+ arg)) X (forward-line -1) X (dired-move-to-filename) X (save-excursion X (beginning-of-line) X (funcall function)))) X X(defun dired-flag-file-deleted (arg) X "In dired, flag the current line's file for deletion. XWith arg, repeat over several lines." X (interactive "p") X (dired-repeat-over-lines arg X '(lambda () X (let ((buffer-read-only nil)) X`09 (delete-char 1) X`09 (insert "D"))))) X X(defun dired-summary () X (interactive) X ;>> this should check the key-bindings and use substitute-command-keys if V non-standard X (message X "d-elete, u-ndelete, x-ecute, f-ind, o-ther window, r-ename, c-opy, v-iew V")) X X(defun dired-unflag (arg) X "In dired, remove the current line's delete flag then move to next line." X (interactive "p") X (dired-repeat-over-lines arg X '(lambda () X (let ((buffer-read-only nil)) X`09 (delete-char 1) X`09 (insert " ") X`09 (forward-char -1))))) X X(defun dired-backup-unflag (arg) X "In dired, move up a line and remove deletion flag there." X (interactive "p") X (dired-unflag (- arg))) X X(defun dired-next-line (arg) X "Move down ARG lines then position at filename." X (interactive "p") X (next-line arg) X (dired-move-to-filename)) X X(defun dired-previous-line (arg) X "Move up ARG lines then position at filename." X (interactive "p") X (previous-line arg) X (dired-move-to-filename)) X X(defun dired-find-file () X "In dired, visit the file or directory named on this line." X (interactive) X (find-file (dired-get-filename))) X X(defun dired-view-file () X "In dired, examine a file in view mode, returning to dired when done." X (interactive) X (if (file-directory-p (dired-get-filename)) X (dired (dired-get-filename)) X (view-file (dired-get-filename)))) X X(defun dired-find-file-other-window () X "In dired, visit this file or directory in another window." X (interactive) X (find-file-other-window (dired-get-filename))) X X(defun dired-get-filename (&optional localp no-error-if-not-filep) X "In dired, return name of file mentioned on this line. XValue returned normally includes the directory name. XA non-nil 1st argument means do not include it. A non-nil 2nd argument Xsays return nil if no filename on this line, otherwise an error occurs." X (let (eol) X (save-excursion X (end-of-line) X (setq eol (point)) X (beginning-of-line) X (if (eq system-type 'vax-vms) X`09 (progn X`09 (if (and (not (looking-at "..Directory ")) X`09`09 (not (looking-at "..Total ")) X`09`09 (re-search-forward "`5E..\$`5B`5D`5B.A-Z-0-9_$;<>`5D+\$" X`09`09`09`09`09eol t)) X`09`09(progn X`09`09 (buffer-substring (match-beginning 1) (match-end 1)) X`09`09 ) X`09 (if no-error-if-not-filep nil X`09`09(error "No file on this line")))) X`09;; else UNIX style X`09(if (re-search-forward dired-match-date X`09`09`09 eol t) X`09 (progn (skip-chars-forward " ") X`09`09 (skip-chars-forward "`5E " eol) X`09`09 (skip-chars-forward " " eol) X`09`09 (let ((beg (point))) X`09`09 (skip-chars-forward "`5E \n") X`09`09 (if localp X`09`09`09 (buffer-substring beg (point)) X`09`09 ;; >> uses default-directory, could lose on cd, multiple. X`09`09 (concat default-directory X`09`09`09 (buffer-substring beg (point)))))) X`09 (if no-error-if-not-filep nil X`09 (error "No file on this line")))) X ))) X X(defun dired-move-to-filename () X "In dired, move to first char of filename on this line. XReturns position (point) or nil if no filename on this line." X (let ((eol (progn (end-of-line) (point)))) X (beginning-of-line) X (if (re-search-forward X`09 "\$Jan\\`7CFeb\\`7CMar\\`7CApr\\`7CMay\\`7CJun\\`7CJul\\`7CAug\\`7CSep\ V\`7COct\\`7CNov\\`7CDec\$`5B `5D+`5B0-9`5D+" X`09 eol t) X`09(progn X`09 (skip-chars-forward " ") X`09 (skip-chars-forward "`5E " eol) X`09 (skip-chars-forward " " eol) X`09 (point))))) X X(defun dired-map-dired-file-lines (fn) X "perform fn with point at the end of each non-directory line: Xarguments are the short and long filename" X (save-excursion X (let (filename longfilename (buffer-read-only nil)) X (goto-char (point-min)) X (while (not (eobp)) X`09(save-excursion X`09 (and (not (looking-at " d")) X`09 (not (eolp)) X`09 (setq filename (dired-get-filename t t) X`09`09 longfilename (dired-get-filename nil t)) X`09 (progn (end-of-line) X`09`09 (funcall fn filename longfilename)))) X`09(forward-line 1))))) X`0C X(defun dired-flag-auto-save-files () X "Flag for deletion files whose names suggest they are auto save files." X (interactive) X (save-excursion X (let ((buffer-read-only nil)) X (goto-char (point-min)) X (while (not (eobp)) X (and (not (looking-at " d")) X`09 (not (eolp)) X`09 (if (fboundp 'auto-save-file-name-p) X`09`09(let ((fn (dired-get-filename t t))) X`09`09 (if fn (auto-save-file-name-p fn))) X`09 (if (dired-move-to-filename) X`09`09 (looking-at "#"))) X`09 (progn (beginning-of-line) X`09`09 (delete-char 1) X`09`09 (insert "D"))) X (forward-line 1))))) X X(defun dired-clean-directory (keep) X "Flag numerical backups for Deletion. XSpares dired-kept-versions latest versions, and kept-old-versions oldest. XPositive numeric arg overrides dired-kept-versions; Xnegative numeric arg overrides kept-old-versions with minus the arg." X (interactive "P") X (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions)) X (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) X`09(late-retention (if (<= keep 0) dired-kept-versions keep)) X`09(file-version-assoc-list ())) X ;; Look at each file. X ;; If the file has numeric backup versions, X ;; put on file-version-assoc-list an element of the form X ;; (FILENAME . VERSION-NUMBER-LIST) X (dired-map-dired-file-lines 'dired-collect-file-versions) +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-