Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-nos-ve.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 7e54bd776075 9f59509498e1
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-nos-ve.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: efs support for NOS/VE
9 ;; Authors: Sandy Rutherford <sandy@ibm550.sissa,it>
10 ;; Created: Fri Aug 19 04:57:09 1994 by sandy on ibm550
11 ;; Modified: Sun Nov 27 18:39:43 1994 by sandy on gandalf
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 (provide 'efs-nos-ve)
19 (require 'efs)
20
21 ;;; Works for NOS/VE from CDC. NOS/VE runs on Cybers.
22
23 ;;; Thank you to Jost Krieger <Jost.Krieger@rz.ruhr-uni-bochum.de> for
24 ;;; providing imformation and testing.
25
26 (defconst efs-nos-ve-version
27 (concat (substring "$efs release: 1.15 $" 14 -2)
28 "/"
29 (substring "$Revision: 1.1 $" 11 -2)))
30
31 ;;;;---------------------------------------------------------------
32 ;;;; NOS/VE support for efs
33 ;;;;---------------------------------------------------------------
34
35 ;;; A legal NOS/VE filename is of the form
36 ;;; <family>.<dirname>.<dirname>.<direname>.....<filename>
37 ;;; where <family> always starts with the char : and is followed by
38 ;;; alphanumeric characters. Each <dirname> or <filename> can be up to 31
39 ;;; characters. File names are case insensistive.
40 ;;; eg. :FOO.DIR_1.DIR_2.BAR
41 ;;;
42 ;;; The character set consists of (single case) alphabet, the numerals,
43 ;;; and the characters "@$_#". (Not the quotes ...) The characters
44 ;;; "[\]{|}" will also occur in a misguided attempt at
45 ;;; internationalization. A filename may not start with a numeral.
46
47
48 ;;; entry points
49
50 (efs-defun efs-fix-path nos-ve (path &optional reverse)
51 ;; Convert path from UNIX to NOS/VE.
52 ;; If REVERSE is non-nil, goes in the opposite direction.
53 (if reverse
54 (let* ((res (concat "." path))
55 (len (length res))
56 (n 0))
57 (while (< n len)
58 (and (= (aref res n) ?.) (aset res n ?/))
59 (setq n (1+ n)))
60 res)
61 (let* ((res (substring (efs-internal-directory-file-name path) 1))
62 (len (length res))
63 (n 0))
64 (while (< n len)
65 (and (= (aref res n) ?/) (aset res n ?.))
66 (setq n (1+ n)))
67 res)))
68
69 (efs-defun efs-fix-dir-path nos-ve (dir-path)
70 ;; Converts DIR-PATH to NOS/VE format for a directory listing.
71 (efs-fix-path 'nos-ve dir-path))
72
73 ;;; parser
74
75 (defconst efs-nos-ve-file-line-regexp
76 (concat
77 " \\([>0-9,]+\\) bytes \\(in [0-9]+ \\(file\\|catalog\\)s?\\)?\\|"
78 "\\( -- empty catalog\\)\\| -- device"))
79
80 (efs-defun efs-parse-listing nos-ve (host user dir path &optional switches)
81 ;; Parse the current buffer which is assumed to be a NOS/VE listing.
82 ;; Returns a hashtable.
83 (goto-char (point-min))
84 (efs-save-match-data
85 (if (and (re-search-forward efs-nos-ve-file-line-regexp
86 (save-excursion (end-of-line) (point)) t)
87 (or (match-beginning 2) (match-beginning 4)))
88 (let ((tbl (efs-make-hashtable))
89 size dir-p file)
90 (forward-line 1)
91 (while (re-search-forward efs-nos-ve-file-line-regexp
92 (save-excursion (end-of-line) (point)) t)
93 (setq size (and (match-beginning 1)
94 (buffer-substring
95 (match-beginning 1) (match-end 1)))
96 dir-p (null (null (or (match-beginning 2)
97 (match-beginning 4)))))
98 (if size
99 (let ((start 0)
100 res)
101 (while (string-match "," size start)
102 (setq res (concat res (substring size start
103 (match-beginning 0)))
104 start (match-end 0)))
105 (setq size (string-to-int
106 (concat res (substring size start))))))
107 (beginning-of-line)
108 (forward-char 2)
109 (setq file (buffer-substring
110 (point)
111 (progn (skip-chars-forward "^ \t\n") (point))))
112 (efs-put-hash-entry file (list dir-p size)
113 (or tbl (setq tbl (efs-make-hashtable))))
114 (forward-line 1))
115 (efs-put-hash-entry "." '(t) tbl)
116 (efs-put-hash-entry ".." '(t) tbl)
117 tbl))))
118
119 (efs-defun efs-allow-child-lookup nos-ve (host user dir file)
120 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
121 ;; according to its file-name syntax, and therefore a child listing should
122 ;; be attempted. Note that DIR is in directory syntax.
123 ;; i.e. /foo/bar/, not /foo/bar.
124 ;; Deal with dired. Anything else?
125 (not (and (boundp 'dired-local-variables-file)
126 (stringp dired-local-variables-file)
127 (string-equal (downcase dired-local-variables-file)
128 (downcase file)))))
129
130 ;;; Tree Dired
131
132 (defconst efs-dired-nos-ve-re-exe "^.[^ \t\n]")
133 ;; Matches no lines. Should it match something?
134
135 (or (assq 'nos-ve efs-dired-re-exe-alist)
136 (setq efs-dired-re-exe-alist
137 (cons (cons 'nos-ve efs-dired-nos-ve-re-exe)
138 efs-dired-re-exe-alist)))
139
140 (defconst efs-dired-nos-ve-re-dir " [0-9,]+ bytes in [0-9]+ file")
141
142 (or (assq 'nos-ve efs-dired-re-dir-alist)
143 (setq efs-dired-re-dir-alist
144 (cons (cons 'nos-ve efs-dired-nos-ve-re-dir)
145 efs-dired-re-dir-alist)))
146
147 (efs-defun efs-dired-fixup-listing nos-ve (file path &optional switches
148 wildcard)
149 ;; Need to turn the header line into something to masquerading as a file
150 ;; line, and need to remove the indentation. Both upset dired.
151 (goto-char (point-min))
152 (while (search-forward "\n " nil t)
153 (delete-char -2))
154 (goto-char (point-min))
155 (if (looking-at "\\([^ \n]+ +\\)[0-9,]+ bytes in [0-9]+ file")
156 (progn
157 (delete-region (match-beginning 1) (match-end 1))
158 (insert " Total of "))))
159
160 (defconst efs-dired-nos-ve-file-line-regexp
161 (concat
162 ".[ \t]+\\([][{}|\\\\a-z0-9@$_#]+\\) +"
163 "\\([>0-9,]+ bytes\\|-- \\(empty\\|device\\)\\)"))
164
165 (efs-defun efs-dired-manual-move-to-filename nos-ve
166 (&optional raise-error bol eol)
167 ;; In dired, move to first char of filename on this line.
168 ;; Returns position (point) or nil if no filename on this line.
169 ;; This is the NOS/VE version.
170 (if bol
171 (goto-char bol)
172 (skip-chars-backward "^\n\r"))
173 (if (looking-at efs-dired-nos-ve-file-line-regexp)
174 (goto-char (match-beginning 1))
175 (and raise-error (error "No file on this line"))))
176
177 (efs-defun efs-dired-manual-move-to-end-of-filename nos-ve
178 (&optional no-error bol eol)
179 ;; Assumes point is at beginning of filename.
180 ;; So, it should be called only after (dired-move-to-filename t).
181 ;; case-fold-search must be nil, at least for VMS.
182 ;; On failure, signals an error or returns nil.
183 ;; This is the NOS/VE version.
184 (let ((opoint (point)))
185 (and selective-display
186 (null no-error)
187 (eq (char-after
188 (1- (or bol (save-excursion
189 (skip-chars-backward "^\r\n")
190 (point)))))
191 ?\r)
192 ;; File is hidden or omitted.
193 (cond
194 ((dired-subdir-hidden-p (dired-current-directory))
195 (error
196 (substitute-command-keys
197 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
198 ((error
199 (substitute-command-keys
200 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
201 )))))
202 (skip-chars-forward "_a-z0-9$@#\\\\[]{}|") ; right char set?
203 (if (or (= opoint (point)) (/= (following-char) ?\ ))
204 (if no-error
205 nil
206 (error "No file on this line"))
207 (point))))
208
209 ;;; end of efs-nos-ve.el