|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-cms-knet.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: CMS support for efs using KNET/VM server
|
|
|
9 ;; Authors: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
10 ;; Joerg-Martin Schwarz <schwarz@hal1.physik.uni-dortmund.de>
|
|
|
11 ;; Created: Wed Mar 23 14:39:00 1994 by schwarz on hal1 from efs-cms.el
|
|
|
12 ;; Modified: Sun Nov 27 11:45:58 1994 by sandy on gandalf
|
|
|
13 ;; Language: Emacs-Lisp
|
|
|
14 ;;
|
|
|
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
16
|
|
|
17 ;;; This file is part of efs. See efs.el for copyright
|
|
|
18 ;;; (it's copylefted) and warrranty (there isn't one) information.
|
|
|
19
|
|
|
20 (provide 'efs-cms-knet)
|
|
|
21 (require 'efs)
|
|
|
22
|
|
|
23 (defconst efs-cms-knet-version
|
|
|
24 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
25 "/"
|
|
|
26 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
27
|
|
|
28 ;;;; ------------------------------------------------------------
|
|
|
29 ;;;; CMS support for KNET-VM server
|
|
|
30 ;;;; ------------------------------------------------------------
|
|
|
31
|
|
|
32 ;;; efs has full support, including tree dired support, for hosts running
|
|
|
33 ;;; CMS. It should be able to automatically recognize any CMS machine.
|
|
|
34 ;;; We would be grateful if you would report any failures to automatically
|
|
|
35 ;;; recognize a CMS host as a bug.
|
|
|
36 ;;;
|
|
|
37 ;;; Filename syntax:
|
|
|
38 ;;;
|
|
|
39 ;;; KNET/VM Support (J. M. Schwarz, Mar 12, 1994):
|
|
|
40 ;;; This code has been developed and tested with
|
|
|
41 ;;; "KNET/VM FTP server Release 3.2.0" by Spartacus.
|
|
|
42 ;;;
|
|
|
43 ;;; This server uses not only a different listing format than the one used in
|
|
|
44 ;;; efs-cms.el, but also handles minidisks differently.
|
|
|
45 ;;; The cd command for changing minidisk is not supported,
|
|
|
46 ;;; instead a full filename syntax "FILENAME.FILETYPE.FM" is used, where
|
|
|
47 ;;; FM is the filemode. To access a file "PROFILE EXEC A0", efs uses a
|
|
|
48 ;;; syntax "/cms-hostname:/A:/PROFILE.EXEC" (Note the ':')
|
|
|
49 ;;;
|
|
|
50 ;;; In this directory notation, "/A0:" is actually a subset of the "/A:"
|
|
|
51 ;;; directory.
|
|
|
52
|
|
|
53 (efs-defun efs-send-pwd cms-knet (host user &optional xpwd)
|
|
|
54 ;; cms-knet has no concept of current directory.
|
|
|
55 ;; Is it safe to always assume this is the user's home?
|
|
|
56 (cons "A" ""))
|
|
|
57
|
|
|
58 (efs-defun efs-fix-path cms-knet (path &optional reverse)
|
|
|
59 ;; Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
|
|
|
60 ;; from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
|
|
|
61 ;; so we fudge things by sending cd's.
|
|
|
62 (if reverse
|
|
|
63 ;; Since we only convert output from a pwd in this direction,
|
|
|
64 ;; this should never be applied, as PWD doesn't work for this server.
|
|
|
65 (concat "/" path "/")
|
|
|
66 (efs-save-match-data
|
|
|
67 (if (string-match "^/[A-Z]/\\([-A-Z0-9$_+@:]+\\.[-A-Z0-9$_+@:]+\\)$"
|
|
|
68 path)
|
|
|
69 (concat
|
|
|
70 (substring path (match-beginning 1) (match-end 1))
|
|
|
71 "."
|
|
|
72 ;; minidisk
|
|
|
73 (substring path 1 2))
|
|
|
74 (error "Invalid CMS-KNET filename")))))
|
|
|
75
|
|
|
76 (efs-defun efs-fix-dir-path cms-knet (dir-path)
|
|
|
77 ;; Convert path from UNIX-ish to CMS-KNET ready for a DIRectory listing.
|
|
|
78 (cond
|
|
|
79 ((string-equal "/" dir-path)
|
|
|
80 "*.*.*")
|
|
|
81 ((string-match
|
|
|
82 "^/[A-Z]/\\([-A-Z0-9$._+@:]+\\.[-A-Z0-9$._+@:]+\\)?$"
|
|
|
83 dir-path)
|
|
|
84 (concat
|
|
|
85 (if (match-beginning 1)
|
|
|
86 (substring dir-path (match-beginning 1) (match-end 1))
|
|
|
87 "*")
|
|
|
88 "."
|
|
|
89 (substring dir-path 1 2)))
|
|
|
90 (t (error "Invalid CMS-KNET pathname"))))
|
|
|
91
|
|
|
92 (defconst efs-cms-knet-file-name-regexp
|
|
|
93 (concat
|
|
|
94 "^ *\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +"
|
|
|
95 "\\([A-Z]\\)[0-9] +[VF] +[0-9]+ "))
|
|
|
96
|
|
|
97 (efs-defun efs-parse-listing cms-knet
|
|
|
98 (host user dir path &optional switches)
|
|
|
99 ;; Parse the current buffer which is assumed to be a CMS directory listing.
|
|
|
100 ;; HOST = remote host name
|
|
|
101 ;; USER = remote user name
|
|
|
102 ;; DIR = directory as a full remote path
|
|
|
103 ;; PATH = directory as a full efs-path
|
|
|
104 (let ((tbl (efs-make-hashtable)))
|
|
|
105 (goto-char (point-min))
|
|
|
106 (efs-save-match-data
|
|
|
107 (if (string-equal dir "/")
|
|
|
108 (let ((case-fold (memq 'cms-knet efs-case-insensitive-host-types))
|
|
|
109 tbl-alist md md-tbl)
|
|
|
110 (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
|
|
|
111 (setq md (buffer-substring (match-beginning 3) (match-end 3))
|
|
|
112 md-tbl (or (cdr (assoc md tbl-alist))
|
|
|
113 (let ((new-tbl (efs-make-hashtable)))
|
|
|
114 (setq tbl-alist
|
|
|
115 (cons (cons md new-tbl)
|
|
|
116 tbl-alist))
|
|
|
117 new-tbl)))
|
|
|
118 (efs-put-hash-entry md '(t) tbl)
|
|
|
119 (efs-put-hash-entry (concat
|
|
|
120 (buffer-substring (match-beginning 1)
|
|
|
121 (match-end 1))
|
|
|
122 "."
|
|
|
123 (buffer-substring (match-beginning 2)
|
|
|
124 (match-end 2)))
|
|
|
125 '(nil) md-tbl)
|
|
|
126 (forward-line 1))
|
|
|
127 (while tbl-alist
|
|
|
128 (setq md (car (car tbl-alist))
|
|
|
129 md-tbl (cdr (car tbl-alist)))
|
|
|
130 (efs-put-hash-entry "." '(t) md-tbl)
|
|
|
131 (efs-put-hash-entry ".." '(t) md-tbl)
|
|
|
132 (efs-put-hash-entry (concat path md "/") md-tbl
|
|
|
133 efs-files-hashtable case-fold)
|
|
|
134 (setq tbl-alist (cdr tbl-alist))))
|
|
|
135 (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
|
|
|
136 (efs-put-hash-entry
|
|
|
137 (concat (buffer-substring (match-beginning 1)
|
|
|
138 (match-end 1))
|
|
|
139 "."
|
|
|
140 (buffer-substring (match-beginning 2)
|
|
|
141 (match-end 2)))
|
|
|
142 '(nil) tbl)
|
|
|
143 (forward-line 1)))
|
|
|
144 (efs-put-hash-entry "." '(t) tbl)
|
|
|
145 (efs-put-hash-entry ".." '(t) tbl))
|
|
|
146 tbl))
|
|
|
147
|
|
|
148 (efs-defun efs-allow-child-lookup cms-knet (host user dir file)
|
|
|
149 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
150 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
151 ;; be attempted.
|
|
|
152
|
|
|
153 ;; CMS file system is flat. Only minidisks are "subdirs".
|
|
|
154 (string-equal "/" dir))
|
|
|
155
|
|
|
156 ;;; Tree dired support:
|
|
|
157
|
|
|
158 (defconst efs-dired-cms-re-exe
|
|
|
159 "^. +[-A-Z0-9$_+@:]+ +\\(EXEC\\|MODULE\\) "
|
|
|
160 "Regular expression to use to search for CMS executables.")
|
|
|
161
|
|
|
162 (or (assq 'cms efs-dired-re-exe-alist)
|
|
|
163 (setq efs-dired-re-exe-alist
|
|
|
164 (cons (cons 'cms-knet efs-dired-cms-re-exe)
|
|
|
165 efs-dired-re-exe-alist)))
|
|
|
166
|
|
|
167 (efs-defun efs-dired-insert-headerline cms-knet (dir)
|
|
|
168 ;; CMS has no total line, so we insert a blank line for
|
|
|
169 ;; aesthetics.
|
|
|
170 (insert "\n")
|
|
|
171 (forward-char -1)
|
|
|
172 (efs-real-dired-insert-headerline dir))
|
|
|
173
|
|
|
174 (efs-defun efs-dired-manual-move-to-filename cms-knet
|
|
|
175 (&optional raise-error bol eol)
|
|
|
176 ;; In dired, move to the first char of filename on this line.
|
|
|
177 ;; This is the CMS version.
|
|
|
178 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
179 (let (case-fold-search)
|
|
|
180 (if bol
|
|
|
181 (goto-char bol)
|
|
|
182 (skip-chars-backward "^\n\r")
|
|
|
183 (setq bol (point)))
|
|
|
184 (if (re-search-forward efs-cms-knet-file-name-regexp eol t)
|
|
|
185 (goto-char (match-beginning 1))
|
|
|
186 (if raise-error
|
|
|
187 (error "No file on this line.")
|
|
|
188 (goto-char bol)))))
|
|
|
189
|
|
|
190 (efs-defun efs-dired-manual-move-to-end-of-filename cms-knet
|
|
|
191 (&optional no-error bol eol)
|
|
|
192 ;; Assumes point is at beginning of filename.
|
|
|
193 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
194 ;; case-fold-search must be nil, at least for VMS.
|
|
|
195 ;; On failure, signals an error or returns nil.
|
|
|
196 ;; This is the CMS version.
|
|
|
197 (and selective-display
|
|
|
198 (null no-error)
|
|
|
199 (eq (char-after
|
|
|
200 (1- (or bol (save-excursion
|
|
|
201 (skip-chars-backward "^\r\n")
|
|
|
202 (point)))))
|
|
|
203 ?\r)
|
|
|
204 ;; File is hidden or omitted.
|
|
|
205 (cond
|
|
|
206 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
207 (error
|
|
|
208 (substitute-command-keys
|
|
|
209 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
210 ((error
|
|
|
211 (substitute-command-keys
|
|
|
212 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
213 )))))
|
|
|
214 (if (looking-at "[-A-Z0-9$_+@:]+ +[-A-Z0-9$_+@:]+ +[A-Z][0-9] ")
|
|
|
215 (goto-char (- (match-end 0) 2)) ; return point
|
|
|
216 (if no-error
|
|
|
217 nil
|
|
|
218 (error "No file on this line."))))
|
|
|
219
|
|
|
220 (efs-defun efs-dired-get-filename cms-knet
|
|
|
221 (&optional localp no-error-if-not-filep)
|
|
|
222 (let ((name (efs-real-dired-get-filename 'no-dir no-error-if-not-filep)))
|
|
|
223 (and name
|
|
|
224 (if (string-match
|
|
|
225 "^\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +\\([A-Z]\\)$"
|
|
|
226 name)
|
|
|
227 (let* ((dir (dired-current-directory))
|
|
|
228 (rdir (nth 2 (efs-ftp-path dir))))
|
|
|
229 (setq name (concat (substring name (match-beginning 1)
|
|
|
230 (match-end 1))
|
|
|
231 "."
|
|
|
232 (substring name (match-beginning 2)
|
|
|
233 (match-end 2))))
|
|
|
234 (if (string-equal rdir "/")
|
|
|
235 (setq name (concat (substring name (match-beginning 3)
|
|
|
236 (match-end 3)) "/" name)))
|
|
|
237 (if (eq localp 'no-dir)
|
|
|
238 name
|
|
|
239 (concat (if localp
|
|
|
240 (dired-current-directory localp)
|
|
|
241 dir)
|
|
|
242 name)))
|
|
|
243 (error "Strange CMS-KNET file name %s" name)))))
|
|
|
244
|
|
|
245 ;;; end of efs-cms-knet.el
|
