Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-hell.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 8b8b7f3559a2
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
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