Mercurial > hg > xemacs-beta

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