|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-mpe.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: MPE (HP3000) support for efs.
|
|
|
9 ;; Author: (Corny de Souza) cdesouza@hpbbn.bbn.hp.com
|
|
|
10 ;; Created: Fri Jan 15 12:58:29 1993
|
|
|
11 ;; Modified: Sun Nov 27 18:36:13 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 ;;; Credits
|
|
|
20 ;;
|
|
|
21 ;; Sandy Rutherford for his help and advice.
|
|
|
22
|
|
|
23 ;;; Usage
|
|
|
24 ;;
|
|
|
25 ;; For a general description of remote file access see efs.el.
|
|
|
26 ;;
|
|
|
27 ;; MPE Specifics
|
|
|
28 ;;
|
|
|
29 ;; *) To make things easier (for me) MPE has been UNIXified so think UNIX
|
|
|
30 ;; and you stand a good chance of understanding everything.
|
|
|
31 ;;
|
|
|
32 ;; *) Filename syntax is as follows
|
|
|
33 ;;
|
|
|
34 ;; /session,user.account,group@system:/account/group/file;buildparms
|
|
|
35 ;;
|
|
|
36 ;; the "session," and ",group" in the logon sequence are optional.
|
|
|
37 ;;
|
|
|
38 ;; e.g. /CDSUSER.OSCAR@SYSTEM41:/OSCAR/CDSSRC/TST0000S
|
|
|
39 ;; will get the file TST0000S.CDSSRC.OSCAR
|
|
|
40 ;;
|
|
|
41 ;; The ";buildparms" is also optional. It should be used when creating
|
|
|
42 ;; files whos characteristics differ from the default system buildparms,
|
|
|
43 ;; described in the file FTPDOC.ARPA.SYS (at least it is on my system).
|
|
|
44 ;; Also see variable efs-mpe-default-buildparms.
|
|
|
45 ;;
|
|
|
46 ;; e.g. REC=-256,,V,ASCII
|
|
|
47 ;;
|
|
|
48 ;; *) Password syntax is as follows
|
|
|
49 ;;
|
|
|
50 ;; userpass,accountpass,grouppass
|
|
|
51 ;;
|
|
|
52 ;; Leading commas cannot be omitted, trailing commas can.
|
|
|
53 ;; e.g. USERPASS,ACCTPASS (no group password)
|
|
|
54 ;; ,ACCTPASS (only account password)
|
|
|
55 ;; USERPASS,,GRPPASS (no account password)
|
|
|
56 ;;
|
|
|
57 ;; *) Do not use account name completion on large systems. See the variable
|
|
|
58 ;; efs-mpe-account-completion-confirm
|
|
|
59 ;;
|
|
|
60 ;; *) Do not use group name completion on large accounts. See the variable
|
|
|
61 ;; efs-mpe-group-completion-confirm
|
|
|
62 ;;
|
|
|
63 ;; *) The buffers FILE and FILE;BUILDPARMS both point to the same physical
|
|
|
64 ;; disc file.
|
|
|
65 ;;
|
|
|
66 ;; *) When using filename completion you will usually be given the option
|
|
|
67 ;; between FILE and FILE;BUILDPARMS. Just ignore the FILE;BUILDPARMS
|
|
|
68 ;; bit.
|
|
|
69 ;;
|
|
|
70 ;; *) WARNING ********* Two buffer for the same file ************ WARNING
|
|
|
71 ;; If you land up with two buffers FILE and FILE;BUILDPARMS for the same
|
|
|
72 ;; file kill the FILE;BUILDPARMS one. If however this is newwer than
|
|
|
73 ;; the FILE buffer (and you cannot live with a buffer called
|
|
|
74 ;; FILE;BUILDPARMS) save it kill both buffers and get the FILE buffer again.
|
|
|
75 ;;
|
|
|
76 ;; *) When creating new files only create FILES. It is possible to create
|
|
|
77 ;; files as GROUPs and ACCOUNTs but don't!
|
|
|
78 ;;
|
|
|
79 ;;; To Do
|
|
|
80 ;;
|
|
|
81 ;; A lot of things are likely to change with MPE 4.5 and POSIX so I do not want
|
|
|
82 ;; to invest too much time in this now. I would rather wait until I can see
|
|
|
83 ;; what comes with POSIX.
|
|
|
84 ;;
|
|
|
85 ;; Feel free to send bugs, suggestions for enhancements and enhancements
|
|
|
86 ;; to me cdesouza@hpbbn.bbn.hp.com. If I have TIME I will try to deal with
|
|
|
87 ;; them. Also I'm not a lisp programmer so keep it simple or put in plenty
|
|
|
88 ;; of comments.
|
|
|
89 ;;
|
|
|
90 ;;
|
|
|
91 ;; *) Improve on the dired GROUP and ACCOUNT listings.
|
|
|
92 ;;
|
|
|
93 ;; *) Add ".." to dired FILE and GROUP listings.
|
|
|
94 ;;
|
|
|
95 ;; *) Support POSIX (need POSIX machine first though).
|
|
|
96 ;;
|
|
|
97 ;; *) Test ACCOUNT name completion and listings properly. I have the problem
|
|
|
98 ;; that the only systems available to me are large ( i.e. start a listf
|
|
|
99 ;; @.@.@,2 today and come back tomorrow), which makes
|
|
|
100 ;; it pretty hard for me to test.
|
|
|
101 ;;
|
|
|
102
|
|
|
103 ;;; Code
|
|
|
104
|
|
|
105 (provide 'efs-mpe)
|
|
|
106 (require 'efs)
|
|
|
107
|
|
|
108 ;;; User Variables
|
|
|
109
|
|
|
110 (defvar efs-mpe-account-completion-confirm t
|
|
|
111 "*Set to non-nil will cause a prompt to be issued before attempting ACCOUNT
|
|
|
112 name completion. For ACCOUNT name completion a LISTF @.@.@,2 is required.
|
|
|
113 This can take a very long time on large systems")
|
|
|
114
|
|
|
115 (defvar efs-mpe-group-completion-confirm t
|
|
|
116 "*Set to non-nil will cause a prompt to be issued before attempting GROUP
|
|
|
117 name completion. For GROUP name completion a LISTF @.@.ACCOUNT,2 is required.
|
|
|
118 This can take a very long time on large accounts")
|
|
|
119
|
|
|
120 (defvar efs-mpe-default-buildparms ""
|
|
|
121 "*If set to non empty string used to override the system default buildparms.")
|
|
|
122
|
|
|
123 ;;; Internal Variables
|
|
|
124
|
|
|
125 (defconst efs-mpe-version
|
|
|
126 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
127 "/"
|
|
|
128 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
129
|
|
|
130 ;;; Support for build parameters
|
|
|
131
|
|
|
132 (defun efs-mpe-get-buildparms (path)
|
|
|
133 ;; Gets the mpe buildparms for PATH. PATH should be in efs syntax.
|
|
|
134 (let ((files (efs-get-files-hashtable-entry (file-name-directory
|
|
|
135 (directory-file-name path)))))
|
|
|
136 (if files
|
|
|
137 (let* ((file (efs-get-file-part path))
|
|
|
138 (completion-ignore-case
|
|
|
139 (memq 'mpe efs-case-insensitive-host-types))
|
|
|
140 (bpversions (all-completions (concat file ";") files)))
|
|
|
141 (cond
|
|
|
142 ((null bpversions)
|
|
|
143 efs-mpe-default-buildparms)
|
|
|
144 ((= (length bpversions) 1)
|
|
|
145 (substring (car bpversions) (length file)))
|
|
|
146 (t
|
|
|
147 (error
|
|
|
148 "efs-mpe: %s seems to have more than one set of buildparams."
|
|
|
149 path))))
|
|
|
150 ;; return the default
|
|
|
151 efs-mpe-default-buildparms)))
|
|
|
152
|
|
|
153 (defun efs-mpe-fix-buildparms (buildparms host user path)
|
|
|
154 "Try to assign buildparms for the file being PUT"
|
|
|
155 (or
|
|
|
156 ;; Buildparms specified with file use them.
|
|
|
157 buildparms
|
|
|
158 (efs-mpe-get-buildparms (format efs-path-format-string user host path))))
|
|
|
159
|
|
|
160 ;;; entry points
|
|
|
161
|
|
|
162 (efs-defun efs-fix-path mpe (path &optional reverse)
|
|
|
163 ;; Convert PATH from UNIX-ish to MPE. If REVERSE given then convert from
|
|
|
164 ;; MPE to UNIX-ish. N.B. Path does not contain HOST or USER part so the
|
|
|
165 ;; dynamic variables HOST and USER are used.
|
|
|
166 ;; Also uses the dynamic variable CMD0.
|
|
|
167 (efs-save-match-data
|
|
|
168 (if reverse
|
|
|
169 ;; This is never used as we only convert PWD (see below) output in
|
|
|
170 ;; this direction. However I will leave this here should it be
|
|
|
171 ;; required in the future.
|
|
|
172 (if (let ((case-fold-search t))
|
|
|
173 (string-match
|
|
|
174 (concat "^\\([A-Z][A-Z0-9]*\\)" ; file
|
|
|
175 "\\(.[A-Z][A-Z0-9]*\\)" ; group
|
|
|
176 "\\(.[A-Z][A-Z0-9]*\\)$") ; account
|
|
|
177 path))
|
|
|
178 (let (file group account)
|
|
|
179 (setq file (substring path 0 (match-end 1)))
|
|
|
180 (if (match-beginning 2)
|
|
|
181 (setq group (substring
|
|
|
182 path (1+ (match-beginning 2)) (match-end 2))))
|
|
|
183 (if (match-beginning 3)
|
|
|
184 (setq account (substring
|
|
|
185 path (1+ (match-beginning 3))
|
|
|
186 (match-end 3))))
|
|
|
187 (concat (and account (concat "/" account "/"))
|
|
|
188 (and group (concat group "/"))
|
|
|
189 file))
|
|
|
190 ;; handle PWD output
|
|
|
191 (if (let ((case-fold-search t))
|
|
|
192 (string-match
|
|
|
193 (concat
|
|
|
194 "\\([A-Z][A-Z0-9]*\\)?" ; sessionname
|
|
|
195 ",[A-Z][A-Z0-9]*\.\\([A-Z][A-Z0-9]*\\)," ; username.account
|
|
|
196 "\\([A-Z][A-Z0-9]*\\)$") ; group
|
|
|
197 path))
|
|
|
198 (concat "/"
|
|
|
199 (substring path (match-beginning 2) (match-end 2))
|
|
|
200 "/"
|
|
|
201 (substring path (match-beginning 3) (match-end 3))
|
|
|
202 "/")
|
|
|
203 (error "Invalid MPE (MPE->UNIX) filename: %s" path)))
|
|
|
204 (if (let ((case-fold-search t))
|
|
|
205 (string-match
|
|
|
206 (concat
|
|
|
207 "^\\(/[A-Z][A-Z0-9]*/\\)" ; account
|
|
|
208 "\\([A-Z][A-Z0-9]*/\\)" ; group
|
|
|
209 "\\([A-Z][A-Z0-9]*\\)" ; file
|
|
|
210 "\\(;.*\\)?$") ; buildparms
|
|
|
211 path))
|
|
|
212 (let ((for-put (and (boundp 'cmd0) (eq cmd0 'put)))
|
|
|
213 file group account buildparms)
|
|
|
214 (setq account (substring
|
|
|
215 path (1+ (match-beginning 1)) (1- (match-end 1))))
|
|
|
216 (setq group (substring
|
|
|
217 path (match-beginning 2) (1- (match-end 2))))
|
|
|
218 (setq file (substring path (match-beginning 3) (match-end 3)))
|
|
|
219 (if for-put
|
|
|
220 (setq buildparms
|
|
|
221 (efs-mpe-fix-buildparms
|
|
|
222 (and (match-beginning 4)
|
|
|
223 (substring path
|
|
|
224 (match-beginning 4) (match-end 4)))
|
|
|
225 host user path)))
|
|
|
226 (concat file
|
|
|
227 (and group (concat "." group ))
|
|
|
228 (and account (concat "." account ))
|
|
|
229 (and for-put buildparms)))
|
|
|
230 (error "Invalid MPE (UNIX->MPE) filename: *%s*" path)))))
|
|
|
231
|
|
|
232 (efs-defun efs-fix-dir-path mpe (dir-path)
|
|
|
233 ;; Convert path from UNIX-ish to MPE ready for a DIRectory listing. MPE does
|
|
|
234 ;; not have directories as such. It does have GROUPS and ACCOUNTS, but the
|
|
|
235 ;; DIR command does not let you list just ACCOUNTs on the system or just
|
|
|
236 ;; GROUPs in the ACCOUNT - no you always get everything downwards
|
|
|
237 ;; i.e. ACCOUNTs + GROUPs + FILEs or GROUPs + FILEs or just FILEs
|
|
|
238 ;; depending on the level.
|
|
|
239 (efs-save-match-data
|
|
|
240 (message "Fixing listing %s ..." dir-path)
|
|
|
241 (cond
|
|
|
242 ;; Everything !?! might take a while.
|
|
|
243 ((string-equal dir-path "/")
|
|
|
244 (if efs-mpe-account-completion-confirm
|
|
|
245 (if (y-or-n-p "Continue with ACCOUNT name completion? ")
|
|
|
246 "@.@.@"
|
|
|
247 (error "Quit ACCOUNT name completion"))
|
|
|
248 "@.@.@"))
|
|
|
249 ;; specification starts with account
|
|
|
250 ((let ((case-fold-search t))
|
|
|
251 (string-match
|
|
|
252 (concat
|
|
|
253 "^\\(/[A-Z][A-Z0-9]*/\\)" ; account
|
|
|
254 "\\([A-Z][A-Z0-9]*/\\)?" ; group
|
|
|
255 "\\([A-Z][A-Z0-9]*\\)?" ; file
|
|
|
256 "\\(;.*\\)?/?$") ; buildparms
|
|
|
257 dir-path))
|
|
|
258 (let (file group account)
|
|
|
259 (setq account (substring dir-path
|
|
|
260 (1+ (match-beginning 1)) (1- (match-end 1))))
|
|
|
261 (if (match-beginning 2)
|
|
|
262 (setq group (substring dir-path
|
|
|
263 (match-beginning 2) (1- (match-end 2))))
|
|
|
264 (if efs-mpe-group-completion-confirm
|
|
|
265 (if (y-or-n-p "Continue with GROUP name completion? ")
|
|
|
266 (setq group "@")
|
|
|
267 (error "Quit GROUP name completion"))
|
|
|
268 (setq group "@")))
|
|
|
269 (if (match-beginning 3)
|
|
|
270 ;;(setq file (substring dir-path
|
|
|
271 ;; (match-beginning 3) (1- (match-end 3))))
|
|
|
272 ;; set the filename to something silly so that the DIR will fail
|
|
|
273 ;; and so force a DIR for the group instead. Either I've
|
|
|
274 ;; misunderstood something or you have to do it like this.
|
|
|
275 (setq file "~!#&*")
|
|
|
276 (setq file "@"))
|
|
|
277 (concat file "." group "." account)))
|
|
|
278 (t
|
|
|
279 (error "Invalid MPE (LISTF) filename: %s" dir-path)))))
|
|
|
280
|
|
|
281 (defconst efs-mpe-acct-grp-line-regexp
|
|
|
282 "ACCOUNT= +\\([A-Z][A-Z0-9]*\\) +GROUP= +\\([A-Z][A-Z0-9]*\\)")
|
|
|
283 (defconst efs-mpe-file-line-regexp
|
|
|
284 (concat
|
|
|
285 "\\*? +\\([A-Z0-9]*\\) +\\([0-9]+\\)"
|
|
|
286 "\\([BW]\\) +\\([FV]\\)\\([AB]\\)\\([MCO]?\\) +\\([0-9]+\\)"))
|
|
|
287
|
|
|
288 (efs-defun efs-parse-listing mpe
|
|
|
289 (host user dir path &optional switches)
|
|
|
290 ;; Parse the current buffer which is assumed to be in
|
|
|
291 ;; mpe ftp dir format.
|
|
|
292 ;; HOST is the name of the remote host.
|
|
|
293 ;; USER is the user name.
|
|
|
294 ;; DIR is the directory as a full remote path
|
|
|
295 ;; PATH is the directory in full efs-syntax
|
|
|
296 ;; SWITCHES are the switches passed to ls (not relevant for mpe)
|
|
|
297 (goto-char (point-min))
|
|
|
298 (efs-save-match-data
|
|
|
299 ;;Make sure this is a valid listing
|
|
|
300 (if (re-search-forward "ACCOUNT= +[A-Z]+ +GROUP=" nil t)
|
|
|
301 (let (acct-tbl grp-tbl file-tbl
|
|
|
302 account group file
|
|
|
303 acct-cur grp-cur)
|
|
|
304 (goto-char (point-min))
|
|
|
305 ;; Look for something that could be a filename.
|
|
|
306 (while (re-search-forward "^[A-Z][A-Z0-9]*" nil t)
|
|
|
307 (goto-char (match-beginning 0))
|
|
|
308 ;; Check to see if looking at an ACCOUNT= GROUP= line. Could
|
|
|
309 ;; be a continuation (cont). line or a change in account or group
|
|
|
310 (if (looking-at efs-mpe-acct-grp-line-regexp)
|
|
|
311 (progn
|
|
|
312 (setq account (buffer-substring (match-beginning 1)
|
|
|
313 (match-end 1)))
|
|
|
314 (setq group (buffer-substring (match-beginning 2)
|
|
|
315 (match-end 2)))
|
|
|
316 ;;Check for change of account
|
|
|
317 (if (not (string-equal acct-cur account))
|
|
|
318 (progn
|
|
|
319 ;;Create table for account names and fill with
|
|
|
320 ;; "." entry.
|
|
|
321 (if (not acct-tbl)
|
|
|
322 (progn
|
|
|
323 (setq acct-tbl (efs-make-hashtable))
|
|
|
324 (efs-put-hash-entry "." '(t) acct-tbl)))
|
|
|
325 (efs-put-hash-entry account '(t) acct-tbl)
|
|
|
326 ;;Store the current group table
|
|
|
327 (if grp-tbl
|
|
|
328 (progn
|
|
|
329 (efs-set-files
|
|
|
330 (efs-replace-path-component
|
|
|
331 path
|
|
|
332 (concat "/" acct-cur "/"))
|
|
|
333 grp-tbl )
|
|
|
334 (setq grp-tbl nil)))))
|
|
|
335 ;;Check for change in group. Change in account is automatic
|
|
|
336 ;;change in group.
|
|
|
337 (if (or (not (string-equal acct-cur account))
|
|
|
338 (not (string-equal grp-cur group)))
|
|
|
339 (progn
|
|
|
340 ;;Create table for group names and fill with
|
|
|
341 ;; "." and ".." entries.
|
|
|
342 (if (not grp-tbl)
|
|
|
343 (progn
|
|
|
344 (setq grp-tbl (efs-make-hashtable))
|
|
|
345 (efs-put-hash-entry "." '(t) grp-tbl)
|
|
|
346 (efs-put-hash-entry ".." '(t) grp-tbl)))
|
|
|
347 (efs-put-hash-entry group '(t) grp-tbl)
|
|
|
348 ;;Store current file table
|
|
|
349 (if file-tbl
|
|
|
350 (progn
|
|
|
351 (efs-set-files
|
|
|
352 (efs-replace-path-component
|
|
|
353 path
|
|
|
354 (concat "/" acct-cur "/" grp-cur "/"))
|
|
|
355 file-tbl)
|
|
|
356 (setq file-tbl nil)))))
|
|
|
357 ;;Set new grp-cur and acct-cur incase one or both chnaged.
|
|
|
358 (setq grp-cur group acct-cur account)
|
|
|
359 )
|
|
|
360 ;;Looking at either a file name, or the line
|
|
|
361 ;;"FILENAME CODE --....--LOGICAL.."
|
|
|
362 ;;Save the possible filename.
|
|
|
363 (setq file (buffer-substring (point)
|
|
|
364 (progn
|
|
|
365 (skip-chars-forward "A-Z0-9")
|
|
|
366 (point))))
|
|
|
367 ;;Make sure its a file name.
|
|
|
368 ;;"\\*?" is for files in access.
|
|
|
369 ;; File codes can be numeric as well! CdS
|
|
|
370 (if (looking-at efs-mpe-file-line-regexp)
|
|
|
371 ;;Hack out the buildparms
|
|
|
372 (let* ((code (and
|
|
|
373 (/= (match-beginning 1) (match-end 1))
|
|
|
374 (concat ";CODE="
|
|
|
375 (buffer-substring
|
|
|
376 (match-beginning 1) (match-end 1)))))
|
|
|
377 (length (buffer-substring (match-beginning 2)
|
|
|
378 (match-end 2)))
|
|
|
379 (eof (buffer-substring (match-beginning 7)
|
|
|
380 (match-end 7)))
|
|
|
381 (bytes (* (string-to-int eof)
|
|
|
382 (string-to-int length)))
|
|
|
383 (word-byte (buffer-substring (match-beginning 3)
|
|
|
384 (match-end 3)))
|
|
|
385 (fix-var (buffer-substring (match-beginning 4)
|
|
|
386 (match-end 4)))
|
|
|
387 (ascii-binary (buffer-substring (match-beginning 5)
|
|
|
388 (match-end 5)))
|
|
|
389 (cir-msg (and (match-beginning 6)
|
|
|
390 (buffer-substring (match-beginning 6)
|
|
|
391 (match-end 6))))
|
|
|
392 (rec ";REC="))
|
|
|
393 (if (string-equal word-byte "B")
|
|
|
394 (setq rec (concat rec "-"))
|
|
|
395 (setq bytes (* 2 bytes)))
|
|
|
396 (setq rec (concat rec length ",," fix-var ","))
|
|
|
397 (if (string-equal ascii-binary "A")
|
|
|
398 (setq rec (concat rec "ASCII"))
|
|
|
399 (setq rec (concat rec "BINARY")))
|
|
|
400 (cond ((string-equal cir-msg "M")
|
|
|
401 (setq cir-msg ";MSG"))
|
|
|
402 ((string-equal cir-msg "O")
|
|
|
403 (setq cir-msg ";CIR"))
|
|
|
404 (t
|
|
|
405 (setq cir-msg nil)))
|
|
|
406 (if (not file-tbl)
|
|
|
407 (progn
|
|
|
408 (setq file-tbl (efs-make-hashtable))
|
|
|
409 (efs-put-hash-entry "." '(t) file-tbl)
|
|
|
410 (efs-put-hash-entry ".." '(t) file-tbl)))
|
|
|
411 (message "Adding... %s" file)
|
|
|
412 (efs-put-hash-entry file (list nil bytes) file-tbl)
|
|
|
413 (efs-put-hash-entry (concat file rec code cir-msg)
|
|
|
414 (list nil bytes) file-tbl)))
|
|
|
415 ) ;if looking-at
|
|
|
416 (forward-line 1)
|
|
|
417 );while
|
|
|
418 ;;Check at what level the listing was done and return the
|
|
|
419 ;;corresponding table. System = acct-tbl, Account = grp-tbl,
|
|
|
420 ;;Group = file-tbl.
|
|
|
421 (if (let ((case-fold-search t))
|
|
|
422 (string-match
|
|
|
423 "\\(/\\)\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?"
|
|
|
424 dir))
|
|
|
425 ;;group level listing, just return table of files
|
|
|
426 (if (or (match-beginning 3) (match-beginning 4))
|
|
|
427 file-tbl
|
|
|
428 ;;account level listing, return table of groups but do not
|
|
|
429 ;;forget to store current table of files.
|
|
|
430 (if (match-beginning 2)
|
|
|
431 (progn
|
|
|
432 (if file-tbl
|
|
|
433 (efs-set-files
|
|
|
434 (efs-replace-path-component
|
|
|
435 path
|
|
|
436 (concat "/" acct-cur "/" grp-cur "/"))
|
|
|
437 file-tbl))
|
|
|
438 grp-tbl)
|
|
|
439 ;;System level listing, return table of accounts but do not
|
|
|
440 ;;forget to store current table of groups and files
|
|
|
441 (if (match-beginning 1)
|
|
|
442 (progn
|
|
|
443 (if file-tbl
|
|
|
444 (efs-set-files
|
|
|
445 (efs-replace-path-component
|
|
|
446 path
|
|
|
447 (concat "/" acct-cur "/" grp-cur "/"))
|
|
|
448 file-tbl))
|
|
|
449 (if grp-tbl
|
|
|
450 (efs-set-files
|
|
|
451 (efs-replace-path-component
|
|
|
452 path
|
|
|
453 (concat "/" acct-cur "/"))
|
|
|
454 grp-tbl))
|
|
|
455 acct-tbl)
|
|
|
456 (error "Parse listing 0 path %s" path))))
|
|
|
457 (error "Parse listing 1 path %s" path))))))
|
|
|
458
|
|
|
459
|
|
|
460 (efs-defun efs-really-file-p mpe (file ent)
|
|
|
461 ;; Doesn't treat the buildparm entry as a real file entry.
|
|
|
462 (efs-save-match-data
|
|
|
463 (not (string-match ";" file))))
|
|
|
464
|
|
|
465 (efs-defun efs-delete-file-entry mpe (path &optional dir-p)
|
|
|
466 ;; Deletes FILE and FILE;BUILDPARMS from file hashtable.
|
|
|
467 (let ((ignore-case (memq 'mpe efs-case-insensitive-host-types)))
|
|
|
468 (if dir-p
|
|
|
469 (let ((path (file-name-as-directory path))
|
|
|
470 files)
|
|
|
471 (efs-del-hash-entry path efs-files-hashtable ignore-case)
|
|
|
472 (setq path (directory-file-name path)
|
|
|
473 files (efs-get-files-hashtable-entry
|
|
|
474 (file-name-directory path)))
|
|
|
475 (if files
|
|
|
476 (efs-del-hash-entry (efs-get-file-part path)
|
|
|
477 files ignore-case)))
|
|
|
478 (let ((file (efs-get-file-part path))
|
|
|
479 (files (efs-get-files-hashtable-entry
|
|
|
480 (file-name-directory path))))
|
|
|
481 (if files
|
|
|
482 (efs-save-match-data
|
|
|
483 (if (string-match ";" file)
|
|
|
484 (let ((root (substring file (match-beginning 0))))
|
|
|
485 ;; delete ROOT from hashtable
|
|
|
486 (efs-del-hash-entry root files ignore-case)
|
|
|
487 ;; delete ROOT;BUILDPARAMS from hashtable
|
|
|
488 (efs-del-hash-entry file files ignore-case))
|
|
|
489 ;; we've specified only a root.
|
|
|
490 (let* ((root (concat file ";"))
|
|
|
491 (completion-ignore-case ignore-case)
|
|
|
492 (extensions (all-completions root files)))
|
|
|
493 ;; Get rid of FILE.
|
|
|
494 (efs-del-hash-entry file files ignore-case)
|
|
|
495 ;; Get rid of all BUILDPARAMS versions
|
|
|
496 (while extensions
|
|
|
497 ;; all-completions will return names with the right case.
|
|
|
498 ;; Don't need to ignore-case now.
|
|
|
499 (efs-del-hash-entry (car extensions) files)
|
|
|
500 (setq extensions (cdr extensions)))))))))
|
|
|
501 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
502
|
|
|
503 (efs-defun efs-add-file-entry mpe (path dir-p size owner
|
|
|
504 &optional modes nlinks mdtm)
|
|
|
505 ;; Deletes FILE (if present) and FILE;BUILDPARMS (if present) from hashtable
|
|
|
506 ;; then adds FILE and FILE;BUILDPARMS (if specified) to hashtable.
|
|
|
507 (let ((ignore-case (memq 'mpe efs-case-insensitive-host-types))
|
|
|
508 (ent (let ((dir-p (null (null dir-p))))
|
|
|
509 (if mdtm
|
|
|
510 (list dir-p size owner nil nil mdtm)
|
|
|
511 (list dir-p size owner)))))
|
|
|
512
|
|
|
513 (if dir-p
|
|
|
514 (let* ((path (directory-file-name path))
|
|
|
515 (files (efs-get-files-hashtable-entry
|
|
|
516 (file-name-directory path))))
|
|
|
517 (if files
|
|
|
518 (efs-put-hash-entry (efs-get-file-part path) ent files
|
|
|
519 ignore-case)))
|
|
|
520
|
|
|
521 (let ((files (efs-get-files-hashtable-entry
|
|
|
522 (file-name-directory path))))
|
|
|
523 (efs-save-match-data
|
|
|
524 (if files
|
|
|
525 (let* ((file (efs-get-file-part path))
|
|
|
526 (root (substring file 0 (string-match ";" file))))
|
|
|
527 (if (equal root file)
|
|
|
528 (setq file (concat file (efs-mpe-get-buildparms path))))
|
|
|
529 ;; In case there is another entry with different buildparams,
|
|
|
530 ;; wipe it.
|
|
|
531 (efs-delete-file-entry 'mpe path nil)
|
|
|
532 (efs-put-hash-entry root ent files ignore-case)
|
|
|
533 (efs-put-hash-entry file ent files ignore-case))))))
|
|
|
534 (efs-del-from-ls-cache path t ignore-case)))
|
|
|
535
|
|
|
536 (efs-defun efs-allow-child-lookup mpe (host user dir file)
|
|
|
537 ;; Returns non-NIL if FILE in directory DIR could possibly be a subdir
|
|
|
538 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
539 ;; be attempted. Note that DIR is in directory syntax i.e. /foo/bar/, not
|
|
|
540 ;; /foo/bar.
|
|
|
541
|
|
|
542 ;; Subdirs in MPE are accounts or groups.
|
|
|
543 (string-match "^/\\([^/]+/\\)?$" dir))
|
|
|
544
|
|
|
545 (efs-defun efs-file-type mpe (path)
|
|
|
546 ;; Returns whether to treat an efs file as a text file or not.
|
|
|
547 (let ((buildparams (efs-mpe-get-buildparms path)))
|
|
|
548 (efs-save-match-data
|
|
|
549 (let ((case-fold-search t))
|
|
|
550 (cond
|
|
|
551 ((string-match "BINARY" buildparams)
|
|
|
552 '8-binary)
|
|
|
553 (t
|
|
|
554 'text))))))
|
|
|
555
|
|
|
556 ;;; Tree dired support:
|
|
|
557
|
|
|
558 (efs-defun efs-dired-manual-move-to-filename mpe
|
|
|
559 (&optional raise-error bol eol)
|
|
|
560 ;; In dired, move to first char of filename on this line.
|
|
|
561 ;; Returns position (point) or nil if no filename on this line.
|
|
|
562 ;; This is the MPE version.
|
|
|
563 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
564 (let (case-fold-search)
|
|
|
565 (if bol
|
|
|
566 (goto-char bol)
|
|
|
567 (skip-chars-backward "^\n\r"))
|
|
|
568 ;; The "\\|ACCOUNT=\\|GROUP=" bit is to take care of the hacked account and
|
|
|
569 ;; group dired listings.
|
|
|
570 (if (looking-at
|
|
|
571 ". [A-Z][A-Z0-9]*\\*? +\\([A-Z]* +[0-9]+\\|ACCOUNT=\\|GROUP=\\)")
|
|
|
572 (progn
|
|
|
573 (forward-char 2)
|
|
|
574 (point))
|
|
|
575 (and raise-error (error "No file on this line")))))
|
|
|
576
|
|
|
577 (efs-defun efs-dired-manual-move-to-end-of-filename mpe
|
|
|
578 (&optional no-error bol eol)
|
|
|
579 ;; Assumes point is at beginning of filename.
|
|
|
580 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
581 ;; On failure, signals an error or returns nil.
|
|
|
582 ;; This is the MPE version.
|
|
|
583 (let ((opoint (point)))
|
|
|
584 (and selective-display
|
|
|
585 (null no-error)
|
|
|
586 (eq (char-after
|
|
|
587 (1- (or bol (save-excursion
|
|
|
588 (skip-chars-backward "^\r\n")
|
|
|
589 (point)))))
|
|
|
590 ?\r)
|
|
|
591 ;; File is hidden or omitted.
|
|
|
592 (cond
|
|
|
593 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
594 (error
|
|
|
595 (substitute-command-keys
|
|
|
596 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
597 ((error
|
|
|
598 (substitute-command-keys
|
|
|
599 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
600 )))))
|
|
|
601 (skip-chars-forward "A-Z0-9")
|
|
|
602 (if (or (= opoint (point)) (not (memq (following-char) '(?\ ?*))))
|
|
|
603 (if no-error
|
|
|
604 nil
|
|
|
605 (error "No file on this line"))
|
|
|
606 (point))))
|
|
|
607
|
|
|
608 (efs-defun efs-dired-ls-trim mpe ()
|
|
|
609 ;; trim single file listings 1-line.
|
|
|
610 ;; This uses an evil dynamical binding of file.
|
|
|
611 (if (and (boundp 'file) (stringp file))
|
|
|
612 (let ((f (file-name-nondirectory file)))
|
|
|
613 (or (zerop (length f))
|
|
|
614 (progn
|
|
|
615 (goto-char (point-min))
|
|
|
616 (if (search-forward (concat "\n" (upcase file) " ") nil t)
|
|
|
617 (progn
|
|
|
618 (beginning-of-line)
|
|
|
619 (delete-region (point-min) (point))
|
|
|
620 (forward-line 1)
|
|
|
621 (delete-region (point) (point-max)))))))))
|
|
|
622
|
|
|
623 (efs-defun efs-dired-fixup-listing mpe (file path &optional switches wildcard)
|
|
|
624 ;; File (group) listings stay pretty much as they are group (account) and
|
|
|
625 ;; account (system) listings get realy hacked.
|
|
|
626 (efs-save-match-data
|
|
|
627 (goto-char (point-max))
|
|
|
628 (string-match
|
|
|
629 "\\(/\\)\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?\\([A-Z0-9]+/\\)?"
|
|
|
630 path)
|
|
|
631 ;; group or file level listing.
|
|
|
632 (if (or (match-beginning 3) (match-beginning 4))
|
|
|
633 ;; Hack out the continuation lines.
|
|
|
634 (while
|
|
|
635 (re-search-backward
|
|
|
636 "\n\nACCOUNT=.+GROUP=.+(CONT\\.)\n\n.*\n.*\n" nil t)
|
|
|
637 (replace-match "" nil nil))
|
|
|
638 ;;account level listing, hack out everything apart from group names
|
|
|
639 (if (match-beginning 2)
|
|
|
640 (let ((group nil)
|
|
|
641 (grp-cur nil))
|
|
|
642 (while
|
|
|
643 (re-search-backward
|
|
|
644 "GROUP= +\\([A-Z][A-Z0-9]*\\)\\(.\\|\n\\)*"
|
|
|
645 nil t)
|
|
|
646 (setq group
|
|
|
647 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
648 ;;Continuation header or new group
|
|
|
649 (if (string-equal grp-cur group)
|
|
|
650 (replace-match "" nil nil)
|
|
|
651 (replace-match (format "\n\n%-10sGROUP=" group) nil nil))
|
|
|
652 (forward-line -1)
|
|
|
653 (setq grp-cur group)
|
|
|
654 (narrow-to-region (point-min) (point)))
|
|
|
655 (widen)
|
|
|
656 (goto-char (point-max))
|
|
|
657 (insert "\n\n"))
|
|
|
658 ;;System level listing, hack out everything apart from account names
|
|
|
659 (if (match-beginning 1)
|
|
|
660 (let (account acct-cur)
|
|
|
661 (while
|
|
|
662 (re-search-backward
|
|
|
663 "^ACCOUNT= +\\([A-Z][A-Z0-9]*\\)\\(.\\|\n\\)*"
|
|
|
664 nil t)
|
|
|
665 (setq account
|
|
|
666 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
667 ;;Continuation header or new account
|
|
|
668 (if (string-equal acct-cur account)
|
|
|
669 (replace-match "" nil nil)
|
|
|
670 (replace-match (format "%-10sACCOUNT=" account) nil nil))
|
|
|
671 (forward-line -1)
|
|
|
672 (setq acct-cur account)
|
|
|
673 (narrow-to-region (point-min) (point)))
|
|
|
674 (widen)
|
|
|
675 (goto-char (point-max))
|
|
|
676 (insert "\n\n")))))))
|
|
|
677
|
|
|
678 ;;; end of efs-mpe.el
|
