|
|
1.1 ! root 1: ;; Override parts of files.el for VMS. ! 2: ;; Copyright (C) 1986 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is distributed in the hope that it will be useful, ! 7: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 8: ;; accepts responsibility to anyone for the consequences of using it ! 9: ;; or for whether it serves any particular purpose or works at all, ! 10: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 11: ;; License for full details. ! 12: ! 13: ;; Everyone is granted permission to copy, modify and redistribute ! 14: ;; GNU Emacs, but only under the conditions described in the ! 15: ;; GNU Emacs General Public License. A copy of this license is ! 16: ;; supposed to have been given to you along with GNU Emacs so you ! 17: ;; can know your rights and responsibilities. It should be in a ! 18: ;; file named COPYING. Among other things, the copyright notice ! 19: ;; and this notice must be preserved on all copies. ! 20: ! 21: ! 22: ;;; Functions that need redefinition ! 23: ! 24: ;;; VMS file names are upper case, but buffer names are more ! 25: ;;; convenient in lower case. ! 26: ! 27: (defun create-file-buffer (filename) ! 28: "Create a suitably named buffer for visiting FILENAME, and return it. ! 29: FILENAME (sans directory) is used unchanged if that name is free; ! 30: otherwise a string <2> or <3> or ... is appended to get an unused name." ! 31: (generate-new-buffer (downcase (file-name-nondirectory filename)))) ! 32: ! 33: ;;; Given a string FN, return a similar name which is a legal VMS filename. ! 34: ;;; This is used to avoid invalid auto save file names. ! 35: (defun make-legal-file-name (fn) ! 36: (setq fn (copy-sequence fn)) ! 37: (let ((dot nil) (indx 0) (len (length fn)) chr) ! 38: (while (< indx len) ! 39: (setq chr (aref fn indx)) ! 40: (cond ! 41: ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t))) ! 42: ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z)) ! 43: (and (>= chr ?0) (<= chr ?9)) ! 44: (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0)))) ! 45: (aset fn indx ?_))) ! 46: (setq indx (1+ indx)))) ! 47: fn) ! 48: ! 49: ;;; Auto save filesnames start with _$ and end with $. ! 50: ! 51: (defun make-auto-save-file-name () ! 52: "Return file name to use for auto-saves of current buffer. ! 53: Does not consider auto-save-visited-file-name; that is checked ! 54: before calling this function. ! 55: This is a separate function so your .emacs file or site-init.el can redefine it. ! 56: See also auto-save-file-name-p." ! 57: (if buffer-file-name ! 58: (concat (file-name-directory buffer-file-name) ! 59: "_$" ! 60: (file-name-nondirectory buffer-file-name) ! 61: "$") ! 62: (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$")))) ! 63: ! 64: (defun auto-save-file-name-p (filename) ! 65: "Return t if FILENAME can be yielded by make-auto-save-file-name. ! 66: FILENAME should lack slashes. ! 67: This is a separate function so your .emacs file or site-init.el can redefine it." ! 68: (string-match "^_\\$.*\\$" filename)) ! 69: ! 70: (defun vms-suspend-resume-hook () ! 71: "When resuming suspended Emacs, check for file to be found. ! 72: If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file." ! 73: (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME"))) ! 74: (if file (find-file file)))) ! 75: ! 76: (setq suspend-resume-hook 'vms-suspend-resume-hook) ! 77: ! 78: (defun vms-suspend-hook () ! 79: "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined." ! 80: (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS") ! 81: (error "Can't suspend this emacs")) ! 82: nil) ! 83: ! 84: (setq suspend-hook 'vms-suspend-hook)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.