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