|
22
|
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
|
