Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-ti-twenex.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 8b8b7f3559a2 8619ce7e4c50
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
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