X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6251ee24afa4f74a3e094ba12493ab2dc9315886..e223ede91633099df2cf0d8853d8de7e191def6e:/lisp/vms-patch.el diff --git a/lisp/vms-patch.el b/lisp/vms-patch.el index b0d722d381..eb365c3b58 100644 --- a/lisp/vms-patch.el +++ b/lisp/vms-patch.el @@ -1,11 +1,11 @@ -;;; vms-patch.el --- override parts of files.el for VMS. +;;; vms-patch.el --- override parts of files.el for VMS + +;; Copyright (C) 1986, 1992, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF -;; Last-Modified: 06 May 1992 ;; Keywords: vms -;; Copyright (C) 1986 Free Software Foundation, Inc. - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -19,11 +19,16 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: ;;; Code: +(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 @@ -55,10 +60,11 @@ otherwise a string <2> or <3> or ... is appended to get an unused name." (defun make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. -Does not consider auto-save-visited-file-name; that is checked -before calling this function. -This is a separate function so your .emacs file or site-init.el can redefine it. -See also auto-save-file-name-p." +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) "_$" @@ -67,16 +73,30 @@ See also auto-save-file-name-p." (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$")))) (defun auto-save-file-name-p (filename) - "Return t if FILENAME can be yielded by make-auto-save-file-name. + "Return t if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. -This is a separate function so your .emacs file or site-init.el can redefine it." +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"))) - (if file (find-file 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) @@ -88,6 +108,52 @@ If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." (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) @@ -105,13 +171,95 @@ If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)") (setq print-region-function - '(lambda (start end command ign1 ign2 ign3 &rest switches) + (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"" " + " 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