Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-guardian.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-guardian.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
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 "/"
25 (substring "$Revision: 1.1 $" 11 -2)))
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