Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-dos-distinct.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 8b8b7f3559a2
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-dos-distinct.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: Distinct's DOS FTP server support for efs
9 ;; Author: Sandy Rutherford <sandy@tsmi19.sissa.it>
10 ;; Created: Fri Jan 15 22:20:32 1993 by sandy on ibm550
11 ;; Modified: Sun Nov 27 18:30:04 1994 by sandy on gandalf
12 ;;
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14
15 ;;; This file is part of efs. See efs.el for copyright
16 ;;; (it's copylefted) and warrranty (there isn't one) information.
17
18 ;;; Thanks to Rodd Zurcher <rbz@hook.corp.mot.com> for beta testing.
19
20 (provide 'efs-dos-distinct)
21 (require 'efs)
22
23 (defconst efs-dos-distinct-version
24 (concat (substring "$efs release: 1.15 $" 14 -2)
25 "/"
26 (substring "$Revision: 1.1 $" 11 -2)))
27
28 ;;;; -----------------------------------------------------------------
29 ;;;; Distinct's DOS FTP server support for efs
30 ;;;; -----------------------------------------------------------------
31
32 ;;; This is not included in efs-dos.el with the support for the
33 ;;; other dos ftp servers, because the Distinct server uses unix syntax
34 ;;; for path names.
35
36 ;; This is defined in efs.el, but we put it here too.
37
38 (defconst efs-dos-distinct-date-and-time-regexp
39 (concat
40 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
41 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
42 "[ 12][0-9]:[0-5][0-9] "))
43
44 ;;; entry point
45
46 (efs-defun efs-parse-listing dos-distinct
47 (host user dir path &optional switches)
48 ;; Parse the current buffer which is assumed to be a listing from
49 ;; Distinct's DOS FTP server. Both empty dirs, and ls errors return
50 ;; empty buffers.
51 ;; HOST = remote host name
52 ;; USER = remote user name
53 ;; DIR = remote directory as a full remote path
54 ;; PATH = directory in full efs-path syntax
55 (goto-char (point-min))
56 (efs-save-match-data
57 (if (re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
58 (let ((tbl (efs-make-hashtable))
59 dir-p)
60 (beginning-of-line)
61 (while (progn
62 (setq dir-p (eq (following-char) ?d)) ; we're bolp
63 (re-search-forward
64 efs-dos-distinct-date-and-time-regexp nil t))
65 (efs-put-hash-entry (buffer-substring (point)
66 (progn (end-of-line)
67 (point)))
68 (list dir-p) tbl)
69 (forward-line 1))
70 (efs-put-hash-entry "." '(t) tbl)
71 (efs-put-hash-entry ".." '(t) tbl)
72 tbl))))
73
74 (efs-defun efs-allow-child-lookup dos-distinct (host user dir file)
75 ;; Returns t if FILE in directory DIR could possibly be a subdir
76 ;; according to its file-name syntax, and therefore a child listing should
77 ;; be attempted.
78 ;; Subdirs in DOS can't have an extension.
79 (not (string-match "\\." file)))
80
81 ;;; Tree Dired
82
83 (defconst efs-dired-dos-distinct-re-exe
84 "^[^\n]+\\.exe$")
85
86 (or (assq 'dos-distinct efs-dired-re-exe-alist)
87 (setq efs-dired-re-exe-alist
88 (cons (cons 'dos-distinct efs-dired-dos-distinct-re-exe)
89 efs-dired-re-exe-alist)))
90
91 (defconst efs-dired-dos-distinct-re-dir
92 "^. [ \t]*d")
93
94 (or (assq 'dos-distinct efs-dired-re-dir-alist)
95 (setq efs-dired-re-dir-alist
96 (cons (cons 'dos-distinct efs-dired-dos-distinct-re-dir)
97 efs-dired-re-dir-alist)))
98
99 (efs-defun efs-dired-insert-headerline dos-distinct (dir)
100 ;; The Distinct DOS server has no total line, so we insert a
101 ;; blank line for aesthetics.
102 (insert "\n")
103 (forward-char -1)
104 (efs-real-dired-insert-headerline dir))
105
106 (efs-defun efs-dired-manual-move-to-filename dos-distinct
107 (&optional raise-error bol eol)
108 ;; In dired, move to the first char of filename on this line.
109 ;; Returns (point) or nil if raise-error is nil, and there is no
110 ;; no filename on this line.
111 ;; This version is for Distinct's DOS FTP server.
112 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
113 (let (case-fold-search)
114 (if bol
115 (goto-char bol)
116 (skip-chars-backward "^\n\r"))
117 (if (re-search-forward efs-dos-distinct-date-and-time-regexp eol t)
118 (point)
119 (and raise-error (error "No file on this line")))))
120
121 (efs-defun efs-dired-manual-move-to-end-of-filename dos-distinct
122 (&optional no-error bol eol)
123 ;; Assumes point is at the beginning of filename.
124 ;; So, it should be called only after (dired-move-to-filename t)
125 ;; On failure signals an error, or returns nil.
126 ;; This is the version for Distinct's DOS FTP server.
127 (let ((opoint (point)))
128 (and selective-display
129 (null no-error)
130 (eq (char-after
131 (1- (or bol (save-excursion
132 (skip-chars-backward "^\r\n")
133 (point)))))
134 ?\r)
135 ;; it's hidden or omitted
136 (cond
137 ((dired-subdir-hidden-p (dired-current-directory))
138 (error
139 (substitute-command-keys
140 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
141 ((error
142 (substitute-command-keys
143 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
144 )))))
145 (skip-chars-forward "-_+=a-z0-9.$")
146 (if (or (= opoint (point)) (not (memq (following-char) '(\n \r))))
147 (if no-error
148 nil
149 (error "No file on this line"))
150 (point))))
151
152 ;;; end of efs-dos-distinct.el