|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-mts.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: MTS support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@itp.ethz.ch>
|
|
|
10 ;; Created: Fri Oct 23 08:51:29 1992
|
|
|
11 ;; Modified: Sun Nov 27 18:37:18 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 (provide 'efs-mts)
|
|
|
20 (require 'efs)
|
|
|
21
|
|
|
22 (defconst efs-mts-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
|
25 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
26
|
|
|
27 ;;;; ------------------------------------------------------------
|
|
|
28 ;;;; MTS support
|
|
|
29 ;;;; ------------------------------------------------------------
|
|
|
30
|
|
|
31 ;;; efs has full support, including tree dired support, for hosts running
|
|
|
32 ;;; the Michigan terminal system. It should be able to automatically
|
|
|
33 ;;; recognize any MTS machine. We would be grateful if you
|
|
|
34 ;;; would report any failures to automatically recognize a MTS host as a bug.
|
|
|
35 ;;;
|
|
|
36 ;;; Filename syntax:
|
|
|
37 ;;;
|
|
|
38 ;;; MTS filenames are entered in a UNIX-y way. For example, if your account
|
|
|
39 ;;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
|
|
|
40 ;;; entered as
|
|
|
41 ;;; /YYYY@mtsg.ubc.ca:/XXXX:/FILE
|
|
|
42 ;;; In other words, MTS accounts are treated as UNIX directories. Of course,
|
|
|
43 ;;; to access a file in another account, you must have access permission for
|
|
|
44 ;;; it. If FILE were in your own account, then you could enter it in a
|
|
|
45 ;;; relative path fashion as
|
|
|
46 ;;; /YYYY@mtsg.ubc.ca:FILE
|
|
|
47 ;;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
|
|
|
48 ;;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
|
|
|
49 ;;; like.) MTS filenames are always in upper case, and hence be sure to enter
|
|
|
50 ;;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
|
|
|
51 ;;; is.
|
|
|
52
|
|
|
53
|
|
|
54 (defconst efs-mts-date-regexp
|
|
|
55 (concat
|
|
|
56 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
57 "\\|Nov\\|Dec\\) [ 123]?[0-9] "))
|
|
|
58
|
|
|
59 ;;; The following two functions are entry points to this file.
|
|
|
60 ;;; They are put into the appropriate alists in efs.el
|
|
|
61
|
|
|
62 (efs-defun efs-fix-path mts (path &optional reverse)
|
|
|
63 ;; Convert PATH from UNIX-ish to MTS.
|
|
|
64 ;; If REVERSE given then convert from MTS to UNIX-ish.
|
|
|
65 (efs-save-match-data
|
|
|
66 (if reverse
|
|
|
67 (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" path)
|
|
|
68 (let (acct file)
|
|
|
69 (if (match-beginning 1)
|
|
|
70 (setq acct (substring path 0 (match-end 1))))
|
|
|
71 (if (match-beginning 2)
|
|
|
72 (setq file (substring path
|
|
|
73 (match-beginning 2) (match-end 2))))
|
|
|
74 (concat (and acct (concat "/" acct "/"))
|
|
|
75 file))
|
|
|
76 (error "path %s didn't match" path))
|
|
|
77 (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" path)
|
|
|
78 (concat (substring path 1 (match-end 1))
|
|
|
79 (substring path (match-beginning 2) (match-end 2)))
|
|
|
80 ;; Let's hope that mts will recognize it anyway.
|
|
|
81 path))))
|
|
|
82
|
|
|
83 (efs-defun efs-fix-dir-path mts (dir-path)
|
|
|
84 ;; Convert path from UNIX-ish to MTS ready for a DIRectory listing.
|
|
|
85 ;; Remember that there are no directories in MTS.
|
|
|
86 (if (string-equal dir-path "/")
|
|
|
87 (error "Cannot get listing for fictitious \"/\" directory.")
|
|
|
88 (let ((dir-path (efs-fix-path 'mts dir-path)))
|
|
|
89 (cond
|
|
|
90 ((string-equal dir-path "")
|
|
|
91 "?")
|
|
|
92 ((efs-save-match-data (string-match ":$" dir-path))
|
|
|
93 (concat dir-path "?"))
|
|
|
94 (dir-path))))) ; It's just a single file.
|
|
|
95
|
|
|
96
|
|
|
97 (efs-defun efs-parse-listing mts
|
|
|
98 (host user dir path &optional switches)
|
|
|
99 ;; Parse the current buffer which is assumed to be in
|
|
|
100 ;; mts ftp dir format.
|
|
|
101 ;; HOST = remote host name
|
|
|
102 ;; USER = remote user name
|
|
|
103 ;; DIR = remote directory as a remote full path
|
|
|
104 ;; PATH = directory as an efs full path
|
|
|
105 ;; SWITCHES are never used here, but they
|
|
|
106 ;; must be specified in the argument list for compatibility
|
|
|
107 ;; with the unix version of this function.
|
|
|
108 (let ((tbl (efs-make-hashtable))
|
|
|
109 perms)
|
|
|
110 (goto-char (point-min))
|
|
|
111 (efs-save-match-data
|
|
|
112 (while (re-search-forward efs-mts-date-regexp nil t)
|
|
|
113 (beginning-of-line)
|
|
|
114 (if (looking-at "[rwed]+")
|
|
|
115 (setq perms (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
116 (setq perms nil))
|
|
|
117 (end-of-line)
|
|
|
118 (skip-chars-backward " ")
|
|
|
119 (let ((end (point)))
|
|
|
120 (skip-chars-backward "-A-Z0-9_.!")
|
|
|
121 (efs-put-hash-entry (buffer-substring (point) end)
|
|
|
122 (list nil nil nil perms) tbl))
|
|
|
123 (forward-line 1)))
|
|
|
124 ;; Don't need to bother with ..
|
|
|
125 (efs-put-hash-entry "." '(t) tbl)
|
|
|
126 tbl))
|
|
|
127
|
|
|
128 (efs-defun efs-allow-child-lookup mts (host user dir file)
|
|
|
129 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
130 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
131 ;; be attempted.
|
|
|
132
|
|
|
133 ;; MTS file system is flat. Only "accounts" are subdirs.
|
|
|
134 (string-equal "/" dir))
|
|
|
135
|
|
|
136 (efs-defun efs-internal-file-writable-p mts (user owner modes)
|
|
|
137 (if (stringp modes)
|
|
|
138 (efs-save-match-data
|
|
|
139 (null (null (string-match "w" modes))))
|
|
|
140 t)) ; guess
|
|
|
141
|
|
|
142 (efs-defun efs-internal-file-readable-p mts (user owner modes)
|
|
|
143 (if (stringp modes)
|
|
|
144 (efs-save-match-data
|
|
|
145 (null (null (string-match "r" modes))))
|
|
|
146 t)) ; guess
|
|
|
147
|
|
|
148 ;;; Tree dired support:
|
|
|
149
|
|
|
150 ;; There aren't too many systems left that use MTS. This dired support will
|
|
|
151 ;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
|
|
|
152 ;; implement ftp in the same way. If not, it might be necessary to make the
|
|
|
153 ;; following more flexible.
|
|
|
154
|
|
|
155 (defconst efs-dired-mts-re-exe nil)
|
|
|
156
|
|
|
157 (or (assq 'mts efs-dired-re-exe-alist)
|
|
|
158 (setq efs-dired-re-exe-alist
|
|
|
159 (cons (cons 'mts efs-dired-mts-re-exe)
|
|
|
160 efs-dired-re-exe-alist)))
|
|
|
161
|
|
|
162 (defconst efs-dired-mts-re-dir nil)
|
|
|
163
|
|
|
164 (or (assq 'mts efs-dired-re-dir-alist)
|
|
|
165 (setq efs-dired-re-dir-alist
|
|
|
166 (cons (cons 'mts efs-dired-mts-re-dir)
|
|
|
167 efs-dired-re-dir-alist)))
|
|
|
168
|
|
|
169 (efs-defun efs-dired-manual-move-to-filename mts
|
|
|
170 (&optional raise-error bol eol)
|
|
|
171 ;; In dired, move to first char of filename on this line.
|
|
|
172 ;; Returns position (point) or nil if no filename on this line.
|
|
|
173 ;; This is the MTS version.
|
|
|
174 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
175 (if bol
|
|
|
176 (goto-char bol)
|
|
|
177 (skip-chars-backward "^\n\r"))
|
|
|
178 (if (re-search-forward efs-mts-date-regexp eol t)
|
|
|
179 (progn
|
|
|
180 (skip-chars-forward " ") ; Eat blanks after date
|
|
|
181 (skip-chars-forward "0-9:") ; Eat time or year
|
|
|
182 (skip-chars-forward " ") ; one space before filename
|
|
|
183 (point))
|
|
|
184 (and raise-error (error "No file on this line"))))
|
|
|
185
|
|
|
186 (efs-defun efs-dired-manual-move-to-end-of-filename mts
|
|
|
187 (&optional no-error bol eol)
|
|
|
188 ;; Assumes point is at beginning of filename.
|
|
|
189 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
190 ;; On failure, signals an error or returns nil.
|
|
|
191 ;; This is the MTS version.
|
|
|
192 (let ((opoint (point)))
|
|
|
193 (and selective-display
|
|
|
194 (null no-error)
|
|
|
195 (eq (char-after
|
|
|
196 (1- (or bol (save-excursion
|
|
|
197 (skip-chars-backward "^\r\n")
|
|
|
198 (point)))))
|
|
|
199 ?\r)
|
|
|
200 ;; File is hidden or omitted.
|
|
|
201 (cond
|
|
|
202 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
203 (error
|
|
|
204 (substitute-command-keys
|
|
|
205 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
206 ((error
|
|
|
207 (substitute-command-keys
|
|
|
208 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
209 )))))
|
|
|
210 (skip-chars-forward "-A-Z0-9._!")
|
|
|
211 (if (or (= opoint (point)) (not (memq (following-char) '(?\r ?\n))))
|
|
|
212 (if no-error
|
|
|
213 nil
|
|
|
214 (error "No file on this line"))
|
|
|
215 (point))))
|
|
|
216
|
|
|
217 (efs-defun efs-dired-fixup-listing mts (file path &optional switches wildcard)
|
|
|
218 ;; If you're not listing your own account, MTS puts the
|
|
|
219 ;; account name in front of each filename. Scrape them off.
|
|
|
220 ;; PATH will have unix /'s on it.
|
|
|
221 ;; file-name-directory is in case of wildcards
|
|
|
222 (let ((len (length path)))
|
|
|
223 (if (> len 2)
|
|
|
224 (progn
|
|
|
225 (if (= (aref path (1- len)) ?/)
|
|
|
226 (setq path (substring path -2))
|
|
|
227 (setq path (substring path -1)))
|
|
|
228 (goto-char (point-min))
|
|
|
229 (while (search-forward path nil t)
|
|
|
230 (delete-region (match-beginning 0) (match-end 0)))))))
|
|
|
231
|
|
|
232 (efs-defun efs-dired-insert-headerline mts (dir)
|
|
|
233 ;; MTS has no total line, so we insert a blank line for
|
|
|
234 ;; aesthetics.
|
|
|
235 (insert "\n")
|
|
|
236 (forward-char -1)
|
|
|
237 (efs-real-dired-insert-headerline dir))
|
|
|
238
|
|
|
239 ;;; end of efs-mts.el
|
