|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-l19.11.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: efs support for XEemacs, versions 19.11, and later.
|
|
|
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
10 ;; Created: Tue Aug 2 17:40:32 1994 by sandy on ibm550
|
|
|
11 ;; Modified: Sun Nov 27 18:34:33 1994 by sandy on gandalf
|
|
|
12 ;;
|
|
|
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
14
|
|
|
15 (provide 'efs-l19\.11)
|
|
|
16 (require 'efs-cu)
|
|
|
17 (require 'default-dir)
|
|
|
18 (require 'efs-ovwrt)
|
|
|
19
|
|
|
20 (defconst efs-l19\.11-version
|
|
|
21 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
22 "/"
|
|
|
23 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
24
|
|
|
25 ;;; Functions requiring special defs. for these lemacs versions.
|
|
|
26
|
|
|
27 (defun efs-abbreviate-file-name (filename &optional hack-homedir)
|
|
|
28 ;; lucid emacs version of abbreviate-file-name for remote files.
|
|
|
29 (let (file-name-handler-alist)
|
|
|
30 (if (and hack-homedir (efs-ftp-path filename))
|
|
|
31 ;; Do replacements from directory-abbrev-alist
|
|
|
32 (apply 'efs-unexpand-parsed-filename
|
|
|
33 (efs-ftp-path (abbreviate-file-name filename nil)))
|
|
|
34 (abbreviate-file-name filename hack-homedir))))
|
|
|
35
|
|
|
36 (defun efs-relativize-filename (file &optional dir new)
|
|
|
37 "Abbreviate the given filename relative to DIR .
|
|
|
38 If DIR is nil, use the value of `default-directory'. If the
|
|
|
39 optional parameter NEW is given and the non-directory parts match, only return
|
|
|
40 the directory part of the file."
|
|
|
41 (let* ((dir (or dir default-directory))
|
|
|
42 (dlen (length dir))
|
|
|
43 (result file))
|
|
|
44 (and (> (length file) dlen)
|
|
|
45 (string-equal (substring file 0 dlen) dir)
|
|
|
46 (setq result (substring file dlen)))
|
|
|
47 (and new
|
|
|
48 (string-equal (file-name-nondirectory result)
|
|
|
49 (file-name-nondirectory new))
|
|
|
50 (or (setq result (file-name-directory result))
|
|
|
51 (setq result "./")))
|
|
|
52 (abbreviate-file-name result t)))
|
|
|
53
|
|
|
54 (defun efs-set-buffer-file-name (filename)
|
|
|
55 ;; Sets the buffer local variables for filename appropriately.
|
|
|
56 ;; A special function because Lucid and FSF do this differently.
|
|
|
57 (setq buffer-file-name filename)
|
|
|
58 (if (and efs-compute-remote-buffer-file-truename
|
|
|
59 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
60 efs-unix-host-types))
|
|
|
61 (compute-buffer-file-truename)
|
|
|
62 (setq buffer-file-truename filename)))
|
|
|
63
|
|
|
64 ;; Do we need to do anything about compute-buffer-file-truename, or
|
|
|
65 ;; will the handler for file-truename handle this automatically? I suppose
|
|
|
66 ;; that efs-compute-remote-buffer-file-truename should really apply to
|
|
|
67 ;; compute-buffer-file-truename, and not file-truename, but then we would
|
|
|
68 ;; have to do deal with the fact that this function doesn't exist in GNU Emacs.
|
|
|
69
|
|
|
70 ;; Only Lucid Emacs has this function. Why do we need both this and
|
|
|
71 ;; set-visited-file-modtime?
|
|
|
72
|
|
|
73 (defun efs-set-buffer-modtime (buffer &optional time)
|
|
|
74 ;; For buffers visiting remote files, set the buffer modtime.
|
|
|
75 (or time
|
|
|
76 (progn
|
|
|
77 (setq time
|
|
|
78 (let* ((file (save-excursion
|
|
|
79 (set-buffer buffer) buffer-file-name))
|
|
|
80 (parsed (efs-ftp-path file)))
|
|
|
81 (efs-get-file-mdtm (car parsed) (nth 1 parsed)
|
|
|
82 (nth 2 parsed) file)))
|
|
|
83 (if time
|
|
|
84 (setq time (cons (car time) (nth 1 time)))
|
|
|
85 (setq time '(0 . 0)))))
|
|
|
86 (let (file-name-handler-alist)
|
|
|
87 (set-buffer-modtime buffer time)))
|
|
|
88
|
|
|
89 ;;; Need to add access to the file-name-handler-alist to these functions.
|
|
|
90
|
|
|
91 (defun efs-l19\.11-set-buffer-modtime (buffer &optional time)
|
|
|
92 "Documented as original"
|
|
|
93 (let ((handler (save-excursion
|
|
|
94 (set-buffer buffer)
|
|
|
95 (and buffer-file-name
|
|
|
96 (find-file-name-handler buffer-file-name
|
|
|
97 'set-buffer-modtime)))))
|
|
|
98 (if handler
|
|
|
99 (funcall handler 'set-buffer-modtime buffer time)
|
|
|
100 (let (file-name-handler-alist)
|
|
|
101 (efs-real-set-buffer-modtime buffer time)))))
|
|
|
102
|
|
|
103 (efs-overwrite-fn "efs" 'set-buffer-modtime 'efs-l19\.11-set-buffer-modtime)
|
|
|
104
|
|
|
105 (defun efs-l19\.11-backup-buffer ()
|
|
|
106 "Documented as original"
|
|
|
107 (if buffer-file-name
|
|
|
108 (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer)))
|
|
|
109 (if handler
|
|
|
110 (funcall handler 'backup-buffer)
|
|
|
111 (let (file-name-handler-alist)
|
|
|
112 (efs-real-backup-buffer))))))
|
|
|
113
|
|
|
114 (efs-overwrite-fn "efs" 'backup-buffer 'efs-l19\.11-backup-buffer)
|
|
|
115
|
|
|
116 (defun efs-l19\.11-create-file-buffer (file)
|
|
|
117 "Documented as original"
|
|
|
118 (let ((handler (find-file-name-handler file 'create-file-buffer)))
|
|
|
119 (if handler
|
|
|
120 (funcall handler 'create-file-buffer file)
|
|
|
121 (let (file-name-handler-alist)
|
|
|
122 (efs-real-create-file-buffer file)))))
|
|
|
123
|
|
|
124 (efs-overwrite-fn "efs" 'create-file-buffer 'efs-l19\.11-create-file-buffer)
|
|
|
125
|
|
|
126 (defun efs-l19\.11-abbreviate-file-name (filename &optional hack-homedir)
|
|
|
127 "Documented as original"
|
|
|
128 (let ((handler (find-file-name-handler filename 'abbreviate-file-name)))
|
|
|
129 (if handler
|
|
|
130 (funcall handler 'abbreviate-file-name filename hack-homedir)
|
|
|
131 (let (file-name-handler-alist)
|
|
|
132 (efs-real-abbreviate-file-name filename hack-homedir)))))
|
|
|
133
|
|
|
134 (efs-overwrite-fn "efs" 'abbreviate-file-name
|
|
|
135 'efs-l19\.11-abbreviate-file-name)
|
|
|
136
|
|
|
137 (defun efs-l19\.11-recover-file (file)
|
|
|
138 "Documented as original"
|
|
|
139 (interactive
|
|
|
140 (let ((prompt-file buffer-file-name)
|
|
|
141 (file-name nil)
|
|
|
142 (file-dir nil))
|
|
|
143 (and prompt-file
|
|
|
144 (setq file-name (file-name-nondirectory prompt-file)
|
|
|
145 file-dir (file-name-directory prompt-file)))
|
|
|
146 (list (read-file-name "Recover file: "
|
|
|
147 file-dir nil nil file-name))))
|
|
|
148 (let* ((file (expand-file-name file))
|
|
|
149 (handler (or (find-file-name-handler file 'recover-file)
|
|
|
150 (find-file-name-handler
|
|
|
151 (let ((buffer-file-name file))
|
|
|
152 (make-auto-save-file-name))
|
|
|
153 'recover-file))))
|
|
|
154 (if handler
|
|
|
155 (funcall handler 'recover-file file)
|
|
|
156 (efs-real-recover-file file))))
|
|
|
157
|
|
|
158 (efs-overwrite-fn "efs" 'recover-file 'efs-l19\.11-recover-file)
|
|
|
159
|
|
|
160 (defun efs-l19\.11-substitute-in-file-name (filename)
|
|
|
161 "Documented as original."
|
|
|
162 (let ((handler (find-file-name-handler filename 'substitute-in-file-name)))
|
|
|
163 (if handler
|
|
|
164 (funcall handler 'substitute-in-file-name filename)
|
|
|
165 (let (file-name-handler-alist)
|
|
|
166 (efs-real-substitute-in-file-name filename)))))
|
|
|
167
|
|
|
168 (efs-overwrite-fn "efs" 'substitute-in-file-name
|
|
|
169 'efs-l19\.11-substitute-in-file-name)
|
|
|
170
|
|
|
171 ;;; For the file-name-handler-alist
|
|
|
172
|
|
|
173 (put 'set-buffer-modtime 'efs 'efs-set-buffer-modtime)
|
|
|
174
|
|
|
175 ;;; end of efs-l19.11.el
|
