Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-pc.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 7e54bd776075 8619ce7e4c50
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-pc.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: PC support for efs
9 ;; Author: Sandy Rutherford <sandy@tsmi19.sissa.it>
10 ;; Created: Thu Mar 18 13:06:25 1993
11 ;; Modified: Sun Nov 27 18:40:46 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 ;;; Thanks to jrs@world.std.com (Rick Sladkey) for providing support for
20 ;;; the Frontier Technologies Super-TCP server
21
22 ;;; Many thanks to the following people for beta testing:
23 ;;; Mike Northam <mbn@hfglobe.intel.com>
24 ;;; bagman@austin.ibm.com (Doug Bagley)
25 ;;; Jens Petersen <J.Petersen@qmw.ac.uk>
26 ;;; Jeff Morgenthaler <jpmorgen@wisp4.physics.wisc.edu>
27
28 (provide 'efs-pc)
29 (require 'efs)
30
31 (defconst efs-pc-version
32 (concat (substring "$efs release: 1.15 $" 14 -2)
33 "/"
34 (substring "$Revision: 1.1 $" 11 -2)))
35
36 ;;;-----------------------------------------------------------------
37 ;;; PC support for efs
38 ;;;-----------------------------------------------------------------
39
40 ;;; Works for the DOS FTP servers:
41 ;;; Novell LAN WorkPlace v4.01 (NetWare & EXOS)
42 ;;; PC/TCP Version 2.05 pl2 FTP Server by FTP Software
43 ;;; Microsoft FTP Server service (beta 2)
44 ;;; NCSA DOS ftp server.
45 ;;; Frontier Technologies super tcp server (runs under MS WINDOWS)
46 ;;; Alun's Windows FTP daemon for Winsock, v1.8b
47 ;;;
48 ;;; Works for IBM OS/2 TCP/IP FTP Version 1.2
49
50 ;;; Currently support for all of the above FTP servers are in this file.
51 ;;; Should they live in separate files?
52
53 ;;; host and listing type hierarchy in this file
54 ;;;
55 ;;; dos: dos:novell, dos:ftp, dos:ncsa, dos:microsoft, dos:stcp, dos:winsock
56 ;;; os2:
57
58 ;;; DOS and OS/2 have slightly different filename syntaxes.
59 ;;;
60 ;;; DOS only allows at most one extension (".") per filename.
61 ;;; A directory name usually has the extension ".DIR" implicit, but
62 ;;; it seems that other extensions can be used.
63 ;;;
64 ;;; OS/2 running the FAT file system uses the same 8.3 format for
65 ;;; filenames as DOS, except that extensions are allowed in directory names.
66 ;;; OS/2 running the HPFS (high performance file system allows an arbitrary
67 ;;; number of extensions in a filename.
68 ;;; Mostly these differences are unimportant here, except in the dos
69 ;;; definition of efs-allow-child-lookup.
70
71 ;;;; ----------------------------------------------------
72 ;;;; Utility functions and macros
73 ;;;; ----------------------------------------------------
74
75 (defun efs-fix-pc-path (path &optional reverse)
76 ;; Convert PATH from UNIX-ish to DOS or OS/2.
77 ;; If REVERSE do just that.
78 (efs-save-match-data
79 (if reverse
80 (let ((n 0)
81 len res)
82 (if (string-match "^[a-zA-Z0-9]:" path)
83 ;; there's a disk
84 (setq res (concat "\\" path))
85 (setq res (copy-sequence path)))
86 (setq len (length res))
87 (while (< n len)
88 (and (= (aref res n) ?\\ ) (aset res n ?/))
89 (setq n (1+ n)))
90 res)
91 (let ((n 0)
92 len res)
93 (if (string-match "^/[a-zA-Z0-9]:" path)
94 (setq res (substring path 1))
95 (setq res (copy-sequence path)))
96 (setq len (length res))
97 (while (< n len)
98 (and (= (aref res n) ?/) (aset res n ?\\ ))
99 (setq n (1+ n)))
100 res))))
101
102 (defmacro efs-dired-pc-move-to-end-of-filename (&optional no-error bol eol)
103 ;; Assumes point is at the beginning of filename.
104 ;; So, it should be called only after (dired-move-to-filename t)
105 ;; On failure signals an error, or returns nil.
106 ;; This is the DOS and OS/2 version. It is common to all of the PC ftp
107 ;; servers since it depends only on the file name character set.
108 (`
109 (let ((opoint (point)))
110 (and selective-display
111 (null (, no-error))
112 (eq (char-after
113 (1- (or (, bol) (save-excursion
114 (skip-chars-backward "^\r\n")
115 (point)))))
116 ?\r)
117 ;; File is hidden or omitted.
118 (cond
119 ((dired-subdir-hidden-p (dired-current-directory))
120 (error
121 (substitute-command-keys
122 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
123 ((error
124 (substitute-command-keys
125 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
126 )))))
127 (skip-chars-forward "-_+=a-zA-Z0-9.$~")
128 (if (= opoint (point))
129 (if (, no-error)
130 nil
131 (error "No file on this line"))
132 (point)))))
133
134 (defun efs-dired-pc-insert-headerline (dir)
135 ;; Insert a blank line for aesthetics.
136 (insert " \n")
137 (forward-char -2)
138 (efs-real-dired-insert-headerline dir))
139
140
141 ;;;;-----------------------------------------------------------
142 ;;;; General DOS support
143 ;;;;-----------------------------------------------------------
144
145 ;;; Regexps to be used for host and listing-type identification.
146
147 (defconst efs-dos:ftp-file-line-regexp
148 (concat
149 " *\\([0-9]+\\|<dir>\\) +\\([-_+=a-zA-Z0-9$~.]+\\)"
150 " +\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\) "
151 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|"
152 "Oct\\|Nov\\|Dec\\) [0-3][0-9] "))
153
154 (defconst efs-dos:microsoft-file-line-regexp
155 ;; matches all the way to the first char of the filename.
156 (concat
157 "[01][0-9]-[0-3][0-9]-[0-9][0-9] +[012][0-9]:[0-5][0-9][AP]M +"
158 "\\(<DIR>\\|[0-9]+\\) +"))
159
160 (defconst efs-dos:ncsa-file-line-regexp
161 "\\([-_+=a-zA-Z0-9$.~]+\\) +\\(<DIR>\\|[0-9]+\\)[ \n]")
162
163 (defconst efs-dos:stcp-file-line-regexp
164 (concat
165 "\\([-_+=a-zA-Z0-9$~.]+\\) +\\(<DIR>\\|[0-9]+\\) "
166 "+[0-9][0-9]?-[0-3][0-9]-[12][90][0-9][0-9] +"
167 "[0-9][0-9]?:[0-5][0-9]"))
168
169 (defconst efs-dos:winsock-date-and-size-regexp
170 (concat
171 " \\([0-9]+\\) "
172 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|"
173 "Dec\\) [ 0-3][0-9] \\( [12][0-9][0-9][0-9]\\|[0-2][0-9]:[0-6][0-9]\\) +"))
174
175 (efs-defun efs-parse-listing dos
176 (host user dir path &optional switches)
177 ;; Examine the listing, which is assumed to be either a DOS or OS/2
178 ;; listing, and determine the operating system type and FTP server.
179 ;; HOST = remote host name
180 ;; USER = remote user name
181 ;; DIR = directory as a full remote path
182 ;; PATH = directory in full efs-path syntax
183 ;; No need to check for OS/2, as it gets ID'ed by a SYST in
184 ;; efs-guess-host-type.
185 (efs-save-match-data
186 (cond
187
188 ;; Check for the Microsoft server
189 ((re-search-forward efs-dos:microsoft-file-line-regexp nil t)
190 (efs-add-listing-type 'dos:microsoft host user)
191 (efs-parse-listing 'dos:microsoft host user dir path switches))
192
193 ;; Check for the Novell FTP server
194 ((save-excursion
195 (goto-char (point-max))
196 (forward-line -1)
197 (looking-at " [0-9]+ File(s)\n"))
198 (efs-add-listing-type 'dos:novell host user)
199 (efs-parse-listing 'dos:novell host user dir path switches))
200
201 ;; Check for FTP software's server
202 ((re-search-forward efs-dos:ftp-file-line-regexp nil t)
203 (efs-add-listing-type 'dos:ftp host user)
204 (efs-parse-listing 'dos:ftp host user dir path switches))
205
206 ;; Check for winsock
207 ((re-search-forward efs-dos:winsock-date-and-size-regexp nil t)
208 (efs-add-listing-type 'dos:winsock host user)
209 (efs-parse-listing 'dos:winsock host user dir path switches))
210
211 ;; Check for the NCSA FTP server
212 ((re-search-forward efs-dos:ncsa-file-line-regexp nil t)
213 (efs-add-listing-type 'dos:ncsa host user)
214 (efs-parse-listing 'dos:ncsa host user dir path switches))
215
216 ;; Check for Frontier's Super-TCP server
217 ((re-search-forward efs-dos:stcp-file-line-regexp nil t)
218 (efs-add-listing-type 'dos:stcp host user)
219 (efs-parse-listing 'dos:stcp host user dir path switches))
220
221 ((string-match "^/\\([A-Za-z0-9]:/\\)?$" dir)
222 ;; root always exists
223 (let ((tbl (efs-make-hashtable)))
224 (efs-put-hash-entry "." '(t) tbl)
225 (efs-put-hash-entry ".." '(t) tbl)
226 tbl))
227 (t
228 ;; an error message?
229 nil))))
230
231 ;; Some DOS servers (NCSA), return a 501 message for an empty disk.
232 (efs-defun efs-ls-dumb-check dos (line host file path lsargs msg noparse
233 noerror nowait cont)
234 (and (string-match "^501 " line)
235 (string-match "^/[A-Za-z0-9]:/?$" path)
236 (let ((parse (or (null noparse) (eq noparse 'parse)
237 (efs-parsable-switches-p lsargs t))))
238 (efs-add-to-ls-cache file lsargs "\n" parse)
239 (if parse
240 (efs-set-files file (let ((tbl (efs-make-hashtable)))
241 (efs-put-hash-entry "." '(t) tbl)
242 (efs-put-hash-entry ".." '(t) tbl)
243 tbl)))
244 (if nowait
245 (progn
246 (if cont
247 (efs-call-cont cont "\n"))
248 t)
249 (if cont
250 (efs-call-cont cont "\n"))
251 "\n"))))
252
253 (efs-defun efs-fix-path dos (path &optional reverse)
254 (efs-fix-pc-path path reverse))
255
256 (efs-defun efs-fix-dir-path dos (dir-path)
257 ;; Convert path from UNIX-ish to DOS for a DIRectory listing.
258 (cond ((string-match "^/\\(.:\\)?$" dir-path)
259 (error "Can't list DOS or OS/2 disks"))
260 ;; Neither DOS nor OS/2 allows us to end the name of a directory
261 ;; with an "\".
262 ;; Adding *.* to the end also allows us to distinguish plain files from
263 ;; directries. All DOS servers seem to understand this except
264 ;; Frontier Technologies' super-tcp server.
265 ((string-match "/$" dir-path)
266 (concat (efs-fix-pc-path dir-path) "*.*"))
267 (t (efs-fix-pc-path dir-path))))
268
269 (efs-defun efs-get-pwd dos (host user &optional xpwd)
270 ;; Parses PWD output for the current working directory. Hopefully this is
271 ;; DOS proof.
272 (let* ((result (efs-send-cmd host user (list 'quote
273 (if xpwd 'xpwd 'pwd))
274 "Getting PWD"))
275 (line (nth 1 result))
276 dir)
277 (if (car result)
278 (efs-save-match-data
279 (and (or (string-match "\"\\([^\"]*\\)\"" line)
280 ;; FTP software's output. They should know better...
281 (string-match "Current working directory is +\\([^ ]+\\)$"
282 line))
283 (setq dir (substring line
284 (match-beginning 1)
285 (match-end 1))))))
286 (cons dir line)))
287
288 (efs-defun efs-allow-child-lookup dos (host user dir file)
289 ;; Returns t if FILE in directory DIR could possibly be a subdir
290 ;; according to its file-name syntax, and therefore a child listing should
291 ;; be attempted.
292
293 ;; Subdirs in DOS usually don't have an extension.
294 (not (string-match "\\." file)))
295
296 ;;;;-----------------------------------
297 ;;;; Support for the Novell FTP server
298 ;;;;-----------------------------------
299
300 (defconst efs-dos:novell-file-line-regexp
301 ;; Matches from the first character of the filename to the end of the date.
302 ;; Does not match parent directories which the server might decide
303 ;; to put in front of the filename.
304 (concat
305 "\\([-_+=a-zA-Z0-9$.~]+\\) +\\(<DIR>\\|[0-9]+\\) +"
306 "[ 0-9][0-9]-[0-9][0-9]-[0-9][0-9] "))
307
308 (efs-defun efs-parse-listing dos:novell
309 (host user dir path &optional switches)
310 ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
311 ;; HOST = remote host name
312 ;; USER = remote user name
313 ;; DIR = directory as a full remote path
314 ;; PATH = directory in full efs-path syntax
315 (let ((tbl (efs-make-hashtable))
316 file size dir-p)
317 (efs-save-match-data
318 ;; Can we check somehow if the listing is really for something
319 ;; that doesn't exist?
320 (goto-char (point-min))
321 (while (re-search-forward efs-dos:novell-file-line-regexp
322 nil t)
323 (setq file (buffer-substring (match-beginning 1)
324 (match-end 1))
325 size (buffer-substring (match-beginning 2)
326 (match-end 2)))
327 (if (string-equal size "<DIR>")
328 (setq size nil
329 dir-p t)
330 (setq size (string-to-int size)
331 dir-p nil))
332 (efs-put-hash-entry file (list dir-p size) tbl)
333 (forward-line 1))
334 (efs-put-hash-entry "." '(t) tbl)
335 (efs-put-hash-entry ".." '(t) tbl)
336 tbl)))
337
338 ;;; Tree Dired Support
339
340 (defconst efs-dired-dos:novell-re-exe
341 "^. [ \t]+[-_+=a-zA-Z0-9$~]+\\.exe ")
342
343 (or (assq 'dos:novell efs-dired-re-exe-alist)
344 (setq efs-dired-re-exe-alist
345 (cons (cons 'dos:novell efs-dired-dos:novell-re-exe)
346 efs-dired-re-exe-alist)))
347
348 (defconst efs-dired-dos:novell-re-dir
349 "^. [ \t]+[-_+=a-zA-Z0-9$~]+ +<DIR>")
350
351 (or (assq 'dos:novell efs-dired-re-dir-alist)
352 (setq efs-dired-re-dir-alist
353 (cons (cons 'dos:novell efs-dired-dos:novell-re-dir)
354 efs-dired-re-dir-alist)))
355
356 (efs-defun efs-dired-insert-headerline dos:novell (dir)
357 (efs-dired-pc-insert-headerline dir))
358
359 (efs-defun efs-dired-manual-move-to-filename dos:novell
360 (&optional raise-error bol eol)
361 ;; In dired, move to the first char of filename on this line.
362 ;; Returns (point) or nil if raise-error is nil, and there is no
363 ;; no filename on this line.
364 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
365 (let (case-fold-search)
366 (if bol
367 (goto-char bol)
368 (skip-chars-backward "^\n\r"))
369 ;; move over marker
370 (if (re-search-forward efs-dos:novell-file-line-regexp eol t)
371 (goto-char (match-beginning 0)) ; returns (point)
372 (and raise-error (error "No file on this line")))))
373
374 (efs-defun efs-dired-manual-move-to-end-of-filename dos:novell
375 (&optional no-error bol eol)
376 ;; Assumes point is at the beginning of filename.
377 ;; So, it should be called only after (dired-move-to-filename t)
378 ;; On failure signals an error, or returns nil.
379 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
380
381 (efs-defun efs-dired-fixup-listing dos:novell
382 (file path &optional switches wildcard)
383 ;; DOS may insert the entire directory name in front of the file name.
384 ;; Scrape it off. The Novell server seems to do weird things when insert
385 ;; the full-path, so be liberal with the hatchet.
386 (goto-char (point-min))
387 (while (re-search-forward efs-dos:novell-file-line-regexp nil t)
388 (beginning-of-line)
389 (delete-region (point) (match-beginning 0))
390 (forward-line 1))
391 ;; the novell server outputs lines in seemingly random order
392 ;; this isn't as good as sorting switches, but at least it's not random.
393 (sort-fields 1 (point-min) (progn (goto-char (point-max))
394 (forward-line -1)
395 (point))))
396
397 (efs-defun efs-dired-ls-trim dos:novell ()
398 (goto-char (point-min))
399 (let (case-fold-search)
400 (forward-line 1)
401 (if (looking-at " [0-9]+ File(s)\n")
402 (delete-region (match-beginning 0) (match-end 0)))))
403
404
405 ;;;;-----------------------------------------------
406 ;;;; PC/TCP (by FTP software) support
407 ;;;;-----------------------------------------------
408
409 (efs-defun efs-parse-listing dos:ftp
410 (host user dir path &optional switches)
411 ;; Parse the current buffer which is assumed to be an FTP Software DOS
412 ;; listing.
413 ;; HOST = remote host name
414 ;; USER = remote user name
415 ;; DIR = directory as a full remote path
416 ;; PATH = directory in full efs-path syntax
417 (let ((tbl (efs-make-hashtable))
418 file size dir-p)
419 (efs-save-match-data
420 ;; Can we check somehow if an empty directory is really
421 ;; a nonexistent directory?
422 (goto-char (point-min))
423 (goto-char (point-min))
424 (while (looking-at efs-dos:ftp-file-line-regexp)
425 (setq file (buffer-substring (match-beginning 2)
426 (match-end 2))
427 size (buffer-substring (match-beginning 1)
428 (match-end 1)))
429 (if (string-equal size "<dir>")
430 (setq size nil
431 dir-p t)
432 (setq size (string-to-int size)
433 dir-p nil))
434 (efs-put-hash-entry file (list dir-p size) tbl)
435 (forward-line 1))
436 (efs-put-hash-entry "." '(t) tbl)
437 (efs-put-hash-entry ".." '(t) tbl)
438 tbl)))
439
440 ;;; Tree Dired Support
441
442 (defconst efs-dired-dos:ftp-re-exe
443 "^. [ \t]*[0-9]+ +[-_+=a-zA-Z0-9$~]+\\.exe ")
444
445 (or (assq 'dos:ftp efs-dired-re-exe-alist)
446 (setq efs-dired-re-exe-alist
447 (cons (cons 'dos:ftp efs-dired-dos:ftp-re-exe)
448 efs-dired-re-exe-alist)))
449
450 (defconst efs-dired-dos:ftp-re-dir
451 "^. [ \t]*<dir> ")
452
453 (or (assq 'dos:ftp efs-dired-re-dir-alist)
454 (setq efs-dired-re-dir-alist
455 (cons (cons 'dos:ftp efs-dired-dos:ftp-re-dir)
456 efs-dired-re-dir-alist)))
457
458 (efs-defun efs-dired-insert-headerline dos:ftp (dir)
459 (efs-dired-pc-insert-headerline dir))
460
461 ;;; Because dos:ftp listings have the file names right justified,
462 ;;; I have reversed what -move-to-filename and -move-to-end-of-filename
463 ;;; actually do. This shouldn't confuse dired, and should make browsing
464 ;;; a dos:ftp listing more aesthetically pleasing.
465
466 (efs-defun efs-dired-manual-move-to-filename dos:ftp
467 (&optional raise-error bol eol)
468 ;; In dired, move to the *last* char of filename on this line.
469 ;; Returns (point) or nil if raise-error is nil, and there is no
470 ;; no filename on this line.
471 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
472 (let (case-fold-search)
473 (if bol
474 (goto-char bol)
475 (skip-chars-backward "^\n\r"))
476 (if (re-search-forward efs-dos:ftp-file-line-regexp eol t)
477 (goto-char (match-end 2)) ; returns (point)
478 (and raise-error (error "No file on this line")))))
479
480 (efs-defun efs-dired-manual-move-to-end-of-filename dos:ftp
481 (&optional no-error bol eol)
482 ;; Assumes point is at the *end* of filename. Really moves the
483 ;; point to the beginning of the filename.
484 ;; So, it should be called only after (dired-move-to-filename t)
485 ;; On failure signals an error, or returns nil.
486 ;; This is the DOS version. It is common to all of the DOS ftp servers
487 ;; since it depends only on the file name character set.
488 (let ((opoint (point)))
489 (and selective-display
490 (null no-error)
491 (eq (char-after
492 (1- (or bol (save-excursion
493 (skip-chars-backward "^\r\n")
494 (point)))))
495 ?\r)
496 ;; File is hidden or omitted.
497 (cond
498 ((dired-subdir-hidden-p (dired-current-directory))
499 (error
500 (substitute-command-keys
501 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
502 ((error
503 (substitute-command-keys
504 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
505 )))))
506 (skip-chars-backward "-_+=a-zA-Z0-9.$~" bol)
507 (if (= opoint (point))
508 (if no-error
509 nil
510 (error "No file on this line"))
511 (point))))
512
513 ;;;;-----------------------------------------------
514 ;;;; NCSA FTP support
515 ;;;;-----------------------------------------------
516
517 (efs-defun efs-parse-listing dos:ncsa
518 (host user dir path &optional switches)
519 ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
520 ;; HOST = remote host name
521 ;; USER = remote user name
522 ;; DIR = directory as a full remote path
523 ;; PATH = directory in full efs-path syntax
524 (let (tbl file size dir-p next)
525 (efs-save-match-data
526 (goto-char (point-min))
527 (while (re-search-forward
528 efs-dos:ncsa-file-line-regexp
529 (setq next (save-excursion (forward-line 1) (point))) t)
530 (setq file (buffer-substring (match-beginning 1)
531 (match-end 1))
532 size (buffer-substring (match-beginning 2)
533 (match-end 2)))
534 (if (string-equal size "<DIR>")
535 (setq size nil
536 dir-p t)
537 (setq size (string-to-int size)
538 dir-p nil))
539 (efs-put-hash-entry file (list dir-p size)
540 (or tbl (setq tbl (efs-make-hashtable))))
541 (goto-char next))
542 ;; DOS does not put . and .. in the root directory.
543 (if (or tbl
544 ;; root always exists
545 (string-match "^/\\([A-Za-z0-9]:/\\)?$" dir))
546 (progn
547 (efs-put-hash-entry "." '(t) tbl)
548 (efs-put-hash-entry ".." '(t) tbl)))
549 tbl)))
550
551 ;;; Tree Dired Support
552
553 (defconst efs-dired-dos:ncsa-re-exe
554 "^. [ \t]+[-_+=a-zA-Z0-9$~]+\\.exe ")
555
556 (or (assq 'dos:ncsa efs-dired-re-exe-alist)
557 (setq efs-dired-re-exe-alist
558 (cons (cons 'dos:ncsa efs-dired-dos:ncsa-re-exe)
559 efs-dired-re-exe-alist)))
560
561 (defconst efs-dired-dos:ncsa-re-dir
562 "^. [ \t]+[-_+=a-zA-Z0-9$~]+ +<DIR>")
563
564 (or (assq 'dos:ncsa efs-dired-re-dir-alist)
565 (setq efs-dired-re-dir-alist
566 (cons (cons 'dos:ncsa efs-dired-dos:ncsa-re-dir)
567 efs-dired-re-dir-alist)))
568
569 (efs-defun efs-dired-insert-headerline dos:ncsa (dir)
570 (efs-dired-pc-insert-headerline dir))
571
572 (efs-defun efs-dired-manual-move-to-filename dos:ncsa
573 (&optional raise-error bol eol)
574 ;; In dired, move to the first char of filename on this line.
575 ;; Returns (point) or nil if raise-error is nil, and there is no
576 ;; no filename on this line.
577 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
578 (let (case-fold-search)
579 (if bol
580 (goto-char bol)
581 (skip-chars-backward "^\n\r"))
582 (if (re-search-forward "[-_+=a-zA-Z0-9$.~]+ +\\(<DIR>\\|[0-9]\\)" eol t)
583 (goto-char (match-beginning 0)) ; returns (point)
584 (and raise-error (error "No file on this line")))))
585
586 (efs-defun efs-dired-manual-move-to-end-of-filename dos:ncsa
587 (&optional no-error bol eol)
588 ;; Assumes point is at the beginning of filename.
589 ;; So, it should be called only after (dired-move-to-filename t)
590 ;; On failure signals an error, or returns nil.
591 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
592
593 (efs-defun efs-dired-fixup-listing dos:ncsa
594 (file path &optional switches wildcard)
595 ;; DOS may insert the entire directory name in front of the file name.
596 ;; Scrape it off.
597 (let (bonl)
598 (goto-char (point-min))
599 (while (re-search-forward
600 efs-dos:ncsa-file-line-regexp
601 (setq bonl (save-excursion (forward-line 1) (point))) t)
602 (goto-char (match-beginning 0))
603 (delete-region (point) (progn (beginning-of-line) (point)))
604 (goto-char bonl)))
605 ;; sort the buffer
606 (sort-fields 1 (point-min) (point-max)))
607
608 (efs-defun efs-dired-ls-trim dos:ncsa ()
609 (goto-char (point-min))
610 (if (re-search-forward efs-dos:ncsa-file-line-regexp nil t)
611 (delete-region (point-min) (match-beginning 0))))
612
613 ;;;;-----------------------------------------------
614 ;;;; Microsoft DOS FTP support
615 ;;;;-----------------------------------------------
616
617 (defconst efs-dos:microsoft-valid-listing-regexp
618 (concat efs-dos:microsoft-file-line-regexp "\\."))
619
620 (efs-defun efs-parse-listing dos:microsoft
621 (host user dir path &optional switches)
622 ;; Parse the current buffer which is assumed to be a Novell DOS FTP listing.
623 ;; HOST = remote host name
624 ;; USER = remote user name
625 ;; DIR = directory as a full remote path
626 ;; PATH = directory in full efs-path syntax
627
628 ;; Use the existence of a "." file as confirmation that it's really
629 ;; a directory listing.
630 (goto-char (point-min))
631 (efs-save-match-data
632 (if (or (string-match "^/.:/$" dir)
633 (re-search-forward efs-dos:microsoft-valid-listing-regexp nil t))
634 (let ((tbl (efs-make-hashtable))
635 size dir-p)
636 (goto-char (point-min))
637 (while (re-search-forward efs-dos:microsoft-file-line-regexp nil t)
638 (setq size (buffer-substring (match-beginning 1) (match-end 1)))
639 (if (string-equal size "<DIR>")
640 (setq size nil
641 dir-p t)
642 (setq size (string-to-int size)
643 dir-p nil))
644 (efs-put-hash-entry (buffer-substring (point)
645 (progn (end-of-line)
646 (point)))
647 (list dir-p size) tbl)
648 (forward-line 1))
649 (efs-put-hash-entry "." '(t) tbl)
650 (efs-put-hash-entry ".." '(t) tbl)
651 tbl))))
652
653 ;;; Tree Dired Support
654
655 (defconst efs-dired-dos:microsoft-re-exe
656 "^[^\n]+ +[-_+=a-zA-Z0-9$~]+\\.\\(EXE\\|exe\\)$")
657
658 (or (assq 'dos:microsoft efs-dired-re-exe-alist)
659 (setq efs-dired-re-exe-alist
660 (cons (cons 'dos:microsoft efs-dired-dos:microsoft-re-exe)
661 efs-dired-re-exe-alist)))
662
663 (defconst efs-dired-dos:microsoft-re-dir
664 "^[^\n]+ <DIR> ")
665
666 (or (assq 'dos:microsoft efs-dired-re-dir-alist)
667 (setq efs-dired-re-dir-alist
668 (cons (cons 'dos:microsoft efs-dired-dos:microsoft-re-dir)
669 efs-dired-re-dir-alist)))
670
671 (efs-defun efs-dired-insert-headerline dos:microsoft (dir)
672 (efs-dired-pc-insert-headerline dir))
673
674 (efs-defun efs-dired-manual-move-to-filename dos:microsoft
675 (&optional raise-error bol eol)
676 ;; In dired, move to the first char of filename on this line.
677 ;; Returns (point) or nil if raise-error is nil, and there is no
678 ;; no filename on this line.
679 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
680 (let (case-fold-search)
681 (if bol
682 (goto-char bol)
683 (skip-chars-backward "^\n\r"))
684 (if (re-search-forward efs-dos:microsoft-file-line-regexp eol t)
685 (goto-char (match-end 0)) ; returns (point)
686 (and raise-error (error "No file on this line")))))
687
688 (efs-defun efs-dired-manual-move-to-end-of-filename dos:microsoft
689 (&optional no-error bol eol)
690 ;; Assumes point is at the beginning of filename.
691 ;; So, it should be called only after (dired-move-to-filename t)
692 ;; On failure signals an error, or returns nil.
693 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
694
695 ;;;;-----------------------------------------------
696 ;;;; Frontier's Super-TCP FTP Server for Windows
697 ;;;;-----------------------------------------------
698
699 (efs-defun efs-parse-listing dos:stcp
700 (host user dir path &optional switches)
701 ;; Parse the current buffer which is assumed to be a Super-TCP FTP listing.
702 ;; HOST = remote host name
703 ;; USER = remote user name
704 ;; DIR = directory as a full remote path
705 ;; PATH = directory in full efs-path syntax
706
707 ;; Use the existence of a strict file line pattern as
708 ;; confirmation that it's really a directory listing.
709 (goto-char (point-min))
710 (efs-save-match-data
711 (let ((regexp (concat "^" efs-dos:stcp-file-line-regexp)))
712 (if (let ((eol (save-excursion (end-of-line) (point))))
713 (re-search-forward regexp eol t))
714 (let ((tbl (efs-make-hashtable))
715 size dir-p)
716 (goto-char (point-min))
717 (while (re-search-forward regexp nil t)
718 (setq size (buffer-substring (match-beginning 2) (match-end 2)))
719 (if (string-equal size "<DIR>")
720 (setq size nil
721 dir-p t)
722 (setq size (string-to-int size)
723 dir-p nil))
724 (efs-put-hash-entry (buffer-substring (match-beginning 1)
725 (match-end 1))
726 (list dir-p size) tbl)
727 (forward-line 1))
728 (efs-put-hash-entry "." '(t) tbl)
729 (efs-put-hash-entry ".." '(t) tbl)
730 tbl)))))
731
732 ;;; Tree Dired Support
733
734 (defconst efs-dired-dos:stcp-re-exe
735 "^[-_+=a-zA-Z0-9$~]+\\.\\(EXE\\|exe\\) ")
736
737 (or (assq 'dos:stcp efs-dired-re-exe-alist)
738 (setq efs-dired-re-exe-alist
739 (cons (cons 'dos:stcp efs-dired-dos:stcp-re-exe)
740 efs-dired-re-exe-alist)))
741
742 (defconst efs-dired-dos:stcp-re-dir
743 "^[^\n ]+ +<DIR> ")
744
745 (or (assq 'dos:stcp efs-dired-re-dir-alist)
746 (setq efs-dired-re-dir-alist
747 (cons (cons 'dos:stcp efs-dired-dos:stcp-re-dir)
748 efs-dired-re-dir-alist)))
749
750 (efs-defun efs-dired-insert-headerline dos:stcp (dir)
751 (efs-dired-pc-insert-headerline dir))
752
753 (efs-defun efs-dired-manual-move-to-filename dos:stcp
754 (&optional raise-error bol eol)
755 ;; In dired, move to the first char of filename on this line.
756 ;; Returns (point) or nil if raise-error is nil, and there is no
757 ;; no filename on this line.
758 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
759 (let (case-fold-search)
760 (if bol
761 (goto-char bol)
762 (skip-chars-backward "^\n\r")
763 (setq bol (point)))
764 (if (re-search-forward efs-dos:stcp-file-line-regexp eol t)
765 (goto-char (match-beginning 0)) ; returns (point)
766 (if raise-error
767 (error "No file on this line")
768 (goto-char bol)))))
769
770 (efs-defun efs-dired-manual-move-to-end-of-filename dos:stcp
771 (&optional no-error bol eol)
772 ;; Assumes point is at the beginning of filename.
773 ;; So, it should be called only after (dired-move-to-filename t)
774 ;; On failure signals an error, or returns nil.
775 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
776
777 (efs-defun efs-dired-fixup-listing dos:stcp
778 (file path &optional switches wildcard)
779 ;; The Super-TCP server outputs lines in seemingly random order.
780 ;; This isn't as good as sorting switches, but at least it's not random.
781 (sort-fields 1 (point-min) (point-max)))
782
783 ;;;;----------------------------------------------------------
784 ;;;; Winsock DOS FTP server (Alun's FTP server)
785 ;;;;----------------------------------------------------------
786
787 (efs-defun efs-parse-listing dos:winsock
788 (host user dir path &optional switches)
789 ;; Parse the current buffer which is assumed to be a DOS Winsock listing.
790 ;; HOST = remote host name
791 ;; USER = remote user name
792 ;; DIR = directory as a full remote path
793 ;; PATH = directory in full efs-path syntax
794
795 (goto-char (point-min))
796 (efs-save-match-data
797 (if (re-search-forward efs-dos:winsock-date-and-size-regexp nil t)
798 (let ((tbl (efs-make-hashtable))
799 size dirp)
800 (while
801 (progn
802 (setq size (string-to-int (buffer-substring (match-beginning 1)
803 (match-end 1)))
804 dirp (save-excursion
805 (beginning-of-line)
806 (skip-chars-forward " ")
807 (char-equal (following-char) ?d)))
808 (efs-put-hash-entry
809 (buffer-substring (point) (progn (end-of-line) (point)))
810 (list dirp size) tbl)
811 (re-search-forward efs-dos:winsock-date-and-size-regexp nil t)))
812 (efs-put-hash-entry "." '(t) tbl)
813 (efs-put-hash-entry ".." '(t) tbl)
814 tbl))))
815
816 (defconst efs-dired-dos:winsock-re-exe "\\.exe$")
817
818 (or (assq 'dos:winsock efs-dired-re-exe-alist)
819 (setq efs-dired-re-exe-alist
820 (cons (cons 'dos:winsock efs-dired-dos:winsock-re-exe)
821 efs-dired-re-exe-alist)))
822
823 (defconst efs-dired-dos:winsock-re-dir "^. +d")
824
825 (or (assq 'dos:winsock efs-dired-re-dir-alist)
826 (setq efs-dired-re-dir-alist
827 (cons (cons 'dos:winsock efs-dired-dos:winsock-re-dir)
828 efs-dired-re-dir-alist)))
829
830 (efs-defun efs-dired-insert-headerline dos:winsock (dir)
831 (efs-dired-pc-insert-headerline dir))
832
833 (efs-defun efs-dired-manual-move-to-filename dos:winsock
834 (&optional raise-error bol eol)
835 ;; In dired, move to the first char of filename on this line.
836 ;; Returns (point) or nil if raise-error is nil, and there is no
837 ;; no filename on this line.
838 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
839 (let (case-fold-search)
840 (if bol
841 (goto-char bol)
842 (skip-chars-backward "^\n\r")
843 (setq bol (point)))
844 (if (re-search-forward efs-dos:winsock-date-and-size-regexp eol t)
845 (point)
846 (if raise-error
847 (error "No file on this line")
848 (goto-char bol)))))
849
850 (efs-defun efs-dired-manual-move-to-end-of-filename dos:winsock
851 (&optional no-error bol eol)
852 ;; Assumes point is at the beginning of filename.
853 ;; So, it should be called only after (dired-move-to-filename t)
854 ;; On failure signals an error, or returns nil.
855 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
856
857 (efs-defun efs-dired-fixup-listing dos:winsock
858 (file path &optional switches wildcard)
859 ;; The Winsock server outputs lines in seemingly random order.
860 ;; This isn't as good as sorting switches, but at least it's not random.
861 (sort-fields 9 (point-min) (point-max)))
862
863 ;;;;-----------------------------------------------------------
864 ;;;; OS/2 Support
865 ;;;;-----------------------------------------------------------
866
867 ;;; OS/2 has two types of file systems, FAT and HPFS. In the FAT file system
868 ;;; filenames are restricted to the traditional DOS 8 + 3 syntax. In the
869 ;;; HPFS file system, filenames can have arbitrarily many extensions (.'s).
870 ;;; As well, file lines for "." and ".." are listed for HPFS.
871 ;;; For the FAT FS, "." and ".." lines are only listed for sudirs, it seems.
872 ;;; Go figure...
873
874 (defconst efs-os2-file-line-regexp
875 (concat
876 " +\\([0-9]+\\) +\\([^ ]+\\)? +[01][0-9]-[0-3][0-9]-[0-9][0-9] +"
877 "[0-2][0-9]:[0-6][0-9] +"))
878
879 (efs-defun efs-fix-path os2 (path &optional reverse)
880 (efs-fix-pc-path path reverse))
881
882 (efs-defun efs-fix-dir-path os2 (dir-path)
883 ;; Convert path from UNIX-ish to DOS for a DIRectory listing.
884 (cond ((string-match "^/\\(.:\\)?$" dir-path)
885 (error "Can't list DOS or OS/2 disks"))
886 ;; Neither DOS nor OS/2 allows us to end the name of a directory
887 ;; with an "\".
888 ;; Can't just hack it off, because if the dir is C:, we'll get the
889 ;; default dir.
890 ;; Don't apend the filename wildcard to distinguish
891 ;; plain files from directories, because OS/2 and DOS may
892 ;; not agree on what the wildcard is. Also, can't then tell
893 ;; the difference between plain files and empty directories.
894 ((string-match "/$" dir-path)
895 (concat (efs-fix-pc-path dir-path) "."))
896 (t (efs-fix-pc-path dir-path))))
897
898 (defconst efs-os2-dot-line-regexp
899 (concat efs-os2-file-line-regexp "\\.\n"))
900
901 (efs-defun efs-parse-listing os2
902 (host user dir path &optional switches)
903 ;; Parse the current buffer which is assumed to be an OS/2 listing.
904 ;; To make sure that it is really a directory listing and not a bogus
905 ;; listing of a single file, make sure that there is an entry for ".".
906 ;; HOST = remote host name
907 ;; USER = remote user name
908 ;; DIR = directory as a full remote path
909 ;; PATH = directory in full efs-path syntax
910 (efs-save-match-data
911 (if (or
912 (string-match "^/.:/$" dir) ; FAT proofing
913 (progn
914 (goto-char (point-min))
915 (re-search-forward efs-os2-dot-line-regexp nil t)))
916 (let ((tbl (efs-make-hashtable)))
917 (goto-char (point-min))
918 (efs-put-hash-entry "." '(t) tbl)
919 (efs-put-hash-entry ".." '(t) tbl)
920 (while (looking-at efs-os2-file-line-regexp)
921 (end-of-line)
922 (efs-put-hash-entry
923 (buffer-substring (match-end 0) (point))
924 (list (and
925 (match-beginning 2)
926 (string-equal "DIR"
927 (buffer-substring (match-beginning 2)
928 (match-end 2))))
929 (string-to-int (buffer-substring (match-beginning 1)
930 (match-end 1))))
931 tbl)
932 (forward-line 1))
933 tbl))))
934
935 ;;; Tree Dired
936
937 (defconst efs-dired-os2-re-exe
938 "^[^\n]+\\.EXEC?$")
939
940 (or (assq 'os2 efs-dired-re-exe-alist)
941 (setq efs-dired-re-exe-alist
942 (cons (cons 'os2 efs-dired-os2-re-exe)
943 efs-dired-re-exe-alist)))
944
945 (defconst efs-dired-os2-re-dir
946 "^ +[0-9]+ +DIR ")
947
948 (or (assq 'os2 efs-dired-re-dir-alist)
949 (setq efs-dired-re-dir-alist
950 (cons (cons 'os2 efs-dired-os2-re-dir)
951 efs-dired-re-dir-alist)))
952
953 (efs-defun efs-dired-manual-move-to-filename os2
954 (&optional raise-error bol eol)
955 ;; In dired, move to the first char of filename on this line.
956 ;; Returns (point) or nil if raise-error is nil, and there is no
957 ;; no filename on this line.
958 ;; This version is for OS/2
959 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
960 (let (case-fold-search)
961 (if bol
962 (goto-char bol)
963 (skip-chars-backward "^\n\r")
964 (setq bol (point)))
965 (if (and
966 (> (- eol bol) 24)
967 (progn
968 (forward-char 2)
969 (looking-at efs-os2-file-line-regexp)))
970 (goto-char (match-end 0))
971 (and raise-error (error "No file on this line")))))
972
973 (efs-defun efs-dired-manual-move-to-end-of-filename os2
974 (&optional no-error bol eol)
975 (efs-dired-pc-move-to-end-of-filename no-error bol eol))
976
977 (efs-defun efs-dired-insert-headerline os2 (dir)
978 (efs-dired-pc-insert-headerline dir))
979
980 ;; end of efs-pc.el