]> code.delx.au - gnu-emacs/blobdiff - lisp/vms-patch.el
(normal-splash-screen, fancy-splash-screens-1): Add a reference to the Lisp
[gnu-emacs] / lisp / vms-patch.el
index 93edaa86808c4a5ddec89f95122ecb8135ee0395..eb365c3b5802a575aaff0f4f7d2d4a9a79806b0c 100644 (file)
@@ -1,6 +1,7 @@
-;;; vms-patch.el --- override parts of files.el for VMS.
+;;; vms-patch.el --- override parts of files.el for VMS
 
-;; Copyright (C) 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: vms
 ;; 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
@@ -54,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)
              "_$"
@@ -66,9 +73,10 @@ 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))
 
 ;;;
@@ -86,7 +94,7 @@ If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file."
     (if (not args)
        (if file
            (progn (find-file file)
-                  (if line (goto-line (string-to-int line)))))
+                  (if line (goto-line (string-to-number line)))))
       (cd (file-name-directory file))
       (vms-command-line-again))))
 
@@ -140,7 +148,7 @@ spawned Emacs and doing things like \"emacs -l myfile.el -f doit\""
                        (< 32 (setq this-char (aref args end)))
                        (> 127 this-char))
              (setq end (1+ end)))
-           (setq command-line-args (append 
+           (setq command-line-args (append
                                     command-line-args
                                     (list (substring args beg end))))
            (setq beg (1+ end)))
@@ -163,7 +171,7 @@ spawned Emacs and doing things like \"emacs -l myfile.el -f doit\""
       "/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
@@ -186,4 +194,72 @@ following bindings are established.
 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