|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-tops-20.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
116
|
6 ;; Version: #Revision: 1.1 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: TOPS-20 support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@math.ubc.ca, sandy@itp.ethz.ch>
|
|
|
10 ;; Created: Fri Oct 23 08:52:00 1992
|
|
|
11 ;; Modified: Sun Nov 27 18:43:45 1994 by sandy on gandalf
|
|
|
12 ;; Language: Emacs-Lisp
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; This file is part of efs. See efs.el for copyright
|
|
|
17 ;;; (it's copylefted) and warrranty (there isn't one) information.
|
|
|
18
|
|
|
19 (require 'efs)
|
|
|
20 (provide 'efs-tops-20)
|
|
|
21
|
|
|
22 (defconst efs-tops-20-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
116
|
25 (substring "#Revision: 1.1 $" 11 -2)))
|
|
22
|
26
|
|
|
27 ;;;; ------------------------------------------------------------
|
|
|
28 ;;;; TOPS-20 support
|
|
|
29 ;;;; ------------------------------------------------------------
|
|
|
30
|
|
|
31 (efs-defun efs-send-pwd tops-20 (host user &optional xpwd)
|
|
|
32 ;; pwd doesn't work for tops-20. Need to get the cwd from a dir listing
|
|
|
33 ;; this function returns the cwd in tops-20 syntax
|
|
|
34 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
35 (cmd (concat "dir * " (cdr temp)))
|
|
|
36 dir u-dir full-dir result)
|
|
|
37 (unwind-protect
|
|
|
38 (if (null (and (car (setq result (efs-raw-send-cmd
|
|
|
39 (efs-get-process host user)
|
|
|
40 cmd
|
|
|
41 "Getting TOPS-20 PWD")))
|
|
|
42 (progn
|
|
|
43 (condition-case ()
|
|
|
44 (delete-file (car temp)) (error nil))
|
|
|
45 (car (setq result
|
|
|
46 (efs-raw-send-cmd
|
|
|
47 (efs-get-process host user)
|
|
|
48 cmd
|
|
|
49 "Trying to get TOPS-20 PWD, again."))))))
|
|
|
50 (save-excursion
|
|
|
51 (set-buffer (get-buffer-create
|
|
|
52 efs-data-buffer-name))
|
|
|
53 (erase-buffer)
|
|
|
54 (if (or (file-readable-p (car temp))
|
|
|
55 (sleep-for efs-retry-time)
|
|
|
56 (file-readable-p (car temp)))
|
|
|
57 ;; Try again.
|
|
|
58 (insert-file-contents (car temp))
|
|
|
59 (efs-error host user
|
|
|
60 (format
|
|
|
61 "list data file %s not readable" (car temp))))
|
|
|
62 ;; get the cwd
|
|
|
63 (goto-char (point-min))
|
|
|
64 (efs-save-match-data
|
|
|
65 (if (looking-at "[^ /:]+:<[^<>/ ]+>")
|
|
|
66 (progn
|
|
|
67 (setq dir (buffer-substring (match-beginning 0)
|
|
|
68 (match-end 0))
|
|
|
69 u-dir (efs-internal-directory-file-name
|
|
|
70 (efs-fix-path 'tops-20 dir t))
|
|
|
71 full-dir (format efs-path-format-string
|
|
|
72 user host u-dir))
|
|
|
73 ;; cache the files too
|
|
|
74 (efs-set-files full-dir
|
|
|
75 (efs-parse-listing
|
|
|
76 'tops-20 host user u-dir full-dir))
|
|
|
77 (efs-add-to-ls-cache full-dir nil (buffer-string) t))))))
|
|
|
78 (efs-del-tmp-name (car temp)))
|
|
|
79 (cons dir (nth 1 result))))
|
|
|
80
|
|
|
81 (efs-defun efs-fix-path tops-20 (path &optional reverse)
|
|
|
82 ;; Convert PATH from UNIX-ish to tops-20. If REVERSE given, then
|
|
|
83 ;; do just that.
|
|
|
84 (efs-save-match-data
|
|
|
85 (if reverse
|
|
|
86 (if (string-match "^\\([^:]+:\\)?<\\([^>.][^>]*\\)>.*$" path)
|
|
|
87 (let ((device (and (match-beginning 1)
|
|
|
88 (substring path (match-beginning 1)
|
|
|
89 (match-end 1))))
|
|
|
90 (dir (substring path (match-beginning 2)
|
|
|
91 (match-end 2)))
|
|
|
92 (file (substring path (1+ (match-end 2)))))
|
|
|
93 (while (string-match "\\." dir)
|
|
|
94 (setq dir (concat (substring dir 0 (match-beginning 0))
|
|
|
95 "/"
|
|
|
96 (substring dir (match-end 0)))))
|
|
|
97 (if device
|
|
|
98 (setq dir (concat "/" device "/" dir)))
|
|
|
99 (concat dir file))
|
|
|
100 (error "path %s didn't match tops-20 syntax" path))
|
|
|
101 (if (string-match "^\\(/[^:/]+:/\\)?\\([^./]+/\\)*\\([^/]*\\)$" path)
|
|
|
102 (let ((device (and (match-beginning 1)
|
|
|
103 (substring path 1 (1- (match-end 1)))))
|
|
|
104 (dir (and (match-beginning 2)
|
|
|
105 (substring path (match-beginning 2)
|
|
|
106 (1- (match-end 2)))))
|
|
|
107 (file (substring path (match-beginning 3)
|
|
|
108 (match-end 3))))
|
|
|
109 (if dir
|
|
|
110 (progn
|
|
|
111 (while (string-match "/" dir)
|
|
|
112 (setq dir (concat (substring dir 0 (match-beginning 0))
|
|
|
113 "."
|
|
|
114 (substring dir (match-end 0)))))
|
|
|
115 (if device
|
|
|
116 (concat device "<" dir ">" file)
|
|
|
117 (concat "<" dir ">" file)))
|
|
|
118 (if device
|
|
|
119 (error "%s is invalid relative syntax for tops-20" path)
|
|
|
120 file)))
|
|
|
121 (error "path %s is invalid syntax for tops-20" path)))))
|
|
|
122
|
|
|
123 (efs-defun efs-fix-dir-path tops-20 (dir-path)
|
|
|
124 ;; Convert a path from UNIX-ish to Tops-20 fir a dir listing.
|
|
|
125 (cond ((string-equal "/" dir-path)
|
|
|
126 (error "Can't list tops-20 devices"))
|
|
|
127 ((string-match "/[^:/]+:/$" dir-path)
|
|
|
128 (error "Can't list all root directories on a tops-20 device"))
|
|
|
129 ((efs-fix-path 'tops-20 dir-path nil))))
|
|
|
130
|
|
|
131
|
|
|
132 ;; In tops-20 listings, the filename starts immediatley after the date regexp.
|
|
|
133
|
|
|
134 (defconst efs-tops-20-date-regexp
|
|
|
135 (concat
|
|
|
136 " [1-3]?[0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
137 "\\|Nov\\|Dec\\)-[0-9][0-9] [0-9][0-9]:[0-9][0-9]:[0-9][0-9] "))
|
|
|
138
|
|
|
139
|
|
|
140 (efs-defun efs-parse-listing tops-20
|
|
|
141 (host user dir path &optional switches)
|
|
|
142 ;; Parse the current buffer which is assumed to be a TOPS-20 directory
|
|
|
143 ;; listing, and return a hashtable as the result.
|
|
|
144 ;; HOST = remote host name
|
|
|
145 ;; USER = user name
|
|
|
146 ;; DIR = directory in as a full remote path
|
|
|
147 ;; PATH = directory in full efs path syntax
|
|
|
148 ;; SWITCHES = ls switches (not relevant here)
|
|
|
149 (let ((tbl (efs-make-hashtable))
|
|
|
150 file)
|
|
|
151 (goto-char (point-min))
|
|
|
152 (efs-save-match-data
|
|
|
153 (if (looking-at " *[^/:]+:<\\([^/.<>]+\\.\\)+> *$")
|
|
|
154 ;; looking at the directory name
|
|
|
155 (forward-line 1))
|
|
|
156 (while (re-search-forward efs-tops-20-date-regexp nil t)
|
|
|
157 (setq file (buffer-substring (point)
|
|
|
158 (progn (end-of-line) (point))))
|
|
|
159 (if (string-match "\\.DIRECTORY\\.[0-9]+$" file)
|
|
|
160 ;; deal with directories
|
|
|
161 (efs-put-hash-entry
|
|
|
162 (substring file 0 (match-beginning 0)) '(t) tbl)
|
|
|
163 (efs-put-hash-entry file '(nil) tbl)
|
|
|
164 ;; sans extension
|
|
|
165 (if (string-match "\\.[0-9]+$" file)
|
|
|
166 (efs-put-hash-entry
|
|
|
167 (substring file 0 (match-beginning 0)) '(nil) tbl)))
|
|
|
168 (forward-line 1))
|
|
|
169 (efs-put-hash-entry "." '(t) tbl)
|
|
|
170 (efs-put-hash-entry ".." '(t) tbl))
|
|
|
171 tbl))
|
|
|
172
|
|
|
173 (efs-defun efs-really-file-p tops-20 (file ent)
|
|
|
174 ;; Eliminates the version entries
|
|
|
175 (or (car ent) ; file-directory-p
|
|
|
176 (efs-save-match-data
|
|
|
177 (string-match "\\.[0-9]+$" file))))
|
|
|
178
|
|
|
179 (efs-defun efs-delete-file-entry tops-20 (path &optional dir-p)
|
|
|
180 (let ((ignore-case (memq 'tops-20 efs-case-insensitive-host-types)))
|
|
|
181 (if dir-p
|
|
|
182 (let ((path (file-name-as-directory path))
|
|
|
183 files)
|
|
|
184 (efs-del-hash-entry path efs-files-hashtable ignore-case)
|
|
|
185 (setq path (directory-file-name path)
|
|
|
186 files (efs-get-hash-entry (file-name-directory path)
|
|
|
187 efs-files-hashtable
|
|
|
188 ignore-case))
|
|
|
189 (if files
|
|
|
190 (efs-del-hash-entry (efs-get-file-part path)
|
|
|
191 files ignore-case)))
|
|
|
192 (efs-save-match-data
|
|
|
193 (let ((file (efs-get-file-part path)))
|
|
|
194 (if (string-match "\\.[0-9]+$" file)
|
|
|
195 ;; Only delete explicit versions
|
|
|
196 (let ((files (efs-get-hash-entry
|
|
|
197 (file-name-directory path)
|
|
|
198 efs-files-hashtable ignore-case)))
|
|
|
199 (if files
|
|
|
200 (let ((root (substring file 0
|
|
|
201 (match-beginning 0)))
|
|
|
202 (completion-ignore-case ignore-case)
|
|
|
203 (len (match-beginning 0)))
|
|
|
204 (efs-del-hash-entry file files ignore-case)
|
|
|
205 ;; Now we need to check if there are any
|
|
|
206 ;; versions left. If not, then delete the
|
|
|
207 ;; root entry.
|
|
|
208 (or (all-completions
|
|
|
209 root files
|
|
|
210 (function
|
|
|
211 (lambda (sym)
|
|
|
212 (string-match "\\.[0-9]+$"
|
|
|
213 (symbol-name sym) len))))
|
|
|
214 (efs-del-hash-entry root files
|
|
|
215 ignore-case)))))))))
|
|
|
216 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
217
|
|
|
218 (efs-defun efs-add-file-entry tops-20
|
|
|
219 (path dir-p size owner &optional modes nlinks mdtm)
|
|
|
220 ;; The tops-20 version of this function needs to keep track
|
|
|
221 ;; of tops-20's file versions.
|
|
|
222 (let ((ignore-case (memq 'tops-20 efs-case-insensitive-host-types))
|
|
|
223 (ent (let ((dir-p (null (null dir-p))))
|
|
|
224 (if mdtm
|
|
|
225 (list dir-p size owner nil nil mdtm)
|
|
|
226 (list dir-p size owner)))))
|
|
|
227 (if dir-p
|
|
|
228 (let* ((path (directory-file-name path))
|
|
|
229 (files (efs-get-hash-entry (file-name-directory path)
|
|
|
230 efs-files-hashtable
|
|
|
231 ignore-case)))
|
|
|
232 (if files
|
|
|
233 (efs-put-hash-entry (efs-get-file-part path)
|
|
|
234 ent files ignore-case)))
|
|
|
235 (let ((files (efs-get-hash-entry
|
|
|
236 (file-name-directory path)
|
|
|
237 efs-files-hashtable ignore-case)))
|
|
|
238 (if files
|
|
|
239 (let ((file (efs-get-file-part path)))
|
|
|
240 (efs-save-match-data
|
|
|
241 (if (string-match "\\.[0-9]+$" file)
|
|
|
242 (efs-put-hash-entry
|
|
|
243 (substring file 0 (match-beginning 0))
|
|
|
244 ent files ignore-case)
|
|
|
245 ;; Need to figure out what version of the file
|
|
|
246 ;; is being added.
|
|
|
247 (let* ((completion-ignore-case ignore-case)
|
|
|
248 (len (length file))
|
|
|
249 (versions (all-completions
|
|
|
250 file files
|
|
|
251 (function
|
|
|
252 (lambda (sym)
|
|
|
253 (string-match "\\.[0-9]+$"
|
|
|
254 (symbol-name sym) len)))))
|
|
|
255 (N (1+ len))
|
|
|
256 (max (apply
|
|
|
257 'max
|
|
|
258 (cons 0 (mapcar
|
|
|
259 (function
|
|
|
260 (lambda (x)
|
|
|
261 (string-to-int (substring x N))))
|
|
|
262 versions)))))
|
|
|
263 ;; No need to worry about case here.
|
|
|
264 (efs-put-hash-entry
|
|
|
265 (concat file "." (int-to-string (1+ max))) ent files))))
|
|
|
266 (efs-put-hash-entry file ent files ignore-case)))))
|
|
|
267 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
268
|
|
|
269 (efs-defun efs-internal-file-name-as-directory tops-20 (name)
|
|
|
270 (efs-save-match-data
|
|
|
271 (if (string-match "\\.DIRECTORY\\(\\.[0-9>]\\)?$" name)
|
|
|
272 (setq name (substring name 0 (match-beginning 0))))
|
|
|
273 (let (file-name-handler-alist)
|
|
|
274 (file-name-as-directory name))))
|
|
|
275
|
|
|
276 ;;; Tree Dired
|
|
|
277
|
|
|
278 (defconst efs-dired-tops-20-re-dir
|
|
|
279 "^[^\n]+\\.DIRECTORY\\(\\.[0-9]+\\)?$")
|
|
|
280
|
|
|
281 (or (assq 'tops-20 efs-dired-re-dir-alist)
|
|
|
282 (setq efs-dired-re-dir-alist
|
|
|
283 (cons (cons 'tops-20 efs-dired-tops-20-re-dir)
|
|
|
284 efs-dired-re-dir-alist)))
|
|
|
285
|
|
|
286
|
|
|
287 (efs-defun efs-dired-manual-move-to-filename tops-20
|
|
|
288 (&optional raise-error bol eol)
|
|
|
289 ;; In dired, move to first char of filename on this line.
|
|
|
290 ;; Returns position (point) or nil if no filename on this line.
|
|
|
291 ;; This is the Tops-20 version.
|
|
|
292 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
293 (let (case-fold-search)
|
|
|
294 (if bol
|
|
|
295 (goto-char bol)
|
|
|
296 (skip-chars-backward "^\n\r"))
|
|
|
297 (if (re-search-forward efs-tops-20-date-regexp eol t)
|
|
|
298 (point)
|
|
|
299 (and raise-error (error "No file on this line")))))
|
|
|
300
|
|
|
301 (efs-defun efs-dired-manual-move-to-end-of-filename tops-20
|
|
|
302 (&optional no-error bol eol)
|
|
|
303 ;; Assumes point is at beginning of filename.
|
|
|
304 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
305 ;; On failure, signals an error or returns nil.
|
|
|
306 ;; This is the Tops-20 version.
|
|
|
307 (let ((opoint (point)))
|
|
|
308 (and selective-display
|
|
|
309 (null no-error)
|
|
|
310 (eq (char-after
|
|
|
311 (1- (or bol (save-excursion
|
|
|
312 (skip-chars-backward "^\r\n")
|
|
|
313 (point)))))
|
|
|
314 ?\r)
|
|
|
315 ;; File is hidden or omitted.
|
|
|
316 (cond
|
|
|
317 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
318 (error
|
|
|
319 (substitute-command-keys
|
|
|
320 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
321 ((error
|
|
|
322 (substitute-command-keys
|
|
|
323 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
324 )))))
|
|
|
325 ;; Is this the right character set?
|
|
|
326 (skip-chars-forward "-_A-Z0-9$.;")
|
|
|
327 (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r))))
|
|
|
328 (if no-error
|
|
|
329 nil
|
|
|
330 (error "No file on this line"))
|
|
|
331 (point))))
|
|
|
332
|
|
|
333 (efs-defun efs-internal--file-name-sans-versions tops-20
|
|
|
334 (name &optional keep-backup-version)
|
|
|
335 (efs-save-match-data
|
|
|
336 (if (string-match "\\.[0-9]+$" name)
|
|
|
337 (substring name 0 (match-beginning 0))
|
|
|
338 name)))
|
|
|
339
|
|
|
340 (efs-defun efs-dired-insert-headerline tops-20 (dir)
|
|
|
341 ;; TOPS-20 inserts a headerline. I would prefer the headerline
|
|
|
342 ;; to be in efs format. This version tries to
|
|
|
343 ;; be careful, because we can't count on a headerline
|
|
|
344 ;; over ftp, and we wouldn't want to delete anything
|
|
|
345 ;; important.
|
|
|
346 (save-excursion
|
|
|
347 (if (looking-at "^ wildcard ")
|
|
|
348 (forward-line 1))
|
|
|
349 (if (looking-at "^[ \n\t]*[^:/<>]+:<[^<>/]+> *\n")
|
|
|
350 (delete-region (point) (match-end 0)))
|
|
|
351 (insert " " (directory-file-name dir) ":\n\n")))
|
|
|
352
|
|
|
353 ;;; end of efs-tops-20.el
|
