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