Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-cms-knet.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 8b8b7f3559a2 8619ce7e4c50
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
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