|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-hell.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.1 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: Hellsoft FTP server support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
10 ;; Created: Tue May 25 02:31:37 1993 by sandy on ibm550
|
|
|
11 ;; Modified: Sun Nov 27 18:32:27 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-hell)
|
|
|
20 (require 'efs)
|
|
|
21
|
|
|
22 (defconst efs-hell-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
|
25 (substring "$Revision: 1.1 $" 11 -2)))
|
|
|
26
|
|
|
27 ;;;; --------------------------------------------------------------
|
|
|
28 ;;;; Hellsoft FTP server support for efs
|
|
|
29 ;;;; --------------------------------------------------------------
|
|
|
30
|
|
|
31 ;;; The hellsoft FTP server runs on DOS PC's and Macs. The hellsoft
|
|
|
32 ;;; support here probably won't work for Macs. If enough people need it
|
|
|
33 ;;; the Mac support _might_ be fixed.
|
|
|
34
|
|
|
35 ;;; Works for "novell FTP Server for NW 3.11 (v1.8), (c) by HellSoft."
|
|
|
36
|
|
|
37 ;; Hellsoft uses unix path syntax. However, we shouldn't append a "."
|
|
|
38 ;; to directories, because if foobar is a plain file, then
|
|
|
39 ;; dir foobar/ will not give a listing (which is correct), but
|
|
|
40 ;; dir foobar/. will give a one-line listing (which is a little strange).
|
|
|
41
|
|
|
42 (efs-defun efs-fix-dir-path hell (dir-path)
|
|
|
43 dir-path)
|
|
|
44
|
|
|
45 ;; Hellsoft returns PWD output in upper case, whereas dir listings are
|
|
|
46 ;; in lower case. To avoid confusion, downcase pwd output.
|
|
|
47
|
|
|
48 (efs-defun efs-send-pwd hell (host user &optional xpwd)
|
|
|
49 ;; Returns ( DIR . LINE ), where DIR is either the current directory, or
|
|
|
50 ;; nil if this couldn't be found. LINE is the line of output from the
|
|
|
51 ;; FTP server. Since the hellsoft server returns pwd output in uppercase, we
|
|
|
52 ;; downcase it.
|
|
|
53 (let ((result (efs-send-pwd 'unix host user xpwd)))
|
|
|
54 (if (car result)
|
|
|
55 (setcar result (downcase (car result))))
|
|
|
56 result))
|
|
|
57
|
|
|
58 (defconst efs-hell-date-and-time-regexp
|
|
|
59 (concat
|
|
|
60 " \\([0-9]+\\) \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
61 "\\|Nov\\|Dec\\) [0-3][0-9] "
|
|
|
62 "\\([012][0-9]:[0-5][0-9]\\| [12][019][0-9][0-9]\\) "))
|
|
|
63 ;; The end of this regexp corresponds to the start of a filename.
|
|
|
64
|
|
|
65 (defmacro efs-hell-parse-file-line ()
|
|
|
66 ;; Returns ( FILENAME DIR-P SIZE ) from the current line
|
|
|
67 ;; of a hellsoft listing. Assumes that the point is at the beginning
|
|
|
68 ;; of the line.
|
|
|
69 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
70 (dir-p (= (following-char) ?d)))
|
|
|
71 (if (re-search-forward efs-hell-date-and-time-regexp eol t)
|
|
|
72 (list (buffer-substring (point) (progn (end-of-line) (point)))
|
|
|
73 dir-p
|
|
|
74 (string-to-int (buffer-substring (match-beginning 1)
|
|
|
75 (match-end 1))))))))
|
|
|
76
|
|
|
77 (efs-defun efs-parse-listing hell
|
|
|
78 (host user dir path &optional switches)
|
|
|
79 ;; Parse the current buffer which is assumed to be a listing from
|
|
|
80 ;; a Hellsoft FTP server.
|
|
|
81 ;; HOST = remote host name
|
|
|
82 ;; USER = remote user name
|
|
|
83 ;; DIR = remote directory as a full remote path
|
|
|
84 ;; PATH = directory in full efs-path syntax
|
|
|
85 (goto-char (point-min))
|
|
|
86 (efs-save-match-data
|
|
|
87 (if (re-search-forward efs-hell-date-and-time-regexp nil t)
|
|
|
88 (let ((tbl (efs-make-hashtable))
|
|
|
89 file-info)
|
|
|
90 (beginning-of-line)
|
|
|
91 (while (setq file-info (efs-hell-parse-file-line))
|
|
|
92 (efs-put-hash-entry (car file-info) (cdr file-info) tbl)
|
|
|
93 (forward-line 1))
|
|
|
94 (efs-put-hash-entry "." '(t) tbl)
|
|
|
95 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
96 tbl)
|
|
|
97 (if (not (string-match (efs-internal-file-name-nondirectory
|
|
|
98 (efs-internal-directory-file-name dir)) "\\."))
|
|
|
99 ;; It's an empty dir
|
|
|
100 (let ((tbl (efs-make-hashtable)))
|
|
|
101 (efs-put-hash-entry "." '(t) tbl)
|
|
|
102 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
103 tbl)))))
|
|
|
104
|
|
|
105
|
|
|
106 (efs-defun efs-allow-child-lookup hell (host user dir file)
|
|
|
107 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
108 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
109 ;; be attempted.
|
|
|
110 ;; Subdirs in DOS can't have an extension.
|
|
|
111 (not (string-match "\\." file)))
|
|
|
112
|
|
|
113 ;;; Tree Dired
|
|
|
114
|
|
|
115 (defconst efs-dired-hell-re-exe
|
|
|
116 "^[^\n]+\\.exe$")
|
|
|
117
|
|
|
118 (or (assq 'hell efs-dired-re-exe-alist)
|
|
|
119 (setq efs-dired-re-exe-alist
|
|
|
120 (cons (cons 'hell efs-dired-hell-re-exe)
|
|
|
121 efs-dired-re-exe-alist)))
|
|
|
122
|
|
|
123 (defconst efs-dired-hell-re-dir
|
|
|
124 "^. [ \t]*d")
|
|
|
125
|
|
|
126 (or (assq 'hell efs-dired-re-dir-alist)
|
|
|
127 (setq efs-dired-re-dir-alist
|
|
|
128 (cons (cons 'hell efs-dired-hell-re-dir)
|
|
|
129 efs-dired-re-dir-alist)))
|
|
|
130
|
|
|
131 (efs-defun efs-dired-manual-move-to-filename hell
|
|
|
132 (&optional raise-error bol eol)
|
|
|
133 ;; In dired, move to the first char of filename on this line, where
|
|
|
134 ;; line can be delimited by either \r or \n.
|
|
|
135 ;; Returns (point) or nil if raise-error is nil and there is no
|
|
|
136 ;; filename on this line. In the later case, leaves the point at the
|
|
|
137 ;; beginning of the line.
|
|
|
138 ;; This version is for the Hellsoft FTP server.
|
|
|
139 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
|
|
|
140 (let (case-fold-search)
|
|
|
141 (if bol
|
|
|
142 (goto-char bol)
|
|
|
143 (skip-chars-backward "^\n\r"))
|
|
|
144 (if (re-search-forward efs-hell-date-and-time-regexp eol t)
|
|
|
145 (point)
|
|
|
146 (and raise-error (error "No file on this line")))))
|
|
|
147
|
|
|
148 (efs-defun efs-dired-manual-move-to-end-of-filename hell
|
|
|
149 (&optional no-error bol eol)
|
|
|
150 ;; Assumes point is at the beginning of filename.
|
|
|
151 ;; So, it should be called only after (dired-move-to-filename t)
|
|
|
152 ;; On failure signals an error, or returns nil.
|
|
|
153 ;; This is the Hellsoft FTP server version.
|
|
|
154 (let ((opoint (point)))
|
|
|
155 (and selective-display
|
|
|
156 (null no-error)
|
|
|
157 (eq (char-after
|
|
|
158 (1- (or bol (save-excursion
|
|
|
159 (skip-chars-backward "^\r\n")
|
|
|
160 (point)))))
|
|
|
161 ?\r)
|
|
|
162 ;; File is hidden or omitted.
|
|
|
163 (cond
|
|
|
164 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
165 (error
|
|
|
166 (substitute-command-keys
|
|
|
167 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
168 ((error
|
|
|
169 (substitute-command-keys
|
|
|
170 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
171 )))))
|
|
|
172 (skip-chars-forward "-_+=a-zA-Z0-9.$~")
|
|
|
173 (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r))))
|
|
|
174 (if no-error
|
|
|
175 nil
|
|
|
176 (error "No file on this line"))
|
|
|
177 (point))))
|
|
|
178
|
|
|
179 (efs-defun efs-dired-insert-headerline hell (dir)
|
|
|
180 ;; Insert a blank line for aesthetics
|
|
|
181 (insert "\n")
|
|
|
182 (forward-char -1)
|
|
|
183 (efs-real-dired-insert-headerline dir))
|
|
|
184
|
|
|
185 ;;; end of efs-hell.el
|
