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