|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-guardian.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
42
|
6 ;; Version: #Revision: 1.7 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: Guardian support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@math.ubc.ca>
|
|
|
10 ;; Created: Sat Jul 10 12:26:12 1993 by sandy on ibm550
|
|
|
11 ;; Language: Emacs-Lisp
|
|
|
12 ;;
|
|
|
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
14
|
|
|
15 ;;; This file is part of efs. See efs.el for copyright
|
|
|
16 ;;; (it's copylefted) and warrranty (there isn't one) information.
|
|
|
17
|
|
|
18 ;;; Acknowledgements:
|
|
|
19 ;;; Adrian Philips and David Karr for answering questions
|
|
|
20 ;;; and debugging. Thanks.
|
|
|
21
|
|
|
22 (defconst efs-guardian-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
42
|
25 (substring "#Revision: 1.7 $" 11 -2)))
|
|
22
|
26
|
|
|
27 (provide 'efs-guardian)
|
|
|
28 (require 'efs)
|
|
|
29
|
|
|
30 ;;;; ------------------------------------------------------------
|
|
|
31 ;;;; Support for Tandem's GUARDIAN operating system.
|
|
|
32 ;;;; ------------------------------------------------------------
|
|
|
33
|
|
|
34 ;;; Supposed to work for (Version 2.7 TANDEM 01SEP92).
|
|
|
35
|
|
|
36 ;;; File name syntax:
|
|
|
37 ;;;
|
|
|
38 ;;; File names are of the form volume.subvolume.file where
|
|
|
39 ;;; volume is $[alphanumeric characters]{1 to 7}
|
|
|
40 ;;; subvolume is <alpha character>[<alphanumeric character>]{0 to 7}
|
|
|
41 ;;; and file is the same as subvolume.
|
|
|
42
|
|
|
43 (defconst efs-guardian-date-regexp
|
|
|
44 (concat
|
|
|
45 " [ 1-3][0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
|
|
|
46 "Sep\\|Oct\\|Nov\\|Dec\\)-[0-9][0-9] "))
|
|
|
47
|
|
|
48 ;;; entry points -- 2 of 'em.
|
|
|
49
|
|
|
50 (efs-defun efs-fix-path guardian (path &optional reverse)
|
|
|
51 ;; Convert PATH from unix-ish to guardian.
|
|
|
52 ;; If REVERSE is non-nil do just that.
|
|
|
53 (efs-save-match-data
|
|
|
54 (let ((case-fold-search t))
|
|
|
55 (if reverse
|
|
|
56 (if (string-match
|
|
|
57 (concat
|
|
|
58 "^\\(\\\\[A-Z0-9]+\\.\\)?"
|
|
|
59 "\\(\\$[A-Z0-9]+\\)\\.\\([A-Z0-9]+\\)\\(\\.[A-Z0-9]+\\)?$")
|
|
|
60 path)
|
|
|
61 (concat
|
|
|
62 "/"
|
|
|
63 (substring path (match-beginning 2) (match-end 2))
|
|
|
64 "/"
|
|
|
65 (substring path (match-beginning 3) (match-end 3))
|
|
|
66 "/"
|
|
|
67 (and (match-beginning 4)
|
|
|
68 (substring path (1+ (match-beginning 4)))))
|
|
|
69 (error "path %s is invalid for the GUARDIAN operating system"
|
|
|
70 path))
|
|
|
71 (if (string-match
|
|
|
72 "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$" path)
|
|
|
73 (apply 'concat
|
|
|
74 (substring path 1 (match-end 1))
|
|
|
75 "."
|
|
|
76 (substring path (match-beginning 2) (match-end 2))
|
|
|
77 (and (match-beginning 3)
|
|
|
78 (/= (- (match-end 3) (match-beginning 3)) 1)
|
|
|
79 (list "."
|
|
|
80 (substring path (1+ (match-beginning 3))))))
|
|
|
81 (error "path %s is invalid for the guardian operating system"
|
|
|
82 path))))))
|
|
|
83
|
|
|
84 (efs-defun efs-fix-dir-path guardian (dir-path)
|
|
|
85 ;; Convert DIR-PATH from unix-ish to guardian fir a DIR listing.
|
|
|
86 (efs-save-match-data
|
|
|
87 (let ((case-fold-search t))
|
|
|
88 (cond
|
|
|
89 ((string-equal "/" dir-path)
|
|
|
90 (error "Can't grok guardian disk volumes."))
|
|
|
91 ((string-match "^/\\$[A-Z0-9]+/?$" dir-path)
|
|
|
92 (error "Can't grok guardian subvolumes."))
|
|
|
93 ((string-match "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$"
|
|
|
94 dir-path)
|
|
|
95 (apply 'concat
|
|
|
96 (substring dir-path 1 (match-end 1))
|
|
|
97 "."
|
|
|
98 (substring dir-path (match-beginning 2) (match-end 2))
|
|
|
99 (and (match-beginning 3)
|
|
|
100 (/= (- (match-end 3) (match-beginning 3)) 1)
|
|
|
101 (list "."
|
|
|
102 (substring dir-path (1+ (match-beginning 3)))))))
|
|
|
103 (t
|
|
|
104 (error "path %s is invalid for the guardian operating system"))))))
|
|
|
105
|
|
|
106 (efs-defun efs-parse-listing guardian
|
|
|
107 (host user dir path &optional switches)
|
|
|
108 ;; Parses a GUARDIAN DIRectory listing.
|
|
|
109 ;; HOST = remote host name
|
|
|
110 ;; USER = remote user name
|
|
|
111 ;; DIR = remote directory as a remote full path
|
|
|
112 ;; PATH = directory as an efs full path
|
|
|
113 ;; SWITCHES are never used here, but they
|
|
|
114 ;; must be specified in the argument list for compatibility
|
|
|
115 ;; with the unix version of this function.
|
|
|
116 (efs-save-match-data
|
|
|
117 (goto-char (point-min))
|
|
|
118 (if (re-search-forward efs-guardian-date-regexp nil t)
|
|
|
119 (let ((tbl (efs-make-hashtable))
|
|
|
120 file size)
|
|
|
121 (while
|
|
|
122 (progn
|
|
|
123 (beginning-of-line)
|
|
|
124 (setq file (buffer-substring (point)
|
|
|
125 (progn
|
|
|
126 (skip-chars-forward "A-Z0-9")
|
|
|
127 (point))))
|
|
|
128 (skip-chars-forward " ")
|
|
|
129 (skip-chars-forward "^ ")
|
|
|
130 (skip-chars-forward " ")
|
|
|
131 (setq size (string-to-int (buffer-substring
|
|
|
132 (point)
|
|
|
133 (progn
|
|
|
134 (skip-chars-forward "0-9")))))
|
|
|
135 (efs-put-hash-entry file (list nil size) tbl)
|
|
|
136 (forward-line 1)
|
|
|
137 (re-search-forward efs-guardian-date-regexp nil t)))
|
|
|
138 (efs-put-hash-entry "." '(t) tbl)
|
|
|
139 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
140 tbl))))
|
|
|
141
|
|
|
142 (efs-defun efs-allow-child-lookup guardian (host user dir file)
|
|
|
143 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
144 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
145 ;; be attempted.
|
|
|
146 (efs-save-match-data
|
|
|
147 (let ((case-fold-search t))
|
|
|
148 (string-match "^/\\$[A-Z0-9]+/$" dir))))
|
|
|
149
|
|
|
150 (efs-defun efs-internal-file-directory-p guardian (file)
|
|
|
151 ;; Directories pop into existence simply by putting files in them.
|
|
|
152 (efs-save-match-data
|
|
|
153 (let ((case-fold-search t))
|
|
|
154 (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
|
|
|
155 t
|
|
|
156 (efs-internal-file-directory-p nil file)))))
|
|
|
157
|
|
|
158 (efs-defun efs-internal-file-exists-p guardian (file)
|
|
|
159 ;; Directories pop into existence simply by putting files in them.
|
|
|
160 (efs-save-match-data
|
|
|
161 (let ((case-fold-search t))
|
|
|
162 (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
|
|
|
163 t
|
|
|
164 (efs-internal-file-exists-p nil file)))))
|
|
|
165
|
|
|
166 ;;; Tree Dired support
|
|
|
167
|
|
|
168 (defconst efs-dired-guardian-re-exe nil)
|
|
|
169
|
|
|
170 (or (assq 'guardian efs-dired-re-exe-alist)
|
|
|
171 (setq efs-dired-re-exe-alist
|
|
|
172 (cons (cons 'guardian efs-dired-guardian-re-exe)
|
|
|
173 efs-dired-re-exe-alist)))
|
|
|
174
|
|
|
175 (defconst efs-dired-guardian-re-dir nil)
|
|
|
176
|
|
|
177 (or (assq 'guardian efs-dired-re-dir-alist)
|
|
|
178 (setq efs-dired-re-dir-alist
|
|
|
179 (cons (cons 'guardian efs-dired-guardian-re-dir)
|
|
|
180 efs-dired-re-dir-alist)))
|
|
|
181
|
|
|
182 (efs-defun efs-dired-manual-move-to-filename guardian
|
|
|
183 (&optional raise-error bol eol)
|
|
|
184 ;; In dired, move to first char of filename on this line.
|
|
|
185 ;; Returns position (point) or nil if no filename on this line.
|
|
|
186 ;; This is the guardian version.
|
|
|
187 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
188 (if bol
|
|
|
189 (goto-char bol)
|
|
|
190 (skip-chars-backward "^\n\r")
|
|
|
191 (setq bol (point)))
|
|
|
192 (if (save-excursion (re-search-forward efs-guardian-date-regexp eol t))
|
|
|
193 (progn
|
|
|
194 (if (looking-at ". [^ ]")
|
|
|
195 (forward-char 2))
|
|
|
196 (point))
|
|
|
197 (and raise-error (error "No file on this line"))))
|
|
|
198
|
|
|
199 (efs-defun efs-dired-manual-move-to-end-of-filename guardian
|
|
|
200 (&optional no-error bol eol)
|
|
|
201 ;; Assumes point is at beginning of filename.
|
|
|
202 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
203 ;; On failure, signals an error or returns nil.
|
|
|
204 ;; This is the guardian version.
|
|
|
205 (and selective-display
|
|
|
206 (null no-error)
|
|
|
207 (eq (char-after
|
|
|
208 (1- (or bol (save-excursion
|
|
|
209 (skip-chars-backward "^\r\n")
|
|
|
210 (point)))))
|
|
|
211 ?\r)
|
|
|
212 ;; File is hidden or omitted.
|
|
|
213 (cond
|
|
|
214 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
215 (error
|
|
|
216 (substitute-command-keys
|
|
|
217 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
218 ((error
|
|
|
219 (substitute-command-keys
|
|
|
220 "File line is omitted. Type \\[dired-omit-toggle] to un-omit.")))))
|
|
|
221 (if (and
|
|
|
222 (>= (following-char) ?A)
|
|
|
223 (<= (following-char) ?Z)
|
|
|
224 (progn
|
|
|
225 (skip-chars-forward "A-Z0-9")
|
|
|
226 (= (following-char) ?\ )))
|
|
|
227 (point)
|
|
|
228 (and (null no-error)
|
|
|
229 (error "No file on this line"))))
|
|
|
230
|
|
|
231 (efs-defun efs-dired-ls-trim guardian ()
|
|
|
232 (goto-char (point-min))
|
|
|
233 (let (case-fold-search)
|
|
|
234 (if (re-search-forward efs-guardian-date-regexp nil t)
|
|
|
235 (progn
|
|
|
236 (beginning-of-line)
|
|
|
237 (delete-region (point-min) (point))
|
|
|
238 (forward-line 1)
|
|
|
239 (delete-region (point) (point-max))))))
|
|
|
240
|
|
|
241 ;;; end of efs-guardian.el
|
