|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-ti-twenex.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: Support for a TI lisp machine in Twenex emulation mode.
|
|
|
9 ;; Author: Jamie Zawinski <jwz@lucid.com>
|
|
|
10 ;; Created: Thu Dec 17 15:04:14 1992
|
|
|
11 ;; Modified: Sun Nov 27 18:43:17 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 (provide 'efs-ti-twenex)
|
|
|
20 (require 'efs)
|
|
|
21
|
|
|
22 (defconst efs-ti-twenex-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
|
25 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
26
|
|
|
27 ;;;; ------------------------------------------------------------
|
|
|
28 ;;;; Twenex support.
|
|
|
29 ;;;; ------------------------------------------------------------
|
|
|
30 ;;; Written for an explorer in ti-twenex mode. Twenex is supposed to be just
|
|
|
31 ;;; MIT's name for tops-20, but an explorer emulating twenex is not the same
|
|
|
32 ;;; thing.
|
|
|
33
|
|
|
34 (defconst efs-ti-twenex-filename-regexp
|
|
|
35 (let* ((excluded-chars ":;<>.#\n\r\ta-z")
|
|
|
36 (token (concat "[^" excluded-chars "]+"))
|
|
|
37 (token* (concat "[^" excluded-chars "]*")))
|
|
|
38 (concat "\\(" token ": *" "\\)?" ; optional device
|
|
|
39 "<\\(" token "\\)?\\(\\." token "\\)*> *" ; directory
|
|
|
40 "\\(" token* "." token* "\\|\\) *" ; name and extension
|
|
|
41 "\\(\\. *-?\\([0-9]+\\|>\\)\\)?"))) ; version
|
|
|
42
|
|
|
43 ;;; The above isn't entirely accurate, because "/" can quote any character
|
|
|
44 ;;; anywhere in a pathname.
|
|
|
45
|
|
|
46 (efs-defun efs-fix-path ti-twenex (path &optional reverse)
|
|
|
47 ;; Convert PATH from UNIX-ish to Twenex. If REVERSE given then convert
|
|
|
48 ;; from Twenex to UNIX-ish.
|
|
|
49 (efs-save-match-data
|
|
|
50 (if reverse
|
|
|
51 (if (string-match
|
|
|
52 "^\\([^:]+:\\)? *\\([^:]+:\\)? *<\\([^>]*\\)> *\\(.*\\)$"
|
|
|
53 path)
|
|
|
54 (let (dir file)
|
|
|
55 ;; I don't understand how "devices" work, so I'm ignoring them.
|
|
|
56 ;; (if (match-beginning 2)
|
|
|
57 ;; (setq device (substring path
|
|
|
58 ;; (match-beginning 2)
|
|
|
59 ;; (1- (match-end 2)))))
|
|
|
60 (if (match-beginning 3)
|
|
|
61 (setq dir
|
|
|
62 (substring path (match-beginning 3) (match-end 3))))
|
|
|
63 (if (match-beginning 4)
|
|
|
64 (setq file
|
|
|
65 (substring path (match-beginning 4) (match-end 4))))
|
|
|
66 (cond (dir
|
|
|
67 (setq dir (apply (function concat)
|
|
|
68 (mapcar (function
|
|
|
69 (lambda (char)
|
|
|
70 (if (= char ?.)
|
|
|
71 (vector ?/)
|
|
|
72 (vector char))))
|
|
|
73 dir)))
|
|
|
74 (if (string-match "^/" dir)
|
|
|
75 (setq dir (substring dir 1))
|
|
|
76 (setq dir (concat "/" dir)))))
|
|
|
77 (concat
|
|
|
78 ;; (and device ":") device (and device ":")
|
|
|
79 dir (and dir "/")
|
|
|
80 file))
|
|
|
81 (error "path %s didn't match ti-twenex syntax" path))
|
|
|
82 (let (dir file tmp)
|
|
|
83 ;; (if (string-match "^/[^:]+:" path)
|
|
|
84 ;; (setq device (substring path 1
|
|
|
85 ;; (1- (match-end 0)))
|
|
|
86 ;; path (substring path (match-end 0))))
|
|
|
87 (cond ((setq tmp (file-name-directory path))
|
|
|
88 (setq dir (apply (function concat)
|
|
|
89 (mapcar (function
|
|
|
90 (lambda (char)
|
|
|
91 (if (= char ?/)
|
|
|
92 (vector ?.)
|
|
|
93 (vector char))))
|
|
|
94 (substring tmp 0 -1))))
|
|
|
95 (if (string-match "^[.]" dir)
|
|
|
96 (setq dir (substring dir 1))
|
|
|
97 (setq dir (concat "." dir)))))
|
|
|
98 (setq file (file-name-nondirectory path))
|
|
|
99 (concat
|
|
|
100 ;; (and device ":") device (and device ":")
|
|
|
101 (and dir "<")
|
|
|
102 dir
|
|
|
103 (and dir ">")
|
|
|
104 file)))))
|
|
|
105
|
|
|
106 ;; (efs-fix-path-for-twenex "/PUBLIC/ZMACS/ZYMURG.LISP.1")
|
|
|
107 ;; (efs-fix-path-for-twenex "<PUBLIC.ZMACS>ZYMURG.LISP.1" t)
|
|
|
108
|
|
|
109 (efs-defun efs-fix-dir-path ti-twenex (dir-path)
|
|
|
110 ;; Convert path from UNIX-ish to Explorer ready for a DIRectory listing.
|
|
|
111 (cond ((string-equal dir-path "/")
|
|
|
112 (efs-fix-path 'ti-twenex "/~/" nil))
|
|
|
113 ((string-match "^/[-A-Z0-9_$]+:/" dir-path)
|
|
|
114 (error "Don't grok TWENEX \"devices\" yet."))
|
|
|
115 ((efs-fix-path 'ti-twenex dir-path nil))))
|
|
|
116
|
|
|
117 (defmacro efs-parse-ti-twenex-filename ()
|
|
|
118 ;; Extract the next filename from an Explorer dired-like listing.
|
|
|
119 (` (if (re-search-forward
|
|
|
120 efs-ti-twenex-filename-regexp
|
|
|
121 nil t)
|
|
|
122 (buffer-substring (match-beginning 0) (match-end 0)))))
|
|
|
123
|
|
|
124 (efs-defun efs-parse-listing ti-twenex
|
|
|
125 (host user dir path &optional switches)
|
|
|
126 ;; Parse the current buffer which is assumed to be a TWENEX directory
|
|
|
127 ;; listing, and return a hashtable as the result.
|
|
|
128 ;; HOST = remote host name
|
|
|
129 ;; USER = user name
|
|
|
130 ;; DIR = directory in as a full remote path
|
|
|
131 ;; PATH = directory in full efs path syntax
|
|
|
132 ;; SWITCHES = ls switches (not relevant here)
|
|
|
133 (let ((tbl (efs-make-hashtable))
|
|
|
134 file)
|
|
|
135 (goto-char (point-min))
|
|
|
136 (efs-save-match-data
|
|
|
137 (while (setq file (efs-parse-ti-twenex-filename))
|
|
|
138 ;; Explorer/Twenex listings might come out in absolute form.
|
|
|
139 (if (string-match "^[^>]*> *" file)
|
|
|
140 (setq file (substring file (match-end 0))))
|
|
|
141 (if (string-match "\\.\\(DIRECTORY\\|directory\\).[0-9]+$" file)
|
|
|
142 ;; deal with directories
|
|
|
143 (efs-put-hash-entry
|
|
|
144 (substring file 0 (match-beginning 0)) '(t) tbl)
|
|
|
145 (efs-put-hash-entry file '(nil) tbl)
|
|
|
146 (if (string-match "\\.[0-9]+$" file) ; deal with extension
|
|
|
147 ;; sans extension
|
|
|
148 (efs-put-hash-entry
|
|
|
149 (substring file 0 (match-beginning 0)) '(nil) tbl)))
|
|
|
150 (forward-line 1))
|
|
|
151 (efs-put-hash-entry "." '(t) tbl)
|
|
|
152 (efs-put-hash-entry ".." '(t) tbl))
|
|
|
153 tbl))
|
|
|
154
|
|
|
155 (efs-defun efs-really-file-p ti-twenex (file ent)
|
|
|
156 ;; Eliminates the version entries
|
|
|
157 (or (car ent) ; file-directory-p
|
|
|
158 (efs-save-match-data
|
|
|
159 (string-match "\\.[0-9]+$" file))))
|
|
|
160
|
|
|
161 (efs-defun efs-delete-file-entry ti-twenex (path &optional dir-p)
|
|
|
162 (let ((ignore-case (memq 'ti-twenex efs-case-insensitive-host-types)))
|
|
|
163 (if dir-p
|
|
|
164 (let ((path (file-name-as-directory path))
|
|
|
165 files)
|
|
|
166 (efs-del-hash-entry path efs-files-hashtable ignore-case)
|
|
|
167 (setq path (directory-file-name path)
|
|
|
168 files (efs-get-hash-entry (file-name-directory path)
|
|
|
169 efs-files-hashtable
|
|
|
170 ignore-case))
|
|
|
171 (if files
|
|
|
172 (efs-del-hash-entry (efs-get-file-part path)
|
|
|
173 files ignore-case)))
|
|
|
174 (efs-save-match-data
|
|
|
175 (let ((file (efs-get-file-part path)))
|
|
|
176 (if (string-match "\\.[0-9]+$" file)
|
|
|
177 ;; Only delete versions with explicit version numbers.
|
|
|
178 (let ((files (efs-get-hash-entry
|
|
|
179 (file-name-directory path)
|
|
|
180 efs-files-hashtable ignore-case)))
|
|
|
181 (if files
|
|
|
182 (let ((root (substring file 0
|
|
|
183 (match-beginning 0)))
|
|
|
184 (completion-ignore-case ignore-case)
|
|
|
185 (len (match-beginning 0)))
|
|
|
186 (efs-del-hash-entry file files ignore-case)
|
|
|
187 ;; Now we need to check if there are any
|
|
|
188 ;; versions left. If not, then delete the
|
|
|
189 ;; root entry.
|
|
|
190 (or (all-completions
|
|
|
191 root files
|
|
|
192 (function
|
|
|
193 (lambda (sym)
|
|
|
194 (string-match "\\.[0-9]+$"
|
|
|
195 (symbol-name sym) len))))
|
|
|
196 (efs-del-hash-entry root files
|
|
|
197 ignore-case)))))))))
|
|
|
198 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
199
|
|
|
200 (efs-defun efs-add-file-entry ti-twenex
|
|
|
201 (path dir-p size owner &optional modes nlinks mdtm)
|
|
|
202 ;; The ti-twenex version of this function needs to keep track
|
|
|
203 ;; of ti-twenex's file versions.
|
|
|
204 (let ((ignore-case (memq 'ti-twenex efs-case-insensitive-host-types))
|
|
|
205 (ent (let ((dir-p (null (null dir-p))))
|
|
|
206 (if mdtm
|
|
|
207 (list dir-p size owner nil nil mdtm)
|
|
|
208 (list dir-p size owner)))))
|
|
|
209 (if dir-p
|
|
|
210 (let* ((path (directory-file-name path))
|
|
|
211 (files (efs-get-hash-entry (file-name-directory path)
|
|
|
212 efs-files-hashtable
|
|
|
213 ignore-case)))
|
|
|
214 (if files
|
|
|
215 (efs-put-hash-entry (efs-get-file-part path)
|
|
|
216 ent files ignore-case)))
|
|
|
217 (let ((files (efs-get-hash-entry
|
|
|
218 (file-name-directory path)
|
|
|
219 efs-files-hashtable ignore-case)))
|
|
|
220 (if files
|
|
|
221 (let ((file (efs-get-file-part path)))
|
|
|
222 (efs-save-match-data
|
|
|
223 (if (string-match "\\.[0-9]+$" file)
|
|
|
224 (efs-put-hash-entry
|
|
|
225 (substring file 0 (match-beginning 0))
|
|
|
226 ent files ignore-case)
|
|
|
227 ;; Need to figure out what version of the file
|
|
|
228 ;; is being added.
|
|
|
229 (let* ((completion-ignore-case ignore-case)
|
|
|
230 (len (length file))
|
|
|
231 (versions (all-completions
|
|
|
232 file files
|
|
|
233 (function
|
|
|
234 (lambda (sym)
|
|
|
235 (string-match "\\.[0-9]+$"
|
|
|
236 (symbol-name sym) len)))))
|
|
|
237 (N (1+ len))
|
|
|
238 (max (apply
|
|
|
239 'max
|
|
|
240 (cons 0 (mapcar
|
|
|
241 (function
|
|
|
242 (lambda (x)
|
|
|
243 (string-to-int (substring x N))))
|
|
|
244 versions)))))
|
|
|
245 ;; No need to worry about case here.
|
|
|
246 (efs-put-hash-entry
|
|
|
247 (concat file "." (int-to-string (1+ max))) ent files))))
|
|
|
248 (efs-put-hash-entry file ent files ignore-case)))))
|
|
|
249 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
250
|
|
|
251 (efs-defun efs-internal-file-name-as-directory ti-twenex (name)
|
|
|
252 (efs-save-match-data
|
|
|
253 (if (string-match "\\.\\(DIRECTORY\\|directory\\)\\(\\.[0-9>]\\)?$" name)
|
|
|
254 (setq name (substring name 0 (match-beginning 0))))
|
|
|
255 (let (file-name-handler-alist)
|
|
|
256 (file-name-as-directory name))))
|
|
|
257
|
|
|
258 (efs-defun efs-allow-child-lookup ti-twenex (host user dir file)
|
|
|
259 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
260 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
261 ;; be attempted.
|
|
|
262
|
|
|
263 ;; Subdirs in TI-TWENEX can't have an extension (other than .DIRECTORY,
|
|
|
264 ;; which we have truncated).
|
|
|
265 (not (string-match "\\." file)))
|
|
|
266
|
|
|
267 ;;; Tree Dired
|
|
|
268
|
|
|
269 (defconst efs-dired-ti-twenex-re-dir
|
|
|
270 "^. *[^>\n\r]+>[^>\n\r.]+\\.\\(DIRECTORY\\|directory\\)\\b"
|
|
|
271 "Regular expression to use to search for TWENEX directories.")
|
|
|
272
|
|
|
273 (or (assq 'ti-twenex efs-dired-re-dir-alist)
|
|
|
274 (setq efs-dired-re-dir-alist
|
|
|
275 (cons (cons 'ti-twenex efs-dired-ti-twenex-re-dir)
|
|
|
276 efs-dired-re-dir-alist)))
|
|
|
277
|
|
|
278 (efs-defun efs-dired-manual-move-to-filename ti-twenex
|
|
|
279 (&optional raise-error bol eol)
|
|
|
280 ;; In dired, move to first char of filename on this line.
|
|
|
281 ;; Returns position (point) or nil if no filename on this line.
|
|
|
282 ;; This is the Twenex version.
|
|
|
283 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
284 (let (case-fold-search)
|
|
|
285 (if bol
|
|
|
286 (goto-char bol)
|
|
|
287 (skip-chars-backward "^\n\r"))
|
|
|
288 (if (re-search-forward efs-ti-twenex-filename-regexp eol t)
|
|
|
289 (progn
|
|
|
290 (goto-char (match-beginning 0))
|
|
|
291 ;; Twenex listings might come out in absolute form.
|
|
|
292 (if (looking-at "[^>]*> *")
|
|
|
293 (goto-char (match-end 0))
|
|
|
294 (point)))
|
|
|
295 (and raise-error (error "No file on this line")))))
|
|
|
296
|
|
|
297 (efs-defun efs-dired-manual-move-to-end-of-filename ti-twenex
|
|
|
298 (&optional no-error bol eol)
|
|
|
299 ;; Assumes point is at beginning of filename.
|
|
|
300 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
301 ;; On failure, signals an error or returns nil.
|
|
|
302 ;; This is the Explorer version.
|
|
|
303 (let (case-fold-search)
|
|
|
304 (and selective-display
|
|
|
305 (null no-error)
|
|
|
306 (eq (char-after
|
|
|
307 (1- (or bol (save-excursion
|
|
|
308 (skip-chars-backward "^\r\n")
|
|
|
309 (point)))))
|
|
|
310 ?\r)
|
|
|
311 ;; File is hidden or omitted.
|
|
|
312 (cond
|
|
|
313 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
314 (error
|
|
|
315 (substitute-command-keys
|
|
|
316 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
317 ((error
|
|
|
318 (substitute-command-keys
|
|
|
319 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
320 )))))
|
|
|
321 (if (looking-at efs-ti-twenex-filename-regexp)
|
|
|
322 (goto-char (match-end 0))
|
|
|
323 (if no-error
|
|
|
324 nil
|
|
|
325 (error "No file on this line")))))
|
|
|
326
|
|
|
327 (efs-defun efs-internal-file-name-sans-versions ti-twenex
|
|
|
328 (name &optional keep-backup-version)
|
|
|
329 (efs-save-match-data
|
|
|
330 (if (string-match "\\.[0-9]+$" name)
|
|
|
331 (substring name 0 (match-beginning 0))
|
|
|
332 name)))
|
|
|
333
|
|
|
334 ;;; ### still need to ape these from vms:
|
|
|
335 ;;; efs-dired-vms-clean-directory
|
|
|
336 ;;; efs-dired-vms-collect-file-versions
|
|
|
337 ;;; efs-dired-vms-trample-file-versions
|
|
|
338 ;;; efs-dired-vms-flag-backup-files
|
|
|
339 ;;; efs-dired-vms-backup-diff
|
|
|
340
|
|
|
341 ;;; end of efs-ti-twenex.el
|
