|
|
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 free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: ! 21: ;;; Functions that need redefinition ! 22: ! 23: ;;; VMS file names are upper case, but buffer names are more ! 24: ;;; convenient in lower case. ! 25: ! 26: (defun create-file-buffer (filename) ! 27: "Create a suitably named buffer for visiting FILENAME, and return it. ! 28: FILENAME (sans directory) is used unchanged if that name is free; ! 29: otherwise a string <2> or <3> or ... is appended to get an unused name." ! 30: (generate-new-buffer (downcase (file-name-nondirectory filename)))) ! 31: ! 32: ;;; Given a string FN, return a similar name which is a legal VMS filename. ! 33: ;;; This is used to avoid invalid auto save file names. ! 34: (defun make-legal-file-name (fn) ! 35: (setq fn (copy-sequence fn)) ! 36: (let ((dot nil) (indx 0) (len (length fn)) chr) ! 37: (while (< indx len) ! 38: (setq chr (aref fn indx)) ! 39: (cond ! 40: ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t))) ! 41: ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z)) ! 42: (and (>= chr ?0) (<= chr ?9)) ! 43: (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0)))) ! 44: (aset fn indx ?_))) ! 45: (setq indx (1+ indx)))) ! 46: fn) ! 47: ! 48: ;;; Auto save filesnames start with _$ and end with $. ! 49: ! 50: (defun make-auto-save-file-name () ! 51: "Return file name to use for auto-saves of current buffer. ! 52: Does not consider auto-save-visited-file-name; that is checked ! 53: before calling this function. ! 54: This is a separate function so your .emacs file or site-init.el can redefine it. ! 55: See also auto-save-file-name-p." ! 56: (if buffer-file-name ! 57: (concat (file-name-directory buffer-file-name) ! 58: "_$" ! 59: (file-name-sans-versions (file-name-nondirectory ! 60: 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.