Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-mpe.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 7e54bd776075 9f59509498e1
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
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