1 ;;; vms-patch.el --- override parts of files.el for VMS.
3 ;; Copyright (C) 1986 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 1, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22 ;;; Functions that need redefinition
24 ;;; VMS file names are upper case, but buffer names are more
25 ;;; convenient in lower case.
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
))))
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
)
39 (setq chr
(aref fn indx
))
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))))
46 (setq indx
(1+ indx
))))
49 ;;; Auto save filesnames start with _$ and end with $.
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."
58 (concat (file-name-directory buffer-file-name
)
60 (file-name-nondirectory buffer-file-name
)
62 (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$"))))
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
))
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
))))
76 (setq suspend-resume-hook
'vms-suspend-resume-hook
)
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"))
84 (setq suspend-hook
'vms-suspend-hook
)
86 (defun vms-read-directory (dirname switches buffer
)
89 (subprocess-command-to-buffer
90 (concat "DIRECTORY " switches
" " dirname
)
92 (goto-char (point-min))
93 ;; Remove all the trailing blanks.
94 (while (search-forward " \n")
96 (delete-horizontal-space))
97 (goto-char (point-min))))
99 (setq dired-listing-switches
100 "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)")
102 (setq print-region-function
103 '(lambda (start end command ign1 ign2 ign3
&rest switches
)
104 (write-region start end
"sys$login:delete-me.txt")
105 (send-command-to-subprocess
108 " sys$login:delete-me.txt/name=""GNUprintbuffer"" "
109 (mapconcat 'identity switches
" "))
112 ;;; vms-patch.el ends here