|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-vos.el
|
|
|
5 ;; Description: VOS support for efs
|
|
|
6 ;; Release: $efs release: 1.15 $
|
|
42
|
7 ;; Version: #Revision: 1.1 $
|
|
22
|
8 ;; RCS:
|
|
|
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
10 ;; Created: Sat Apr 3 03:05:00 1993 by sandy on ibm550
|
|
|
11 ;; Modified: Sun Nov 27 18:45:24 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 ;;; The original ange-ftp VOS support was written by Joe Wells <jbw@cs.bu.edu>
|
|
|
20
|
|
|
21 ;;; Thank you to Jim Franklin <jimf%shared@uunet.uu.net> for providing
|
|
|
22 ;;; information on the VOS operating system.
|
|
|
23
|
|
|
24 (provide 'efs-vos)
|
|
|
25 (require 'efs)
|
|
|
26
|
|
|
27 (defconst efs-vos-version
|
|
|
28 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
29 "/"
|
|
42
|
30 (substring "#Revision: 1.1 $" 11 -2)))
|
|
22
|
31
|
|
|
32 ;;;;---------------------------------------------------------------
|
|
|
33 ;;;; VOS support for efs
|
|
|
34 ;;;;---------------------------------------------------------------
|
|
|
35
|
|
|
36 ;;; A legal VOS pathname is of the form:
|
|
|
37 ;;; %systemname#diskname>dirname>dirname>dir-or-filename
|
|
|
38 ;;;
|
|
|
39 ;;; Each of systemname, diskname, dirname, dir-or-filename can be
|
|
|
40 ;;; at most 32 characters.
|
|
|
41 ;;; Valid characters are all alpha, upper and lower case, all digits,
|
|
|
42 ;;; plus: @[]\^`{|}~"$+,-./:_
|
|
|
43 ;;; restrictions: name cannot begin with hyphen (-) or period (.)
|
|
|
44 ;;; name must not end with a period (.)
|
|
|
45 ;;; name must not contain two adjacent periods (.)
|
|
|
46 ;;;
|
|
|
47 ;;; Invalid characters are:
|
|
|
48 ;;; non-printing control characters
|
|
|
49 ;;; SPACE and DEL
|
|
|
50 ;;; !#%&'()*;<=>?
|
|
|
51 ;;; all other ascii chars
|
|
|
52 ;;;
|
|
|
53 ;;; The full pathname must be less than or equal to 256 characters.
|
|
|
54 ;;; VOS pathnames are CASE-SENSITIVE.
|
|
|
55 ;;; The may be a directory depth limitation of 10 (newer versions may have
|
|
|
56 ;;; eliminated this).
|
|
|
57
|
|
|
58 ;;; entry points
|
|
|
59
|
|
|
60 (efs-defun efs-fix-path vos (path &optional reverse)
|
|
|
61 ;; Convert PATH from UNIX-ish to VOS.
|
|
|
62 ;; If REVERSE given then convert from VOS to UNIX-ish.
|
|
|
63 ;; Does crude checking for valid path syntax, but is by no means exhaustive.
|
|
|
64 (efs-save-match-data
|
|
|
65 (if reverse
|
|
|
66 (if (string-match "^\\(\\(%[^#>%]+\\)?#[^>#%]+\\)?>[^>#%]" path)
|
|
|
67 (let ((marker (1- (match-end 0)))
|
|
|
68 (result "/")
|
|
|
69 system drive)
|
|
|
70 (if (match-beginning 1)
|
|
|
71 (if (match-beginning 2)
|
|
|
72 (setq system (substring path 1 (match-end 2))
|
|
|
73 drive (substring path (1+ (match-end 2))
|
|
|
74 (match-end 1)))
|
|
|
75 (setq drive (substring 1 (match-end 1)))))
|
|
|
76 (while (string-match ">" path marker)
|
|
|
77 (setq result (concat result
|
|
|
78 (substring path marker
|
|
|
79 (match-beginning 0))
|
|
|
80 "/")
|
|
|
81 marker (match-end 0)))
|
|
|
82 (if drive
|
|
|
83 (if system
|
|
|
84 (concat "/" system "/" drive result
|
|
|
85 (substring path marker))
|
|
|
86 (concat "/" drive result (substring path marker)))
|
|
|
87 (concat result (substring path marker))))
|
|
|
88 (error "Invalid VOS pathname %s" path))
|
|
|
89 (if (string-match "^/\\([^/]+\\)/\\([^/]+\\)/[^/]" path)
|
|
|
90 (let ((marker (1- (match-end 0)))
|
|
|
91 (result (concat "%"
|
|
|
92 (substring path
|
|
|
93 (match-beginning 1)
|
|
|
94 (match-end 1))
|
|
|
95 "#"
|
|
|
96 (substring path
|
|
|
97 (match-beginning 2)
|
|
|
98 (match-end 2))
|
|
|
99 ">")))
|
|
|
100 ;; I'm guessing that VOS doesn't have a directory syntax.
|
|
|
101 (setq path (efs-internal-directory-file-name path))
|
|
|
102 (while (string-match "/" path marker)
|
|
|
103 (setq result
|
|
|
104 (concat result
|
|
|
105 (substring path marker
|
|
|
106 (match-beginning 0))
|
|
|
107 ">")
|
|
|
108 marker (match-end 0)))
|
|
|
109 (concat result (substring path marker)))
|
|
|
110 (error "Cannot convert path %s to VOS." path)))))
|
|
|
111
|
|
|
112 (efs-defun efs-fix-dir-path vos (dir-path)
|
|
|
113 ;; Convert path from UNIX-ish to VMS ready for a DIRectory listing.
|
|
|
114 (cond ((string-equal dir-path "/")
|
|
|
115 (error "Cannot gork VOS system names"))
|
|
|
116 ((string-match "^/[^/]/$" dir-path)
|
|
|
117 (error "Cannot grok VOS devices"))
|
|
|
118 ((efs-fix-path 'vos dir-path))))
|
|
|
119
|
|
|
120 (defconst efs-vos-date-and-time-regexp
|
|
|
121 (concat
|
|
|
122 "\\(^\\| \\)" ; For links, this must match at the beginning of the line.
|
|
|
123 "[678901][0-9]-[01][0-9]-[0-3][0-9] [012][0-9]:[0-6][0-9]:[0-6][0-9] "))
|
|
|
124 ;; Regexp to match a VOS file line. The end of the regexp must correspond
|
|
|
125 ;; to the start of the filename.
|
|
|
126
|
|
|
127 (defmacro efs-vos-parse-filename ()
|
|
|
128 ;; Return the VOS filename on the current line of a listing.
|
|
|
129 ;; Assumes that the point is at the beginning of the line.
|
|
|
130 ;; Return nil if no filename is found.
|
|
|
131 (` (let ((eol (save-excursion (end-of-line) (point))))
|
|
|
132 (and (re-search-forward efs-vos-date-and-time-regexp eol t)
|
|
|
133 (buffer-substring (point) eol)))))
|
|
|
134
|
|
|
135 (efs-defun efs-parse-listing vos
|
|
|
136 (host user dir path &optional switches)
|
|
|
137 ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
|
|
|
138 ;; format, and return a hashtable as the result. SWITCHES are never used,
|
|
|
139 ;; but they must be specified in the argument list for compatibility
|
|
|
140 ;; with the unix version of this function.
|
|
|
141 ;; HOST = remote host name
|
|
|
142 ;; USER = user name
|
|
|
143 ;; DIR = directory in as a full remote path
|
|
|
144 ;; PATH = directory in full efs path syntax
|
|
|
145 ;; SWITCHES = ls switches (not relevant here)
|
|
|
146 (goto-char (point-min))
|
|
|
147 (efs-save-match-data
|
|
|
148 (let (tbl file)
|
|
|
149 ;; Look file files.
|
|
|
150 (if (search-forward "\nFiles: " nil t)
|
|
|
151 (progn
|
|
|
152 (setq tbl (efs-make-hashtable))
|
|
|
153 (forward-line 1)
|
|
|
154 (skip-chars-forward "\n")
|
|
|
155 (while (setq file (efs-vos-parse-filename))
|
|
|
156 (efs-put-hash-entry file '(nil) tbl)
|
|
|
157 (forward-line 1))))
|
|
|
158 ;; Look for directories.
|
|
|
159 (if (search-forward "\nDirs: " nil t)
|
|
|
160 (progn
|
|
|
161 (or tbl (setq tbl (efs-make-hashtable)))
|
|
|
162 (forward-line 1)
|
|
|
163 (skip-chars-forward "\n")
|
|
|
164 (while (setq file (efs-vos-parse-filename))
|
|
|
165 (efs-put-hash-entry file '(t) tbl)
|
|
|
166 (forward-line 1))))
|
|
|
167 ;; Look for links
|
|
|
168 (if (search-forward "\nLinks: " nil t)
|
|
|
169 (let (link)
|
|
|
170 (or tbl (setq tbl (efs-make-hashtable)))
|
|
|
171 (forward-line 1)
|
|
|
172 (skip-chars-forward "\n")
|
|
|
173 (while (setq file (efs-vos-parse-filename))
|
|
|
174 (if (string-match " -> \\([^ ]+\\)" file)
|
|
|
175 ;; VOS puts a trailing blank after the name of a symlink
|
|
|
176 ;; target. Go figure...
|
|
|
177 (setq link (substring file (match-beginning 1) (match-end 1))
|
|
|
178 file (substring file 0 (match-beginning 0)))
|
|
|
179 (setq link "")) ; weird?
|
|
|
180 (efs-put-hash-entry file (list link) tbl)
|
|
|
181 (forward-line 1))))
|
|
|
182 ;; This returns nil if no headings for files, dirs, or links
|
|
|
183 ;; are found. In this case, we're assuming that it isn't a valid
|
|
|
184 ;; listing.
|
|
|
185 (if tbl
|
|
|
186 (progn
|
|
|
187 (efs-put-hash-entry "." '(t) tbl)
|
|
|
188 (efs-put-hash-entry ".." '(t) tbl)))
|
|
|
189 tbl)))
|
|
|
190
|
|
|
191 (efs-defun efs-allow-child-lookup vos (host user dir file)
|
|
|
192 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
193 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
194 ;; be attempted.
|
|
|
195 ;; Directoried don't have a size.
|
|
|
196 (string-match ": not a file\\.$"
|
|
|
197 (cdr (efs-send-size host user (concat dir file)))))
|
|
|
198
|
|
|
199 ;;; Tree Dired Support
|
|
|
200
|
|
|
201 (defconst efs-dired-vos-re-exe
|
|
|
202 "^. +e ")
|
|
|
203
|
|
|
204 (or (assq 'vos efs-dired-re-exe-alist)
|
|
|
205 (setq efs-dired-re-exe-alist
|
|
|
206 (cons (cons 'vos efs-dired-vos-re-exe)
|
|
|
207 efs-dired-re-exe-alist)))
|
|
|
208
|
|
|
209 (defconst efs-dired-vos-re-dir
|
|
|
210 "^. +[nsm] +[0-9]+ +[678901][0-9]-")
|
|
|
211
|
|
|
212 (or (assq 'vos efs-dired-re-dir-alist)
|
|
|
213 (setq efs-dired-re-dir-alist
|
|
|
214 (cons (cons 'vos efs-dired-vos-re-dir)
|
|
|
215 efs-dired-re-dir-alist)))
|
|
|
216
|
|
|
217 (efs-defun efs-dired-manual-move-to-filename vos
|
|
|
218 (&optional raise-error bol eol)
|
|
|
219 ;; In dired, move to the first char of filename on this line, where
|
|
|
220 ;; line can be delimited by either \r or \n.
|
|
|
221 ;; Returns (point) or nil if raise-error is nil and there is no
|
|
|
222 ;; filename on this line. In the later case, leaves the point at the
|
|
|
223 ;; beginning of the line.
|
|
|
224 ;; This version is for VOS.
|
|
|
225 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
|
|
|
226 (let (case-fold-search)
|
|
|
227 (if bol
|
|
|
228 (goto-char bol)
|
|
|
229 (skip-chars-backward "^\n\r"))
|
|
|
230 (if (re-search-forward efs-vos-date-and-time-regexp eol t)
|
|
|
231 (point)
|
|
|
232 (and raise-error (error "No file on this line")))))
|
|
|
233
|
|
|
234 (efs-defun efs-dired-manual-move-to-end-of-filename vos
|
|
|
235 (&optional no-error bol eol)
|
|
|
236 ;; Assumes point is at the beginning of filename.
|
|
|
237 ;; So, it should be called only after (dired-move-to-filename t)
|
|
|
238 ;; On failure signals an error, or returns nil.
|
|
|
239 ;; This is the VOS version.
|
|
|
240 (let ((opoint (point)))
|
|
|
241 (and selective-display
|
|
|
242 (null no-error)
|
|
|
243 (eq (char-after
|
|
|
244 (1- (or bol (save-excursion
|
|
|
245 (skip-chars-backward "^\r\n")
|
|
|
246 (point)))))
|
|
|
247 ?\r)
|
|
|
248 ;; File is hidden or omitted.
|
|
|
249 (cond
|
|
|
250 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
251 (error
|
|
|
252 (substitute-command-keys
|
|
|
253 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
254 ((error
|
|
|
255 (substitute-command-keys
|
|
|
256 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
257 )))))
|
|
|
258 (skip-chars-forward "-a-zA-Z0-9@[]\\^`{|}~\"$+,./:_")
|
|
|
259 (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
|
|
|
260 (if no-error
|
|
|
261 nil
|
|
|
262 (error "No file on this line"))
|
|
|
263 (point))))
|
|
|
264
|
|
|
265 (efs-defun efs-dired-fixup-listing vos (file path &optional switches wildcard)
|
|
|
266 ;; VOS listing contain some empty lines, which is inconvenient for dired.
|
|
|
267 (goto-char (point-min))
|
|
|
268 (skip-chars-forward "\n")
|
|
|
269 (delete-region (point-min) (point))
|
|
|
270 (while (search-forward "\n\n" nil t)
|
|
|
271 (forward-char -2)
|
|
|
272 (delete-char 1)))
|
|
|
273
|
|
|
274 (efs-defun efs-dired-ls-trim vos ()
|
|
|
275 ;; Trims VOS dir listings for single files, so that they are exactly one line
|
|
|
276 ;; long.
|
|
|
277 (goto-char (point-min))
|
|
|
278 (let (case-fold-search)
|
|
|
279 (re-search-forward efs-vos-date-and-time-regexp))
|
|
|
280 (beginning-of-line)
|
|
|
281 (delete-region (point-min) (point))
|
|
|
282 (forward-line 1)
|
|
|
283 (delete-region (point) (point-max)))
|
|
|
284
|
|
|
285 ;;; end of efs-vos.el
|
