|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-mvs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
116
|
6 ;; Version: #Revision: 1.4 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: MVS support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@math.ubc.ca, sandy@itp.ethz.ch>
|
|
|
10 ;; Created: Sat Nov 14 02:04:54 1992
|
|
|
11 ;; Modified: Sun Nov 27 18:37:54 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 ;;; --------------------------------------------------------
|
|
|
20 ;;; MVS support
|
|
|
21 ;;; --------------------------------------------------------
|
|
|
22
|
|
|
23 (provide 'efs-mvs)
|
|
|
24 (require 'efs)
|
|
|
25
|
|
|
26 (defconst efs-mvs-version
|
|
|
27 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
28 "/"
|
|
116
|
29 (substring "#Revision: 1.4 $" 11 -2)))
|
|
22
|
30
|
|
|
31 ;; What's the MVS character set for valid partitioned data sets?
|
|
|
32 ;; I'll guess [-A-Z0-9_$+]
|
|
|
33
|
|
|
34 ;; The top level directory in MVS contains partitioned data sets.
|
|
|
35 ;; We will view these as directories. The data sets within each
|
|
|
36 ;; partitioned data set will be viewed as files.
|
|
|
37 ;;
|
|
|
38 ;; In MVS an entry for a "sub-dir" may have the same name as a plain
|
|
|
39 ;; file. This is impossible in unix, so we retain the "dots" at the
|
|
|
40 ;; end of subdir names, to distinuguish.
|
|
|
41 ;; i.e. FOO.BAR --> /FOO./BAR
|
|
|
42
|
|
|
43 (efs-defun efs-send-pwd mvs (host user &optional xpwd)
|
|
|
44 ;; Broken quoting for PWD output on some MVS servers.
|
|
|
45 (let* ((result (efs-send-cmd host user '(pwd) "Getting EXPLORER PWD"))
|
|
|
46 (line (nth 1 result))
|
|
|
47 dir)
|
|
|
48 (and (car result)
|
|
|
49 (efs-save-match-data
|
|
|
50 (and (string-match " \"'?\\([0-9A-Z]+\\)'?\"" line)
|
|
|
51 (setq dir (substring line (match-beginning 1)
|
|
|
52 (match-end 1))))))
|
|
|
53 (cons dir line)))
|
|
|
54
|
|
|
55 (efs-defun efs-fix-path mvs (path &optional reverse)
|
|
|
56 ;; Convert PATH from UNIX-ish to MVS.
|
|
|
57 (efs-save-match-data
|
|
|
58 (if reverse
|
|
|
59 (let ((start 0)
|
|
|
60 (res "/"))
|
|
|
61 ;; MVS has only files, some of which are partitioned
|
|
|
62 ;; into smaller files (partitioned data sets). We will
|
|
|
63 ;; assume that path starts with a partitioned dataset.
|
|
|
64 (while (string-match "\\." path)
|
|
|
65 ;; grab the dot too, because in mvs prefixes and plain
|
|
|
66 ;; files can have the same name.
|
|
|
67 (setq res (concat res (substring path start (match-end 0)) "/")
|
|
|
68 start (match-end 0)))
|
|
|
69 (concat res (substring path start)))
|
|
|
70 (let ((start 1)
|
|
|
71 res)
|
|
|
72 (while (string-match "/" path start)
|
|
|
73 (setq res (concat res (substring path start (match-beginning 0)))
|
|
|
74 start (match-end 0)))
|
|
|
75 (concat res (substring path start))))))
|
|
|
76
|
|
|
77 (efs-defun efs-fix-dir-path mvs (dir-path)
|
|
|
78 ;; Convert path from UNIX-ish to MVS for a DIR listing.
|
|
|
79 (cond
|
|
|
80 ((string-equal "/" dir-path)
|
|
|
81 " ")
|
|
|
82 (t (concat (efs-fix-path 'mvs dir-path) "*"))))
|
|
|
83
|
|
|
84 (efs-defun efs-allow-child-lookup mvs (host user dir file)
|
|
|
85 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
86 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
87 ;; be attempted.
|
|
|
88 ;; MVS file system is flat. Only partitioned data sets are "subdirs".
|
|
|
89 (efs-save-match-data
|
|
|
90 (string-match "\\.$" file)))
|
|
|
91
|
|
|
92 (efs-defun efs-parse-listing mvs (host user dir path &optional switches)
|
|
|
93 ;; Guesses the type of mvs listings.
|
|
|
94 (efs-save-match-data
|
|
|
95 (goto-char (point-min))
|
|
|
96 (cond
|
|
|
97 ((looking-at "Volume ")
|
|
|
98 (efs-add-listing-type 'mvs:tcp host user)
|
|
|
99 (efs-parse-listing 'mvs:tcp host user dir path switches))
|
|
|
100
|
|
|
101 ((looking-at "[-A-Z0-9_$.+]+ ")
|
|
|
102 (efs-add-listing-type 'mvs:nih host user)
|
|
|
103 (efs-parse-listing 'mvs:nih host user dir path switches))
|
|
|
104
|
|
|
105 (t
|
|
|
106 ;; Since MVS works on a template system, return an empty hashtable.
|
|
|
107 (let ((tbl (efs-make-hashtable)))
|
|
|
108 (efs-put-hash-entry "." '(t) tbl)
|
|
|
109 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
110 tbl)))))
|
|
|
111
|
|
|
112 (efs-defun efs-ls-dumb-check mvs (line host file path lsargs msg noparse
|
|
|
113 noerror nowait cont)
|
|
|
114 ;; Because of the template structure of the MVS file system, empty
|
|
|
115 ;; directories are the same as non-existent. It's better for us to treat
|
|
|
116 ;; them as empty.
|
|
|
117 (and (string-match "^550 " line)
|
|
|
118 (let ((parse (or (null noparse) (eq noparse 'parse)
|
|
|
119 (efs-parsable-switches-p lsargs t))))
|
|
|
120 (efs-add-to-ls-cache file lsargs "\n" parse)
|
|
|
121 (if parse
|
|
|
122 (efs-set-files file (let ((tbl (efs-make-hashtable)))
|
|
|
123 (efs-put-hash-entry "." '(t) tbl)
|
|
|
124 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
125 tbl)))
|
|
|
126 (if nowait
|
|
|
127 (progn
|
|
|
128 (if cont
|
|
|
129 (efs-call-cont cont "\n"))
|
|
|
130 t)
|
|
|
131 (if cont
|
|
|
132 (efs-call-cont cont "\n"))
|
|
|
133 "\n"))))
|
|
|
134
|
|
|
135 ;;;; ----------------------------------------------------
|
|
|
136 ;;;; Support for the NIH FTP server.
|
|
|
137 ;;;; ----------------------------------------------------
|
|
|
138
|
|
|
139 (efs-defun efs-parse-listing mvs:nih
|
|
|
140 (host user dir path &optional switches)
|
|
|
141 ;; Parse the current buffer which is assumed to be an MVS listing
|
|
|
142 ;; Based on the listing format of the NIH server. Hope that this format
|
|
|
143 ;; is widespread. If a directory doesn't exist, get a 426 ftp error.
|
|
|
144 ;; HOST = remote host name
|
|
|
145 ;; USER = user name
|
|
|
146 ;; DIR = directory as a remote full path
|
|
|
147 ;; PATH = directory in full efs-syntax
|
|
|
148 (let ((tbl (efs-make-hashtable))
|
|
|
149 (top-p (string-equal "/" dir))
|
|
|
150 ;; assume that everything top-level is a partitioned data set
|
|
|
151 )
|
|
|
152 (goto-char (point-min))
|
|
|
153 (efs-save-match-data
|
|
|
154 (while (re-search-forward "^[-A-Z0-9_$.+]+" nil t)
|
|
|
155 (efs-put-hash-entry
|
|
|
156 (concat (buffer-substring (match-beginning 0) (match-end 0))
|
|
|
157 (and top-p "."))
|
|
|
158 (list top-p) tbl)
|
|
|
159 (forward-line 1))
|
|
|
160 (efs-put-hash-entry "." '(t) tbl)
|
|
|
161 (or top-p (efs-put-hash-entry ".." '(t) tbl)))
|
|
|
162 tbl))
|
|
|
163
|
|
|
164 ;;; Tree dired support
|
|
|
165
|
|
|
166 (defconst efs-dired-mvs-re-exe
|
|
|
167 "^. [-A-Z0-9_$+]+\\.EXE "
|
|
|
168 "Regular expression to use to search for MVS executables.")
|
|
|
169
|
|
|
170 (or (assq 'mvs:nih efs-dired-re-exe-alist)
|
|
|
171 (setq efs-dired-re-exe-alist
|
|
|
172 (cons (cons 'mvs:nih efs-dired-mvs-re-exe)
|
|
|
173 efs-dired-re-exe-alist)))
|
|
|
174
|
|
|
175 (efs-defun efs-dired-insert-headerline mvs:nih (dir)
|
|
|
176 ;; MVS has no total line, so we insert a blank line for
|
|
|
177 ;; aesthetics.
|
|
|
178 (insert "\n")
|
|
|
179 (forward-char -1)
|
|
|
180 (efs-real-dired-insert-headerline dir))
|
|
|
181
|
|
|
182 (efs-defun efs-dired-manual-move-to-filename mvs:nih
|
|
|
183 (&optional raise-error bol eol)
|
|
|
184 ;; In dired, move to the first char of the filename on this line.
|
|
|
185 ;; This is the MVS version.
|
|
|
186 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
187 (let (case-fold-search)
|
|
|
188 (if bol
|
|
|
189 (goto-char bol)
|
|
|
190 (skip-chars-backward "^\n\r")
|
|
|
191 (setq bol (point)))
|
|
|
192 ;; MVS listings are pretty loose. Tough to tell when we've got a file line.
|
|
|
193 (if (and
|
|
|
194 (> (- eol bol) 2)
|
|
|
195 (progn
|
|
|
196 (forward-char 2)
|
|
|
197 (skip-chars-forward " \t")
|
|
|
198 (looking-at "[-A-Z0-9$_.+]+[ \n\r]")))
|
|
|
199 (point)
|
|
|
200 (goto-char bol)
|
|
|
201 (and raise-error (error "No file on this line")))))
|
|
|
202
|
|
|
203 (efs-defun efs-dired-manual-move-to-end-of-filename mvs:nih
|
|
|
204 (&optional no-error bol eol)
|
|
|
205 ;; Assumes point is at the beginning of filename.
|
|
|
206 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
207 ;; case-fold-search must be nil, at least for VMS.
|
|
|
208 ;; On failure, signals an error or returns nil.
|
|
|
209 ;; This is the MVS version.
|
|
|
210 (let ((opoint (point)))
|
|
|
211 (and selective-display
|
|
|
212 (null no-error)
|
|
|
213 (eq (char-after
|
|
|
214 (1- (or bol (save-excursion
|
|
|
215 (skip-chars-backward "^\r\n")
|
|
|
216 (point)))))
|
|
|
217 ?\r)
|
|
|
218 ;; File is hidden or omitted.
|
|
|
219 (cond
|
|
|
220 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
221 (error
|
|
|
222 (substitute-command-keys
|
|
|
223 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
224 ((error
|
|
|
225 (substitute-command-keys
|
|
|
226 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
227 )))))
|
|
|
228 (skip-chars-forward "-A-Z0-9$_.+" eol)
|
|
|
229 (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
|
|
|
230 (if no-error
|
|
|
231 nil
|
|
|
232 (error "No file on this line"))
|
|
|
233 (point))))
|
|
|
234
|
|
|
235 (efs-defun efs-dired-get-filename mvs:nih
|
|
|
236 (&optional localp no-error-if-not-filep)
|
|
|
237 (let ((name (efs-real-dired-get-filename localp no-error-if-not-filep))
|
|
|
238 (parsed (efs-ftp-path (dired-current-directory))))
|
|
|
239 (if (and name (string-equal "/" (nth 2 parsed)))
|
|
|
240 (concat name ".")
|
|
|
241 name)))
|
|
|
242
|
|
|
243 (efs-defun efs-dired-fixup-listing mvs:nih
|
|
|
244 (file path &optional switches wildcard)
|
|
|
245 ;; MVS listings have trailing spaces to 80 columns.
|
|
|
246 ;; Can lead to a mess after indentation.
|
|
|
247 (goto-char (point-min))
|
|
|
248 (while (re-search-forward " +$" nil t)
|
|
|
249 (replace-match "")))
|
|
|
250
|
|
|
251 ;;;; -------------------------------------------------------
|
|
|
252 ;;;; Support for the TCPFTP MVS server
|
|
|
253 ;;;; -------------------------------------------------------
|
|
|
254 ;;;
|
|
|
255 ;;; For TCPFTP IBM MVS V2R2.1 Does it really work?
|
|
|
256
|
|
|
257 (efs-defun efs-parse-listing mvs:tcp
|
|
|
258 (host user dir path &optional switches)
|
|
|
259 ;; Parse the current buffer which is assumed to be an MVS listing
|
|
|
260 ;; Based on the listing format of the NIH server. Hope that this format
|
|
|
261 ;; is widespread. If a directory doesn't exist, get a 426 ftp error.
|
|
|
262 ;; HOST = remote host name
|
|
|
263 ;; USER = user name
|
|
|
264 ;; DIR = directory as a remote full path
|
|
|
265 ;; PATH = directory in full efs-syntax
|
|
|
266 (efs-save-match-data
|
|
|
267 (goto-char (point-min))
|
|
|
268 (and (looking-at "Volume ")
|
|
|
269 (let ((top-tbl (efs-make-hashtable))
|
|
|
270 (case-fold (memq 'mvs efs-case-insensitive-host-types))
|
|
|
271 tbl-list file dn fn tbl dir-p)
|
|
|
272 (forward-line 1)
|
|
|
273 (while (not (eobp))
|
|
|
274 (end-of-line)
|
|
|
275 (setq file (buffer-substring (point)
|
|
|
276 (progn (skip-chars-backward "^ ")
|
|
|
277 (point)))
|
|
|
278 dn path
|
|
|
279 dir-p (string-match "\\." file))
|
|
|
280 (efs-put-hash-entry file '(nil) top-tbl)
|
|
|
281 (if dir-p
|
|
|
282 (progn
|
|
|
283 (setq dir-p (1+ dir-p)
|
|
|
284 fn (substring file 0 dir-p))
|
|
|
285 (efs-put-hash-entry fn '(t) top-tbl)
|
|
|
286 (while dir-p
|
|
|
287 (setq dn (efs-internal-file-name-as-directory nil
|
|
|
288 (concat dn fn))
|
|
|
289 file (substring file dir-p)
|
|
|
290 tbl (cdr (assoc dn tbl-list)))
|
|
|
291 (or tbl (setq tbl (efs-make-hashtable)
|
|
|
292 tbl-list (cons (cons dn tbl) tbl-list)))
|
|
|
293 (efs-put-hash-entry file '(nil) tbl)
|
|
|
294 (setq dir-p (string-match "\\." file))
|
|
|
295 (if dir-p
|
|
|
296 (progn
|
|
|
297 (setq dir-p (1+ dir-p)
|
|
|
298 fn (substring file 0 dir-p))
|
|
|
299 (efs-put-hash-entry fn '(t) tbl))))))
|
|
|
300 (forward-line 1))
|
|
|
301 (while tbl-list
|
|
|
302 (efs-put-hash-entry (car (car tbl-list)) (cdr (car tbl-list))
|
|
|
303 efs-files-hashtable case-fold)
|
|
|
304 (setq tbl-list (cdr tbl-list)))
|
|
|
305 top-tbl))))
|
|
|
306
|
|
|
307 ;;; Tree Dired
|
|
|
308
|
|
|
309 (efs-defun efs-dired-manual-move-to-filename mvs:tcp
|
|
|
310 (&optional raise-error bol eol)
|
|
|
311 ;; In dired, move to the first char of the filename on this line.
|
|
|
312 ;; This is the MVS version.
|
|
|
313 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
314 (let (case-fold-search)
|
|
|
315 (if bol
|
|
|
316 (goto-char bol)
|
|
|
317 (skip-chars-backward "^\n\r")
|
|
|
318 (setq bol (point)))
|
|
|
319 (if (and (re-search-forward " [0-9][0-9]/[0-9][0-9]/[0-9][0-9] " eol t)
|
|
|
320 (progn
|
|
|
321 (goto-char eol)
|
|
|
322 (skip-chars-backward "-A-Z0-9$_.")
|
|
|
323 (char-equal (preceding-char) ?\ ))
|
|
|
324 (/= eol (point)))
|
|
|
325 (point)
|
|
|
326 (goto-char bol)
|
|
|
327 (and raise-error (error "No file on this line")))))
|
|
|
328
|
|
|
329 (efs-defun efs-dired-manual-move-to-end-of-filename mvs:tcp
|
|
|
330 (&optional no-error bol eol)
|
|
|
331 ;; Assumes point is at the beginning of filename.
|
|
|
332 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
333 ;; case-fold-search must be nil, at least for VMS.
|
|
|
334 ;; On failure, signals an error or returns nil.
|
|
|
335 ;; This is the MVS version.
|
|
|
336 (let ((opoint (point)))
|
|
|
337 (and selective-display
|
|
|
338 (null no-error)
|
|
|
339 (eq (char-after
|
|
|
340 (1- (or bol (save-excursion
|
|
|
341 (skip-chars-backward "^\r\n")
|
|
|
342 (point)))))
|
|
|
343 ?\r)
|
|
|
344 ;; File is hidden or omitted.
|
|
|
345 (cond
|
|
|
346 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
347 (error
|
|
|
348 (substitute-command-keys
|
|
|
349 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
350 ((error
|
|
|
351 (substitute-command-keys
|
|
|
352 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
353 )))))
|
|
|
354 (skip-chars-forward "-A-Z0-9$_.+" eol)
|
|
|
355 (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
|
|
|
356 (if no-error
|
|
|
357 nil
|
|
|
358 (error "No file on this line"))
|
|
|
359 (point))))
|
|
|
360
|
|
|
361 ;;; end of efs-mvs.el
|
