Mercurial > emacs
changeset 96523:090433f48c5f
* vms-patch.el, vmsproc.el, mail/vms-pmail.el: Move to obsolete dir.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Sat, 05 Jul 2008 18:27:16 +0000 |
parents | 77765b604664 |
children | d620ef3acfdc |
files | lisp/ChangeLog lisp/mail/vms-pmail.el lisp/obsolete/vms-patch.el lisp/obsolete/vms-pmail.el lisp/obsolete/vmsproc.el lisp/vms-patch.el lisp/vmsproc.el |
diffstat | 7 files changed, 545 insertions(+), 537 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jul 05 18:22:56 2008 +0000 +++ b/lisp/ChangeLog Sat Jul 05 18:27:16 2008 +0000 @@ -1,5 +1,7 @@ 2008-07-05 Dan Nicolaescu <dann@ics.uci.edu> + * vms-patch.el, vmsproc.el, mail/vms-pmail.el: Move to obsolete dir. + * vc-dir.el (vc-dir-find-child-files): New function. (vc-dir-resync-directory-files): New function. (vc-dir-recompute-file-state): New function, broken out of ...
--- a/lisp/mail/vms-pmail.el Sat Jul 05 18:22:56 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,123 +0,0 @@ -;; -*- no-byte-compile: t -*- -;;; vms-pmail.el --- use Emacs as the editor within VMS mail - -;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Roland B Roberts <roberts@panix.com> -;; Maintainer: FSF -;; Keywords: vms - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -;;; -;;; Quick hack to use emacs as mail editor. There are a *bunch* of -;;; changes scattered throughout emacs to make this work, namely: -;;; (1) mod to sysdep.c to allow emacs to attach to a process other -;;; than the one that originally spawned it. -;;; (2) mod to kepteditor.com to define the logical emacs_parent_pid -;;; which is what sysdep.c looks for, and define the logical -;;; emacs_command_args which contains the command line -;;; (3) mod to re-parse command line arguments from emacs_command_args -;;; then execute them as though emacs were just starting up. -;;; -(defun vms-pmail-save-and-exit () - "Save current buffer and exit Emacs. -If this Emacs cannot be suspended, you will be prompted about modified -buffers other than the mail buffer. BEWARE --- suspending Emacs without -saving your mail buffer causes mail to abort the send (potentially useful -since the mail buffer is still here)." - (interactive) - (basic-save-buffer) - (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") - (progn - (save-some-buffers) - (kill-emacs 1)) - (kill-buffer (current-buffer)) - (suspend-emacs))) - -(defun vms-pmail-abort () - "Mark buffer as unmodified and exit Emacs. -When the editor is exited without saving its buffer, VMS mail does not -send a message. If you have other modified buffers you will be -prompted for what to do with them." - (interactive) - (if (not (yes-or-no-p "Really abort mail? ")) - (ding) - (not-modified) - (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") - (progn - (save-some-buffers) - (kill-emacs 1)) - (kill-buffer (current-buffer)) - (suspend-emacs)))) - -(defun vms-pmail-setup () - "Set up file assuming use by VMS MAIL utility. -The buffer is put into text-mode, auto-save is turned off and the -following bindings are established. - -\\[vms-pmail-save-and-exit] vms-pmail-save-and-exit -\\[vms-pmail-abort] vms-pmail-abort - -All other Emacs commands are still available." - (interactive) - (auto-save-mode -1) - (text-mode) - (let ((default (vms-system-info "LOGICAL" "SYS$SCRATCH")) - (directory (file-name-directory (buffer-file-name))) - (filename (file-name-nondirectory (buffer-file-name)))) - (if (string= directory "SYS$SCRATCH:") - (progn - (cd default) - (setq buffer-file-name (concat default filename)))) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'vms-pmail-save-and-exit) - (local-set-key "\C-c\C-g" 'vms-pmail-abort))) - -(defun indicate-mail-reply-text () - "Prepares received mail for re-sending by placing >'s on each line." - (interactive) - (goto-char (point-min)) - (while (not (eobp)) - (insert ">") - (beginning-of-line) - (forward-line 1)) - (set-buffer-modified-p nil) - (goto-char (point-min))) - -(defun insert-signature () - "Moves to the end of the buffer and inserts a \"signature\" file. -First try the file indicated by environment variable MAIL$TRAILER. -If that fails, try the file \"~/.signature\". -If neither file exists, fails quietly." - (interactive) - (goto-char (point-max)) - (newline) - (if (vms-system-info "LOGICAL" "MAIL$TRAILER") - (if (file-attributes (vms-system-info "LOGICAL" "MAIL$TRAILER")) - (insert-file-contents (vms-system-info "LOGICAL" "MAIL$TRAILER")) - (if (file-attributes "~/.signature") - (insert-file-contents "~/.signature"))))) - -(provide 'vms-pmail) - -;; arch-tag: 336850fc-7812-4663-8e4d-b9c13f47dce1 -;;; vms-pmail.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/vms-patch.el Sat Jul 05 18:27:16 2008 +0000 @@ -0,0 +1,270 @@ +;; -*- no-byte-compile: t -*- +;; Not byte compiled because it uses functions that are not part of +;; emacs, so it would generate unnecessary warnings. +;;; vms-patch.el --- override parts of files.el for VMS + +;; Copyright (C) 1986, 1992, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Maintainer: FSF +;; Keywords: vms + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(defvar print-region-function) + +(setq auto-mode-alist (cons '(("\\.com\\'" . dcl-mode)) auto-mode-alist)) + +;;; Functions that need redefinition + +;;; VMS file names are upper case, but buffer names are more +;;; convenient in lower case. + +(defun create-file-buffer (filename) + "Create a suitably named buffer for visiting FILENAME, and return it. +FILENAME (sans directory) is used unchanged if that name is free; +otherwise a string <2> or <3> or ... is appended to get an unused name." + (generate-new-buffer (downcase (file-name-nondirectory filename)))) + +;;; Given a string FN, return a similar name which is a valid VMS filename. +;;; This is used to avoid invalid auto save file names. +(defun make-valid-file-name (fn) + (setq fn (copy-sequence fn)) + (let ((dot nil) (indx 0) (len (length fn)) chr) + (while (< indx len) + (setq chr (aref fn indx)) + (cond + ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t))) + ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z)) + (and (>= chr ?0) (<= chr ?9)) + (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0)))) + (aset fn indx ?_))) + (setq indx (1+ indx)))) + fn) + +(define-obsolete-function-alias 'make-legal-file-name 'make-valid-file-name "23.1") + +;;; Auto save filesnames start with _$ and end with $. + +(defun make-auto-save-file-name () + "Return file name to use for auto-saves of current buffer. +This function does not consider `auto-save-visited-file-name'; +the caller should check that before calling this function. +This is a separate function so that your `.emacs' file or the site's +`site-init.el' can redefine it. +See also `auto-save-file-name-p'." + (if buffer-file-name + (concat (file-name-directory buffer-file-name) + "_$" + (file-name-nondirectory buffer-file-name) + "$") + (expand-file-name (concat "_$_" (make-valid-file-name (buffer-name)) "$")))) + +(defun auto-save-file-name-p (filename) + "Return t if FILENAME can be yielded by `make-auto-save-file-name'. +FILENAME should lack slashes. +This is a separate function so that your `.emacs' file or the site's +`site-init.el' can redefine it." + (string-match "^_\\$.*\\$" filename)) + +;;; +;;; This goes along with kepteditor.com which defines these logicals +;;; If EMACS_COMMAND_ARGS is defined, it supersedes EMACS_FILE_NAME, +;;; which is probably set up incorrectly anyway. +;;; The function command-line-again is a kludge, but it does the job. +;;; +(defun vms-suspend-resume-hook () + "When resuming suspended Emacs, check for file to be found. +If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." + (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME")) + (args (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS")) + (line (vms-system-info "LOGICAL" "EMACS_FILE_LINE"))) + (if (not args) + (if file + (progn (find-file file) + (if line (goto-line (string-to-number line))))) + (cd (file-name-directory file)) + (vms-command-line-again)))) + +(setq suspend-resume-hook 'vms-suspend-resume-hook) + +(defun vms-suspend-hook () + "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined." + (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") + (error "Can't suspend this emacs")) + nil) + +(setq suspend-hook 'vms-suspend-hook) + +;;; +;;; A kludge that allows reprocessing of the command line. This is mostly +;;; to allow a spawned VMS mail process to do something reasonable when +;;; used in conjunction with the modifications to sysdep.c that allow +;;; Emacs to attach to a "foster" parent. +;;; +(defun vms-command-line-again () + "Reprocess command line arguments. VMS specific. +Command line arguments are initialized from the logical EMACS_COMMAND_ARGS +which is defined by kepteditor.com. On VMS this allows attaching to a +spawned Emacs and doing things like \"emacs -l myfile.el -f doit\"" + (let* ((args (downcase (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS"))) + (command-line-args (list "emacs")) + (beg 0) + (end 0) + (len (length args)) + this-char) + (if args + (progn +;;; replace non-printable stuff with spaces + (while (< beg (length args)) + (if (or (> 33 (setq this-char (aref args beg))) + (< 127 this-char)) + (aset args beg 32)) + (setq beg (1+ beg))) + (setq beg (1- (length args))) + (while (= 32 (aref args beg)) (setq beg (1- beg))) + (setq args (substring args 0 (1+ beg))) + (setq beg 0) +;;; now start parsing args + (while (< beg (length args)) + (while (and (< beg (length args)) + (or (> 33 (setq this-char (aref args beg))) + (< 127 this-char)) + (setq beg (1+ beg)))) + (setq end (1+ beg)) + (while (and (< end (length args)) + (< 32 (setq this-char (aref args end))) + (> 127 this-char)) + (setq end (1+ end))) + (setq command-line-args (append + command-line-args + (list (substring args beg end)))) + (setq beg (1+ end))) + (command-line))))) + +(defun vms-read-directory (dirname switches buffer) + (save-excursion + (set-buffer buffer) + (subprocess-command-to-buffer + (concat "DIRECTORY " switches " " dirname) + buffer) + (goto-char (point-min)) + ;; Remove all the trailing blanks. + (while (search-forward " \n") + (forward-char -1) + (delete-horizontal-space)) + (goto-char (point-min)))) + +(setq dired-listing-switches + "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)") + +(setq print-region-function + (lambda (start end command ign1 ign2 ign3 &rest switches) + (write-region start end "sys$login:delete-me.txt") + (send-command-to-subprocess + 1 + (concat command + " sys$login:delete-me.txt/name=\"GNUprintbuffer\" " + (mapconcat 'identity switches " ")) + nil nil nil))) + +;;; +;;; Fuctions for using Emacs as a VMS Mail editor +;;; +(autoload 'vms-pmail-setup "vms-pmail" + "Set up file assuming use by VMS Mail utility. +The buffer is put into text-mode, auto-save is turned off and the +following bindings are established. + +\\[vms-pmail-save-and-exit] vms-pmail-save-and-exit +\\[vms-pmail-abort] vms-pmail-abort + +All other Emacs commands are still available." + t) + +;;; +;;; Filename handling in the minibuffer +;;; +(defun vms-magic-right-square-brace () + "\ +Insert a right square brace, but do other things first depending on context. +During filename completion, when point is at the end of the line and the +character before is not a right square brace, do one of three things before +inserting the brace: + - If there are already two left square braces preceding, do nothing special. + - If there is a previous right-square-brace, convert it to dot. + - If the character before is dot, delete it. +Additionally, if the preceding chars are right-square-brace followed by +either \"-\" or \"..\", strip one level of directory hierarchy." + (interactive) + (when (and minibuffer-completing-file-name + (= (point) (point-max)) + (not (= 93 (char-before)))) + (cond + ;; Avoid clobbering: user:[one.path][another.path + ((search-backward "[" (field-beginning) t 2)) + ((search-backward "]" (field-beginning) t) + (delete-char 1) + (insert ".") + (goto-char (point-max))) + ((= ?. (char-before)) + (delete-char -1))) + (goto-char (point-max)) + (let ((specs '(".." "-")) + (pmax (point-max))) + (while specs + (let* ((up (car specs)) + (len (length up)) + (cut (- (point) len))) + (when (and (< (1+ len) pmax) + (= ?. (char-before cut)) + (string= up (buffer-substring cut (point)))) + (delete-char (- (1+ len))) + (while (not (let ((c (char-before))) + (or (= ?. c) (= 91 c)))) + (delete-char -1)) + (when (= ?. (char-before)) (delete-char -1)) + (setq specs nil))) + (setq specs (cdr specs))))) + (insert "]")) + +(defun vms-magic-colon () + "\ +Insert a colon, but do other things first depending on context. +During filename completion, when point is at the end of the line +and the line contains a right square brace, remove all characters +from the beginning of the line up to and including such brace. +This enables one to type a new filespec without having to delete +the old one." + (interactive) + (when (and minibuffer-completing-file-name + (= (point) (point-max)) + (search-backward "]" (field-beginning) t)) + (delete-region (field-beginning) (1+ (point))) + (goto-char (point-max))) + (insert ":")) + +(let ((m minibuffer-local-completion-map)) + (define-key m "]" 'vms-magic-right-square-brace) + (define-key m "/" 'vms-magic-right-square-brace) + (define-key m ":" 'vms-magic-colon)) + +;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf +;;; vms-patch.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/vms-pmail.el Sat Jul 05 18:27:16 2008 +0000 @@ -0,0 +1,125 @@ +;; -*- no-byte-compile: t -*- +;; Not byte compiled because it uses functions that are not part of +;; emacs, so it would generate unnecessary warnings. +;;; vms-pmail.el --- use Emacs as the editor within VMS mail + +;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Roland B Roberts <roberts@panix.com> +;; Maintainer: FSF +;; Keywords: vms + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +;;; +;;; Quick hack to use emacs as mail editor. There are a *bunch* of +;;; changes scattered throughout emacs to make this work, namely: +;;; (1) mod to sysdep.c to allow emacs to attach to a process other +;;; than the one that originally spawned it. +;;; (2) mod to kepteditor.com to define the logical emacs_parent_pid +;;; which is what sysdep.c looks for, and define the logical +;;; emacs_command_args which contains the command line +;;; (3) mod to re-parse command line arguments from emacs_command_args +;;; then execute them as though emacs were just starting up. +;;; +(defun vms-pmail-save-and-exit () + "Save current buffer and exit Emacs. +If this Emacs cannot be suspended, you will be prompted about modified +buffers other than the mail buffer. BEWARE --- suspending Emacs without +saving your mail buffer causes mail to abort the send (potentially useful +since the mail buffer is still here)." + (interactive) + (basic-save-buffer) + (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") + (progn + (save-some-buffers) + (kill-emacs 1)) + (kill-buffer (current-buffer)) + (suspend-emacs))) + +(defun vms-pmail-abort () + "Mark buffer as unmodified and exit Emacs. +When the editor is exited without saving its buffer, VMS mail does not +send a message. If you have other modified buffers you will be +prompted for what to do with them." + (interactive) + (if (not (yes-or-no-p "Really abort mail? ")) + (ding) + (not-modified) + (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") + (progn + (save-some-buffers) + (kill-emacs 1)) + (kill-buffer (current-buffer)) + (suspend-emacs)))) + +(defun vms-pmail-setup () + "Set up file assuming use by VMS MAIL utility. +The buffer is put into text-mode, auto-save is turned off and the +following bindings are established. + +\\[vms-pmail-save-and-exit] vms-pmail-save-and-exit +\\[vms-pmail-abort] vms-pmail-abort + +All other Emacs commands are still available." + (interactive) + (auto-save-mode -1) + (text-mode) + (let ((default (vms-system-info "LOGICAL" "SYS$SCRATCH")) + (directory (file-name-directory (buffer-file-name))) + (filename (file-name-nondirectory (buffer-file-name)))) + (if (string= directory "SYS$SCRATCH:") + (progn + (cd default) + (setq buffer-file-name (concat default filename)))) + (use-local-map (copy-keymap (current-local-map))) + (local-set-key "\C-c\C-c" 'vms-pmail-save-and-exit) + (local-set-key "\C-c\C-g" 'vms-pmail-abort))) + +(defun indicate-mail-reply-text () + "Prepares received mail for re-sending by placing >'s on each line." + (interactive) + (goto-char (point-min)) + (while (not (eobp)) + (insert ">") + (beginning-of-line) + (forward-line 1)) + (set-buffer-modified-p nil) + (goto-char (point-min))) + +(defun insert-signature () + "Moves to the end of the buffer and inserts a \"signature\" file. +First try the file indicated by environment variable MAIL$TRAILER. +If that fails, try the file \"~/.signature\". +If neither file exists, fails quietly." + (interactive) + (goto-char (point-max)) + (newline) + (if (vms-system-info "LOGICAL" "MAIL$TRAILER") + (if (file-attributes (vms-system-info "LOGICAL" "MAIL$TRAILER")) + (insert-file-contents (vms-system-info "LOGICAL" "MAIL$TRAILER")) + (if (file-attributes "~/.signature") + (insert-file-contents "~/.signature"))))) + +(provide 'vms-pmail) + +;; arch-tag: 336850fc-7812-4663-8e4d-b9c13f47dce1 +;;; vms-pmail.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/vmsproc.el Sat Jul 05 18:27:16 2008 +0000 @@ -0,0 +1,148 @@ +;; -*- no-byte-compile: t -*- +;; Not byte compiled because it uses functions that are not part of +;; emacs, so it would generate unnecessary warnings. +;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs + +;; Copyright (C) 1986, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mukesh Prasad +;; Maintainer: FSF +;; Keywords: vms + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(defvar display-subprocess-window nil + "If non-nil, the subprocess window is displayed whenever input is received.") + +(defvar command-prefix-string "$ " + "String to insert to distinguish commands entered by user.") + +(defvar subprocess-running nil) +(defvar subprocess-buf nil) + +(defvar command-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-m" 'command-send-input) + (define-key map "\C-u" 'command-kill-line) + map)) + +(defun subprocess-input (name str) + "Handle input from a subprocess. Called by Emacs." + (if display-subprocess-window + (display-buffer subprocess-buf)) + (with-current-buffer subprocess-buf + (goto-char (point-max)) + (insert str ?\n))) + +(defun subprocess-exit (name) + "Called by Emacs upon subprocess exit." + (setq subprocess-running nil)) + +(defun start-subprocess () + "Spawn an asynchronous subprocess with output redirected to +the buffer *COMMAND*. Within this buffer, use C-m to send +the last line to the subprocess or to bring another line to +the end." + (if subprocess-running + (return t)) + (setq subprocess-buf (get-buffer-create "*COMMAND*")) + (with-current-buffer subprocess-buf + (use-local-map command-mode-map)) + (setq subprocess-running (spawn-subprocess 1 'subprocess-input + 'subprocess-exit)) + ;; Initialize subprocess so it doesn't panic and die upon + ;; encountering the first error. + (and subprocess-running + (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE"))) + +(defun subprocess-command-to-buffer (command buffer) + "Execute COMMAND and redirect output into BUFFER." + (let (cmd args) + (setq cmd (substring command 0 (string-match " " command))) + (setq args (substring command (string-match " " command))) + (call-process cmd nil buffer nil "*dcl*" args))) + ;; BUGS: only the output up to the end of the first image activation is trapped. + ;; (if (not subprocess-running) + ;; (start-subprocess)) + ;; (with-current-buffer buffer + ;; (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-" + ;; (getenv "USER") ".LISTING"))) + ;; (while (file-exists-p output-filename) + ;; (delete-file output-filename)) + ;; (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW")) + ;; (send-command-to-subprocess 1 command) + ;; (send-command-to-subprocess 1 (concat + ;; "RENAME " output-filename + ;; "-NEW " output-filename)) + ;; (while (not (file-exists-p output-filename)) + ;; (sleep-for 1)) + ;; (define-logical-name "SYS$OUTPUT" nil) + ;; (insert-file output-filename) + ;; (delete-file output-filename)))) + +(defun subprocess-command () + "Start asynchronous subprocess if not running and switch to its window." + (interactive) + (if (not subprocess-running) + (start-subprocess)) + (and subprocess-running + (progn (pop-to-buffer subprocess-buf) (goto-char (point-max))))) + +(defun command-send-input () + "If at last line of buffer, send the current line to +the spawned subprocess. Otherwise bring back current +line to the last line for resubmission." + (interactive) + (beginning-of-line) + (let ((current-line (buffer-substring (point) (line-end-position)))) + (if (eobp) + (progn + (if (not subprocess-running) + (start-subprocess)) + (if subprocess-running + (progn + (beginning-of-line) + (send-command-to-subprocess 1 current-line) + (if command-prefix-string + (progn (beginning-of-line) (insert command-prefix-string))) + (forward-line 1)))) + ;; else -- if not at last line in buffer + (goto-char (point-max)) + (backward-char) + (forward-line 1) + (insert + (if (compare-strings command-prefix-string nil nil + current-line 0 (length command-prefix-string)) + (substring current-line (length command-prefix-string)) + current-line))))) + +(defun command-kill-line () + "Kill the current line. Used in command mode." + (interactive) + (beginning-of-line) + (kill-line)) + +(define-key esc-map "$" 'subprocess-command) + +(provide 'vmsproc) + +;; arch-tag: 600b2512-f903-4887-bcd2-e76b306f5b66 +;;; vmsproc.el ends here
--- a/lisp/vms-patch.el Sat Jul 05 18:22:56 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -;; -*- no-byte-compile: t -*- -;;; vms-patch.el --- override parts of files.el for VMS - -;; Copyright (C) 1986, 1992, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: vms - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(defvar print-region-function) - -(setq auto-mode-alist (cons '(("\\.com\\'" . dcl-mode)) auto-mode-alist)) - -;;; Functions that need redefinition - -;;; VMS file names are upper case, but buffer names are more -;;; convenient in lower case. - -(defun create-file-buffer (filename) - "Create a suitably named buffer for visiting FILENAME, and return it. -FILENAME (sans directory) is used unchanged if that name is free; -otherwise a string <2> or <3> or ... is appended to get an unused name." - (generate-new-buffer (downcase (file-name-nondirectory filename)))) - -;;; Given a string FN, return a similar name which is a valid VMS filename. -;;; This is used to avoid invalid auto save file names. -(defun make-valid-file-name (fn) - (setq fn (copy-sequence fn)) - (let ((dot nil) (indx 0) (len (length fn)) chr) - (while (< indx len) - (setq chr (aref fn indx)) - (cond - ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t))) - ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z)) - (and (>= chr ?0) (<= chr ?9)) - (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0)))) - (aset fn indx ?_))) - (setq indx (1+ indx)))) - fn) - -(define-obsolete-function-alias 'make-legal-file-name 'make-valid-file-name "23.1") - -;;; Auto save filesnames start with _$ and end with $. - -(defun make-auto-save-file-name () - "Return file name to use for auto-saves of current buffer. -This function does not consider `auto-save-visited-file-name'; -the caller should check that before calling this function. -This is a separate function so that your `.emacs' file or the site's -`site-init.el' can redefine it. -See also `auto-save-file-name-p'." - (if buffer-file-name - (concat (file-name-directory buffer-file-name) - "_$" - (file-name-nondirectory buffer-file-name) - "$") - (expand-file-name (concat "_$_" (make-valid-file-name (buffer-name)) "$")))) - -(defun auto-save-file-name-p (filename) - "Return t if FILENAME can be yielded by `make-auto-save-file-name'. -FILENAME should lack slashes. -This is a separate function so that your `.emacs' file or the site's -`site-init.el' can redefine it." - (string-match "^_\\$.*\\$" filename)) - -;;; -;;; This goes along with kepteditor.com which defines these logicals -;;; If EMACS_COMMAND_ARGS is defined, it supersedes EMACS_FILE_NAME, -;;; which is probably set up incorrectly anyway. -;;; The function command-line-again is a kludge, but it does the job. -;;; -(defun vms-suspend-resume-hook () - "When resuming suspended Emacs, check for file to be found. -If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." - (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME")) - (args (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS")) - (line (vms-system-info "LOGICAL" "EMACS_FILE_LINE"))) - (if (not args) - (if file - (progn (find-file file) - (if line (goto-line (string-to-number line))))) - (cd (file-name-directory file)) - (vms-command-line-again)))) - -(setq suspend-resume-hook 'vms-suspend-resume-hook) - -(defun vms-suspend-hook () - "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined." - (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") - (error "Can't suspend this emacs")) - nil) - -(setq suspend-hook 'vms-suspend-hook) - -;;; -;;; A kludge that allows reprocessing of the command line. This is mostly -;;; to allow a spawned VMS mail process to do something reasonable when -;;; used in conjunction with the modifications to sysdep.c that allow -;;; Emacs to attach to a "foster" parent. -;;; -(defun vms-command-line-again () - "Reprocess command line arguments. VMS specific. -Command line arguments are initialized from the logical EMACS_COMMAND_ARGS -which is defined by kepteditor.com. On VMS this allows attaching to a -spawned Emacs and doing things like \"emacs -l myfile.el -f doit\"" - (let* ((args (downcase (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS"))) - (command-line-args (list "emacs")) - (beg 0) - (end 0) - (len (length args)) - this-char) - (if args - (progn -;;; replace non-printable stuff with spaces - (while (< beg (length args)) - (if (or (> 33 (setq this-char (aref args beg))) - (< 127 this-char)) - (aset args beg 32)) - (setq beg (1+ beg))) - (setq beg (1- (length args))) - (while (= 32 (aref args beg)) (setq beg (1- beg))) - (setq args (substring args 0 (1+ beg))) - (setq beg 0) -;;; now start parsing args - (while (< beg (length args)) - (while (and (< beg (length args)) - (or (> 33 (setq this-char (aref args beg))) - (< 127 this-char)) - (setq beg (1+ beg)))) - (setq end (1+ beg)) - (while (and (< end (length args)) - (< 32 (setq this-char (aref args end))) - (> 127 this-char)) - (setq end (1+ end))) - (setq command-line-args (append - command-line-args - (list (substring args beg end)))) - (setq beg (1+ end))) - (command-line))))) - -(defun vms-read-directory (dirname switches buffer) - (save-excursion - (set-buffer buffer) - (subprocess-command-to-buffer - (concat "DIRECTORY " switches " " dirname) - buffer) - (goto-char (point-min)) - ;; Remove all the trailing blanks. - (while (search-forward " \n") - (forward-char -1) - (delete-horizontal-space)) - (goto-char (point-min)))) - -(setq dired-listing-switches - "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)") - -(setq print-region-function - (lambda (start end command ign1 ign2 ign3 &rest switches) - (write-region start end "sys$login:delete-me.txt") - (send-command-to-subprocess - 1 - (concat command - " sys$login:delete-me.txt/name=\"GNUprintbuffer\" " - (mapconcat 'identity switches " ")) - nil nil nil))) - -;;; -;;; Fuctions for using Emacs as a VMS Mail editor -;;; -(autoload 'vms-pmail-setup "vms-pmail" - "Set up file assuming use by VMS Mail utility. -The buffer is put into text-mode, auto-save is turned off and the -following bindings are established. - -\\[vms-pmail-save-and-exit] vms-pmail-save-and-exit -\\[vms-pmail-abort] vms-pmail-abort - -All other Emacs commands are still available." - t) - -;;; -;;; Filename handling in the minibuffer -;;; -(defun vms-magic-right-square-brace () - "\ -Insert a right square brace, but do other things first depending on context. -During filename completion, when point is at the end of the line and the -character before is not a right square brace, do one of three things before -inserting the brace: - - If there are already two left square braces preceding, do nothing special. - - If there is a previous right-square-brace, convert it to dot. - - If the character before is dot, delete it. -Additionally, if the preceding chars are right-square-brace followed by -either \"-\" or \"..\", strip one level of directory hierarchy." - (interactive) - (when (and minibuffer-completing-file-name - (= (point) (point-max)) - (not (= 93 (char-before)))) - (cond - ;; Avoid clobbering: user:[one.path][another.path - ((search-backward "[" (field-beginning) t 2)) - ((search-backward "]" (field-beginning) t) - (delete-char 1) - (insert ".") - (goto-char (point-max))) - ((= ?. (char-before)) - (delete-char -1))) - (goto-char (point-max)) - (let ((specs '(".." "-")) - (pmax (point-max))) - (while specs - (let* ((up (car specs)) - (len (length up)) - (cut (- (point) len))) - (when (and (< (1+ len) pmax) - (= ?. (char-before cut)) - (string= up (buffer-substring cut (point)))) - (delete-char (- (1+ len))) - (while (not (let ((c (char-before))) - (or (= ?. c) (= 91 c)))) - (delete-char -1)) - (when (= ?. (char-before)) (delete-char -1)) - (setq specs nil))) - (setq specs (cdr specs))))) - (insert "]")) - -(defun vms-magic-colon () - "\ -Insert a colon, but do other things first depending on context. -During filename completion, when point is at the end of the line -and the line contains a right square brace, remove all characters -from the beginning of the line up to and including such brace. -This enables one to type a new filespec without having to delete -the old one." - (interactive) - (when (and minibuffer-completing-file-name - (= (point) (point-max)) - (search-backward "]" (field-beginning) t)) - (delete-region (field-beginning) (1+ (point))) - (goto-char (point-max))) - (insert ":")) - -(let ((m minibuffer-local-completion-map)) - (define-key m "]" 'vms-magic-right-square-brace) - (define-key m "/" 'vms-magic-right-square-brace) - (define-key m ":" 'vms-magic-colon)) - -;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf -;;; vms-patch.el ends here
--- a/lisp/vmsproc.el Sat Jul 05 18:22:56 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,146 +0,0 @@ -;; -*- no-byte-compile: t -*- -;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs - -;; Copyright (C) 1986, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Mukesh Prasad -;; Maintainer: FSF -;; Keywords: vms - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(defvar display-subprocess-window nil - "If non-nil, the subprocess window is displayed whenever input is received.") - -(defvar command-prefix-string "$ " - "String to insert to distinguish commands entered by user.") - -(defvar subprocess-running nil) -(defvar subprocess-buf nil) - -(defvar command-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-m" 'command-send-input) - (define-key map "\C-u" 'command-kill-line) - map)) - -(defun subprocess-input (name str) - "Handle input from a subprocess. Called by Emacs." - (if display-subprocess-window - (display-buffer subprocess-buf)) - (with-current-buffer subprocess-buf - (goto-char (point-max)) - (insert str ?\n))) - -(defun subprocess-exit (name) - "Called by Emacs upon subprocess exit." - (setq subprocess-running nil)) - -(defun start-subprocess () - "Spawn an asynchronous subprocess with output redirected to -the buffer *COMMAND*. Within this buffer, use C-m to send -the last line to the subprocess or to bring another line to -the end." - (if subprocess-running - (return t)) - (setq subprocess-buf (get-buffer-create "*COMMAND*")) - (with-current-buffer subprocess-buf - (use-local-map command-mode-map)) - (setq subprocess-running (spawn-subprocess 1 'subprocess-input - 'subprocess-exit)) - ;; Initialize subprocess so it doesn't panic and die upon - ;; encountering the first error. - (and subprocess-running - (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE"))) - -(defun subprocess-command-to-buffer (command buffer) - "Execute COMMAND and redirect output into BUFFER." - (let (cmd args) - (setq cmd (substring command 0 (string-match " " command))) - (setq args (substring command (string-match " " command))) - (call-process cmd nil buffer nil "*dcl*" args))) - ;; BUGS: only the output up to the end of the first image activation is trapped. - ;; (if (not subprocess-running) - ;; (start-subprocess)) - ;; (with-current-buffer buffer - ;; (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-" - ;; (getenv "USER") ".LISTING"))) - ;; (while (file-exists-p output-filename) - ;; (delete-file output-filename)) - ;; (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW")) - ;; (send-command-to-subprocess 1 command) - ;; (send-command-to-subprocess 1 (concat - ;; "RENAME " output-filename - ;; "-NEW " output-filename)) - ;; (while (not (file-exists-p output-filename)) - ;; (sleep-for 1)) - ;; (define-logical-name "SYS$OUTPUT" nil) - ;; (insert-file output-filename) - ;; (delete-file output-filename)))) - -(defun subprocess-command () - "Start asynchronous subprocess if not running and switch to its window." - (interactive) - (if (not subprocess-running) - (start-subprocess)) - (and subprocess-running - (progn (pop-to-buffer subprocess-buf) (goto-char (point-max))))) - -(defun command-send-input () - "If at last line of buffer, send the current line to -the spawned subprocess. Otherwise bring back current -line to the last line for resubmission." - (interactive) - (beginning-of-line) - (let ((current-line (buffer-substring (point) (line-end-position)))) - (if (eobp) - (progn - (if (not subprocess-running) - (start-subprocess)) - (if subprocess-running - (progn - (beginning-of-line) - (send-command-to-subprocess 1 current-line) - (if command-prefix-string - (progn (beginning-of-line) (insert command-prefix-string))) - (forward-line 1)))) - ;; else -- if not at last line in buffer - (goto-char (point-max)) - (backward-char) - (forward-line 1) - (insert - (if (compare-strings command-prefix-string nil nil - current-line 0 (length command-prefix-string)) - (substring current-line (length command-prefix-string)) - current-line))))) - -(defun command-kill-line () - "Kill the current line. Used in command mode." - (interactive) - (beginning-of-line) - (kill-line)) - -(define-key esc-map "$" 'subprocess-command) - -(provide 'vmsproc) - -;; arch-tag: 600b2512-f903-4887-bcd2-e76b306f5b66 -;;; vmsproc.el ends here