annotate lisp/efs/efs-cms.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 7e54bd776075 9f59509498e1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
22
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
1 ;; -*-Emacs-Lisp-*-
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
3 ;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
4 ;; File: efs-cms.el
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
5 ;; Release: $efs release: 1.15 $
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
6 ;; Version: $Revision: 1.1 $
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
7 ;; RCS:
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
8 ;; Description: CMS support for efs
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
10 ;; Created: Fri Oct 23 08:52:00 1992
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
11 ;; Modified: Sun Nov 27 11:46:51 1994 by sandy on gandalf
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
12 ;; Language: Emacs-Lisp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
13 ;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
15
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
16 ;;; This file is part of efs. See efs.el for copyright
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
17 ;;; (it's copylefted) and warrranty (there isn't one) information.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
18
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
19 (provide 'efs-cms)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
20 (require 'efs)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
21
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
22 (defconst efs-cms-version
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
23 (concat (substring "$efs release: 1.15 $" 14 -2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
24 "/"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
25 (substring "$Revision: 1.1 $" 11 -2)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
26
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
27 ;;;; ------------------------------------------------------------
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
28 ;;;; CMS support
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
29 ;;;; ------------------------------------------------------------
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
30
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
31 ;;; efs has full support, including tree dired support, for hosts running
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
32 ;;; CMS. It should be able to automatically recognize any CMS machine.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
33 ;;; We would be grateful if you would report any failures to automatically
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
34 ;;; recognize a CMS host as a bug.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
35 ;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
36 ;;; This should also work with CMS machines running SFS (Shared File System).
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
37 ;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
38 ;;; Filename syntax:
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
39 ;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
40 ;;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
41 ;;; treated as UNIX directories. For example to access the file READ.ME in
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
42 ;;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
43 ;;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
44 ;;; If *.301 is the default minidisk for this account, you could access
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
45 ;;; FOO.BAR on this minidisk as
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
46 ;;; /anonymous@cuvmb.cc.columbia.edu:FOO.BAR
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
47 ;;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
48 ;;; up to 8 characters. Again, beware that CMS filenames are always upper
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
49 ;;; case, and hence must be entered as such.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
50 ;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
51 ;;; Tips:
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
52 ;;; 1. CMS machines, with the exception of anonymous accounts, nearly always
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
53 ;;; need an account password. To have efs send an account password,
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
54 ;;; you can either include it in your .netrc file, or use
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
55 ;;; efs-set-account.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
56 ;;; 2. efs-set-account can be used to set account passwords for specific
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
57 ;;; minidisks. This is usually used to optain write access to the minidisk.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
58 ;;; As well you can put tokens of the form
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
59 ;;; minidisk <minidisk name> <password> in your .netrc file. There can be
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
60 ;;; as many minidisk tokens as you like, however they should follow all
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
61 ;;; other tokens for a given machine entry. Of course, ordinary ftp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
62 ;;; will not understand these entries in your .netrc file.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
63 ;;;
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
64
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
65
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
66 ;;; Since CMS doesn't have any full pathname syntax, we have to fudge
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
67 ;;; things with cd's. We actually send too many cd's, but is dangerous
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
68 ;;; to try to remember the current minidisk, because if the connection
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
69 ;;; is closed and needs to be reopened, we will find ourselves back in
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
70 ;;; the default minidisk. This is fairly likely since CMS ftp servers
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
71 ;;; usually close the connection after 5 minutes of inactivity.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
72
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
73 ;;; Have I got the filename character set right?
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
74
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
75 ;;; The following three functions are entry points to this file.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
76 ;;; They have been added to the appropriate alists in efs.el
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
77
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
78 (efs-defun efs-fix-path cms (path &optional reverse)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
79 ;; Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
80 ;; from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
81 ;; so we fudge things by sending cd's.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
82 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
83 (if reverse
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
84 (if (string-match ":" path)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
85 ;; It's SFS
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
86 (let* ((start (match-end 0))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
87 (return (concat "/" (substring path 0 start))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
88 (while (string-match "\\." path start)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
89 (setq return (concat return "/"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
90 (substring path start
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
91 (match-beginning 0)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
92 start (match-end 0)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
93 (concat return "/" (substring path start)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
94 ;; Since we only convert output from a pwd in this direction,
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
95 ;; we'll assume that it's a minidisk, and make it into a
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
96 ;; directory file name. Note that the expand-dir-hashtable
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
97 ;; stores directories without the trailing /.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
98 (if (char-equal (string-to-char path) ?/)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
99 path
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
100 (concat "/" path)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
101 (if (let ((case-fold-search t))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
102 (string-match
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
103 (concat
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
104 "^/\\([-A-Z0-9$*._+:]+\\)/"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
105 ;; In case there is a SFS
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
106 "\\(\\([-A-Z0-9$*._+]+\\)/\\([-A-Z0-9$*._+]+/\\)?\\)?"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
107 "\\([-A-Z0-9$._+]+\\)$")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
108 path))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
109 (let ((minidisk (substring path 1 (match-end 1)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
110 (sfs (and (match-beginning 2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
111 (substring path (match-beginning 3)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
112 (match-end 3))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
113 (file (substring path (match-beginning 5) (match-end 5)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
114 account)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
115 (and sfs (match-beginning 4)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
116 (setq sfs (concat sfs "." (substring path (match-beginning 4)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
117 (1- (match-end 4))))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
118 (unwind-protect
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
119 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
120 (or sfs
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
121 (setq account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
122 (efs-get-account host user minidisk)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
123 (efs-raw-send-cd host user (if sfs
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
124 (concat minidisk sfs ".")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
125 minidisk))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
126 (if account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
127 (efs-cms-send-minidisk-acct
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
128 host user minidisk account)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
129 (if account (fillarray account 0)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
130 file)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
131 (error "Invalid CMS filename")))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
132
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
133 (efs-defun efs-fix-dir-path cms (dir-path)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
134 ;; Convert path from UNIX-ish to VMS ready for a DIRectory listing.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
135 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
136 (cond
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
137 ((string-equal "/" dir-path)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
138 (error "Cannot get listing for CMS \"/\" directory."))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
139 ((let ((case-fold-search t))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
140 (string-match
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
141 (concat "^/\\([-A-Z0-9$*._+:]+\\)/"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
142 "\\(\\([-A-Z0-9$*._+]+\\)/\\([-A-Z0-9$*._+]+/\\)?\\)?"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
143 "\\([-A-Z0-9$*_.+]+\\)?$") dir-path))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
144 (let ((minidisk (substring dir-path (match-beginning 1) (match-end 1)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
145 (sfs (and (match-beginning 2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
146 (concat
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
147 (substring dir-path (match-beginning 3)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
148 (match-end 3)))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
149 (file (if (match-beginning 5)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
150 (substring dir-path (match-beginning 5) (match-end 5))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
151 "*"))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
152 account)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
153 (and sfs (match-beginning 4)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
154 (setq sfs (concat sfs "." (substring dir-path
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
155 (match-beginning 4)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
156 (1- (match-end 4))))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
157 (unwind-protect
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
158 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
159 (or sfs
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
160 (setq account (efs-get-account host user minidisk)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
161 (efs-raw-send-cd host user (if sfs
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
162 (concat minidisk sfs ".")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
163 minidisk))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
164 (if account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
165 (efs-cms-send-minidisk-acct host user minidisk account)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
166 (if account (fillarray account 0)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
167 file))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
168 (t (error "Invalid CMS pathname")))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
169
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
170 (defconst efs-cms-file-line-regexp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
171 (concat
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
172 "\\([-A-Z0-9$_+]+\\) +"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
173 "\\(\\(\\([-A-Z0-9$_+]+\\) +[VF] +[0-9]+ \\)\\|\\(DIR +- \\)\\)"))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
174
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
175 (efs-defun efs-parse-listing cms
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
176 (host user dir path &optional switches)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
177 ;; Parse the current buffer which is assumed to be a CMS directory listing.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
178 ;; HOST = remote host name
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
179 ;; USER = remote user name
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
180 ;; DIR = directory as a full remote path
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
181 ;; PATH = directory as a full efs-path
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
182 (let ((tbl (efs-make-hashtable))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
183 fn dir-p)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
184 (goto-char (point-min))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
185 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
186 (while (re-search-forward efs-cms-file-line-regexp nil t)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
187 (if (match-beginning 3)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
188 (setq fn (concat (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
189 (match-beginning 1) (match-end 1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
190 "."
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
191 (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
192 (match-beginning 4) (match-end 4)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
193 dir-p nil)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
194 (setq fn (buffer-substring (match-beginning 1) (match-end 1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
195 dir-p t))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
196 (efs-put-hash-entry fn (list dir-p) tbl)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
197 (forward-line 1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
198 (efs-put-hash-entry "." '(t) tbl)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
199 (efs-put-hash-entry ".." '(t) tbl))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
200 tbl))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
201
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
202 (defun efs-cms-send-minidisk-acct (host user minidisk account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
203 &optional noretry)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
204 "For HOST and USER, send the account password ACCOUNT. If MINIDISK is given,
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
205 the account password is for that minidisk. If PROC is given, send to that
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
206 process, rathr than use HOST and USER to look up the process."
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
207 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
208 (let ((result (efs-raw-send-cmd
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
209 (efs-get-process host user)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
210 (concat "quote acct " account))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
211 (cond
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
212 ((eq (car result) 'failed)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
213 (setq account nil)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
214 (unwind-protect
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
215 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
216 (setq
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
217 account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
218 (read-passwd
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
219 (format
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
220 "Invalid acct. password for %s on %s@%s. Try again: "
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
221 minidisk user host)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
222 (if (string-equal "" account)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
223 (setq account nil)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
224 ;; This guarantees that an interrupt will clear the account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
225 ;; password.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
226 (efs-set-account host user minidisk account))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
227 (if account ; give the user another chance
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
228 (efs-cms-send-minidisk-acct host user minidisk account)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
229 ((eq (car result) 'fatal)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
230 (if noretry
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
231 ;; give up
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
232 (efs-error host user
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
233 (concat "ACCOUNT password failed: " (nth 1 result)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
234 ;; try once more
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
235 (efs-cms-send-minidisk-acct host user minidisk account t))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
236 ;; return result
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
237 result)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
238
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
239 (efs-defun efs-write-recover cms
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
240 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
241 ;; If a write fails because of insufficient privileges, give the user a
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
242 ;; chance to send an account password.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
243 (let ((cmd0 (car cmd))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
244 (cmd1 (nth 1 cmd))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
245 (cmd2 (nth 2 cmd)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
246 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
247 (if (and (or (memq cmd0 '(append put rename))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
248 (and (eq cmd0 'quote) (eq cmd1 'stor)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
249 (string-match "^/\\([-A-Z0-9$*._+]+\\)/[-A-Z0-9$*._+]+$" cmd2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
250 (let ((minidisk (substring cmd2 (match-beginning 1) (match-end 1)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
251 account retry)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
252 (unwind-protect
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
253 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
254 (setq account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
255 (read-passwd
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
256 (format "Account password for minidisk %s on %s@%s: "
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
257 minidisk user host)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
258 (if (string-equal account "")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
259 (setq account nil)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
260 (efs-set-account host user minidisk account))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
261 (if account
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
262 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
263 (efs-cms-send-minidisk-acct host user minidisk account)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
264 (setq retry
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
265 (efs-send-cmd host user cmd msg pre-cont cont
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
266 nowait noretry))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
267 (and (null (or cont nowait)) retry))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
268 (if cont
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
269 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
270 (efs-call-cont cont 'failed line cont-lines)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
271 nil)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
272 (and (null nowait) (list 'failed line cont-lines)))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
273 (if cont
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
274 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
275 (efs-call-cont cont 'failed line cont-lines)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
276 nil)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
277 (and (null nowait) (list 'failed line cont-lines)))))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
278
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
279 (efs-defun efs-allow-child-lookup cms (host user dir file)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
280 ;; Returns t if FILE in directory DIR could possibly be a subdir
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
281 ;; according to its file-name syntax, and therefore a child listing should
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
282 ;; be attempted.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
283
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
284 ;; CMS file system is flat. Only minidisks are "subdirs".
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
285 (or (string-equal "/" dir)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
286 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
287 (string-match "^/[^/:]+:/$" dir))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
288
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
289 ;;; Sorting listings
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
290
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
291 (defconst efs-cms-date-and-time-regexp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
292 (concat
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
293 " \\(1?[0-9]\\)/\\([0-3][0-9]\\)/\\([0-9][0-9]\\) +"
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
294 "\\([12]?[0-9]\\):\\([0-5][0-9]\\):\\([0-5][0-9]\\) "))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
295
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
296 (efs-defun efs-t-converter cms (&optional regexp reverse)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
297 (if regexp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
298 nil
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
299 (goto-char (point-min))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
300 (efs-save-match-data
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
301 (if (re-search-forward efs-cms-date-and-time-regexp nil t)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
302 (let (list-start list bol nbol)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
303 (beginning-of-line)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
304 (setq list-start (point))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
305 (while (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
306 (setq bol (point))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
307 (re-search-forward efs-cms-date-and-time-regexp
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
308 (setq nbol (save-excursion
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
309 (forward-line 1) (point)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
310 t))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
311 (setq list
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
312 (cons
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
313 (cons
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
314 (list (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
315 (match-beginning 3)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
316 (match-end 3))) ; year
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
317 (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
318 (match-beginning 1)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
319 (match-end 1))) ; month
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
320 (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
321 (match-beginning 2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
322 (match-end 2))) ; day
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
323 (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
324 (match-beginning 4)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
325 (match-end 4))) ; hour
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
326 (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
327 (match-beginning 5)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
328 (match-end 5))) ; minutes
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
329 (string-to-int (buffer-substring
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
330 (match-beginning 6)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
331 (match-end 6)))) ; seconds
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
332 (buffer-substring bol nbol))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
333 list))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
334 (goto-char nbol))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
335 (if list
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
336 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
337 (setq list
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
338 (mapcar 'cdr
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
339 (sort list 'efs-cms-t-converter-sort-pred)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
340 (if reverse (setq list (nreverse list)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
341 (delete-region list-start (point))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
342 (apply 'insert list)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
343 t)))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
344
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
345 (defun efs-cms-t-converter-sort-pred (elt1 elt2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
346 (let* ((data1 (car elt1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
347 (data2 (car elt2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
348 (year1 (car data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
349 (year2 (car data2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
350 (month1 (nth 1 data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
351 (month2 (nth 1 data2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
352 (day1 (nth 2 data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
353 (day2 (nth 2 data2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
354 (hour1 (nth 3 data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
355 (hour2 (nth 3 data2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
356 (minute1 (nth 4 data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
357 (minute2 (nth 4 data2))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
358 (second1 (nth 5 data1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
359 (second2 (nth 5 data2)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
360 (or (> year1 year2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
361 (and (= year1 year2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
362 (or (> month1 month2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
363 (and (= month1 month2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
364 (or (> day1 day2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
365 (and (= day1 day2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
366 (or (> hour1 hour2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
367 (and (= hour1 hour2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
368 (or (> minute1 minute2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
369 (and (= minute1 minute2)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
370 (or (> (nth 5 data1)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
371 (nth 5 data2)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
372 ))))))))))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
373
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
374
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
375 ;;; Tree dired support:
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
376
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
377 (defconst efs-dired-cms-re-exe "^. [-A-Z0-9$_+]+ +EXEC ")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
378
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
379 (or (assq 'cms efs-dired-re-exe-alist)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
380 (setq efs-dired-re-exe-alist
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
381 (cons (cons 'cms efs-dired-cms-re-exe)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
382 efs-dired-re-exe-alist)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
383
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
384 (defconst efs-dired-cms-re-dir "^. [-A-Z0-9$_+]+ +DIR ")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
385
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
386 (or (assq 'cms efs-dired-re-dir-alist)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
387 (setq efs-dired-re-dir-alist
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
388 (cons (cons 'cms efs-dired-cms-re-dir)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
389 efs-dired-re-dir-alist)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
390
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
391 (efs-defun efs-dired-insert-headerline cms (dir)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
392 ;; CMS has no total line, so we insert a blank line for
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
393 ;; aesthetics.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
394 (insert "\n")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
395 (forward-char -1)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
396 (efs-real-dired-insert-headerline dir))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
397
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
398 (efs-defun efs-dired-manual-move-to-filename cms
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
399 (&optional raise-error bol eol)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
400 ;; In dired, move to the first char of filename on this line.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
401 ;; This is the CMS version.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
402 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
403 (let (case-fold-search)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
404 (if bol
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
405 (goto-char bol)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
406 (skip-chars-backward "^\n\r")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
407 (setq bol (point)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
408 (if (re-search-forward efs-cms-file-line-regexp eol t)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
409 (goto-char (match-beginning 0))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
410 (goto-char bol)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
411 (and raise-error (error "No file on this line")))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
412
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
413 (efs-defun efs-dired-manual-move-to-end-of-filename cms
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
414 (&optional no-error bol eol)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
415 ;; Assumes point is at beginning of filename.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
416 ;; So, it should be called only after (dired-move-to-filename t).
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
417 ;; case-fold-search must be nil, at least for VMS.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
418 ;; On failure, signals an error or returns nil.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
419 ;; This is the CMS version.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
420 (let ((opoint (point)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
421 (and selective-display
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
422 (null no-error)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
423 (eq (char-after
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
424 (1- (or bol (save-excursion
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
425 (skip-chars-backward "^\r\n")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
426 (point)))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
427 ?\r)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
428 ;; File is hidden or omitted.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
429 (cond
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
430 ((dired-subdir-hidden-p (dired-current-directory))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
431 (error
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
432 (substitute-command-keys
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
433 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
434 ((error
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
435 (substitute-command-keys
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
436 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
437 )))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
438 (skip-chars-forward "-A-Z0-9$_+")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
439 (or (looking-at " +DIR ")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
440 (progn
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
441 (skip-chars-forward " ")
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
442 (skip-chars-forward "-A-Z0-9$_+")))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
443 (if (or (= opoint (point)) (/= (following-char) ?\ ))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
444 (if no-error
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
445 nil
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
446 (error "No file on this line"))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
447 (point))))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
448
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
449 (efs-defun efs-dired-make-filename-string cms (filename &optional reverse)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
450 (if reverse
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
451 (if (string-match "\\." filename)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
452 ;; Can't count on the number of blanks between the base and the
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
453 ;; extension, so ignore the extension.
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
454 (substring filename 0 (match-beginning 0))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
455 filename)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
456 (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" filename)
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
457 (concat (substring filename 0 (match-end 1))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
458 "."
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
459 (substring filename (match-beginning 2) (match-end 2)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
460 filename)))
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
461
8fc7fe29b841 Import from CVS: tag r19-15b94
cvs
parents:
diff changeset
462 ;;; end of efs-cms.el