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