File: efs-dos-distinct.el

package info (click to toggle)
xemacs20 20.4-13
  • links: PTS
  • area: main
  • in suites: slink
  • size: 67,324 kB
  • ctags: 57,643
  • sloc: lisp: 586,197; ansic: 184,662; sh: 4,296; asm: 3,179; makefile: 2,021; perl: 1,059; csh: 96; sed: 22
file content (152 lines) | stat: -rw-r--r-- 5,200 bytes parent folder | download | duplicates (3)
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
;; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File:         efs-dos-distinct.el
;; Release:      $efs release: 1.15 $
;; Version:      #Revision: 1.1 $
;; RCS:          
;; Description:  Distinct's DOS FTP server support for efs
;; Author:       Sandy Rutherford <sandy@tsmi19.sissa.it>
;; Created:      Fri Jan 15 22:20:32 1993 by sandy on ibm550
;; Modified:     Sun Nov 27 18:30:04 1994 by sandy on gandalf
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This file is part of efs. See efs.el for copyright
;;; (it's copylefted) and warrranty (there isn't one) information.

;;; Thanks to Rodd Zurcher <rbz@hook.corp.mot.com> for beta testing.

(provide 'efs-dos-distinct)
(require 'efs)

(defconst efs-dos-distinct-version
  (concat (substring "$efs release: 1.15 $" 14 -2)
	  "/"
	  (substring "#Revision: 1.1 $" 11 -2)))

;;;; -----------------------------------------------------------------
;;;; Distinct's DOS FTP server support for efs
;;;; -----------------------------------------------------------------

;;; This is not included in efs-dos.el with the support for the
;;; other dos ftp servers, because the Distinct server uses unix syntax
;;; for path names.

;; This is defined in efs.el, but we put it here too.

(defconst efs-dos-distinct-date-and-time-regexp
  (concat
   " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
   "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9]  "
   "[ 12][0-9]:[0-5][0-9]  "))

;;; entry point

(efs-defun efs-parse-listing dos-distinct
  (host user dir path &optional switches)
  ;; Parse the current buffer which is assumed to be a listing from
  ;; Distinct's DOS FTP server. Both empty dirs, and ls errors return
  ;; empty buffers.
  ;; 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-dos-distinct-date-and-time-regexp nil t)
	(let ((tbl (efs-make-hashtable))
	      dir-p)
	(beginning-of-line)
	(while (progn
		 (setq dir-p (eq (following-char) ?d)) ; we're bolp
		 (re-search-forward
		  efs-dos-distinct-date-and-time-regexp nil t))
	  (efs-put-hash-entry (buffer-substring (point)
						     (progn (end-of-line)
							    (point)))
				   (list dir-p) tbl)
	  (forward-line 1))
	(efs-put-hash-entry "." '(t) tbl)
	(efs-put-hash-entry ".." '(t) tbl)
	tbl))))

(efs-defun efs-allow-child-lookup dos-distinct (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-dos-distinct-re-exe
  "^[^\n]+\\.exe$")

(or (assq 'dos-distinct efs-dired-re-exe-alist)
    (setq efs-dired-re-exe-alist
	  (cons (cons 'dos-distinct  efs-dired-dos-distinct-re-exe)
		efs-dired-re-exe-alist)))

(defconst efs-dired-dos-distinct-re-dir
  "^. [ \t]*d")

(or (assq 'dos-distinct efs-dired-re-dir-alist)
    (setq efs-dired-re-dir-alist
	  (cons (cons 'dos-distinct  efs-dired-dos-distinct-re-dir)
		efs-dired-re-dir-alist)))

(efs-defun efs-dired-insert-headerline dos-distinct (dir)
  ;; The Distinct DOS server has no total line, so we insert a
  ;; blank line for aesthetics.
  (insert "\n")
  (forward-char -1)
  (efs-real-dired-insert-headerline dir))

(efs-defun efs-dired-manual-move-to-filename dos-distinct
  (&optional raise-error bol eol)
  ;; In dired, move to the first char of filename on this line.
  ;; Returns (point) or nil if raise-error is nil, and there is no
  ;; no filename on this line.
  ;; This version is for Distinct's DOS 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-dos-distinct-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 dos-distinct
  (&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 version for Distinct's DOS FTP server.
  (let ((opoint (point)))
    (and selective-display
	 (null no-error)
	 (eq (char-after
	      (1- (or bol (save-excursion
			    (skip-chars-backward "^\r\n")
			    (point)))))
	     ?\r)
	 ;; it's 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-z0-9.$")
    (if (or (= opoint (point)) (not (memq (following-char) '(\n \r))))
	(if no-error
	    nil
	  (error "No file on this line"))
      (point))))

;;; end of efs-dos-distinct.el