Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-ms-unix.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 8619ce7e4c50
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-ms-unix.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: efs support for the Microsoft PC FTP server in unix mode.
9 ;; Author: Sandy Rutherford <sandy@tsmi19.sissa.it>
10 ;; Created: Thu Aug 19 08:31:15 1993 by sandy on ibm550
11 ;; Modified: Sun Nov 27 18:37:00 1994 by sandy on gandalf
12 ;; Language: Emacs-Lisp
13 ;;
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15
16 (provide 'efs-ms-unix)
17 (require 'efs)
18
19 (defconst efs-ms-unix-version
20 (concat (substring "$efs release: 1.15 $" 14 -2)
21 "/"
22 (substring "$Revision: 1.1 $" 11 -2)))
23
24 (defvar efs-ms-unix-month-and-time-regexp
25 (concat
26 " \\([0-9]+\\) +" ; file size
27 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
28 "\\|Nov\\|Dec\\) [ 0-3][0-9]"
29 " +\\([ 012][0-9]:[0-6][0-9]\\|[12][90][0-9][0-9]\\) +"))
30
31 ;;; entry points
32
33 (efs-defun efs-fix-path ms-unix (path &optional reverse)
34 ;; Convert PATH from UNIX-ish to MS-UNIX.
35 (if reverse
36 (concat "/" path)
37 (substring path 1)))
38
39 (efs-defun efs-fix-dir-path ms-unix (dirpath)
40 ;; Convert a path from UNIX-ish to MS-UNIX for a dir listing
41 (if (string-equal dirpath "/")
42 (error "Cannot grok disk names.")
43 (setq dirpath (substring dirpath 1))
44 (efs-save-match-data
45 (if (string-match "/$" dirpath)
46 (concat dirpath "*")
47 dirpath))))
48
49 (defmacro efs-ms-unix-parse-file-line ()
50 ;; Extract the filename, size, and permission string from the current
51 ;; line of a dired-like listing. Assumes that the point is at
52 ;; the beginning of the line, leaves it just before the size entry.
53 ;; Returns a list (name size perm-string nlinks owner).
54 ;; If there is no file on the line, returns nil.
55 (` (let ((eol (save-excursion (end-of-line) (point)))
56 name size modes nlinks owner)
57 (skip-chars-forward " 0-9" eol)
58 (and
59 (looking-at efs-modes-links-owner-regexp)
60 (setq modes (buffer-substring (match-beginning 1)
61 (match-end 1))
62 nlinks (string-to-int (buffer-substring (match-beginning 2)
63 (match-end 2)))
64 owner (buffer-substring (match-beginning 3) (match-end 3)))
65 (re-search-forward efs-ms-unix-month-and-time-regexp eol t)
66 (setq name (buffer-substring (point) eol)
67 size (string-to-int (buffer-substring (match-beginning 1)
68 (match-end 1))))
69 (list name size modes nlinks owner)))))
70
71 (efs-defun efs-parse-listing ms-unix (host user dir path &optional switches)
72 ;; Parse the current buffer which is assumed to be output from
73 ;; the Microsoft FTP server in unix mode.
74 ;; Return a hashtable as the result. SWITCHES are never used,
75 ;; but they must be specified in the argument list for compatibility
76 ;; with the unix version of this function.
77 ;; HOST = remote host name
78 ;; USER = user name
79 ;; DIR = directory in as a full remote path
80 ;; PATH = directory in full efs path syntax
81 ;; SWITCHES = ls switches
82 (goto-char (point-min))
83 (efs-save-match-data
84 (if (re-search-forward efs-ms-unix-month-and-time-regexp nil t)
85 (let ((tbl (efs-make-hashtable))
86 size modes nlinks dir-p owner file)
87 (beginning-of-line)
88 (while (setq file (efs-ms-unix-parse-file-line))
89 (setq size (nth 1 file)
90 modes (nth 2 file)
91 nlinks (nth 3 file)
92 owner (nth 4 file)
93 file (car file)
94 dir-p (= (string-to-char modes) ?d))
95 (if (and dir-p
96 (string-match "/$" file))
97 (setq file (substring file 0 -1)))
98 (efs-put-hash-entry file (list dir-p size owner modes nlinks) tbl)
99 (forward-line 1))
100 (efs-put-hash-entry "." '(t) tbl)
101 (efs-put-hash-entry ".." '(t) tbl)
102 tbl))))
103
104 ;;; Tree Dired
105
106 ;; ms-unix does not have a total line
107
108 (efs-defun efs-dired-insert-headerline ms-unix (dir)
109 ;; MTS has no total line, so we insert a blank line for
110 ;; aesthetics.
111 (insert "\n")
112 (forward-char -1)
113 (efs-real-dired-insert-headerline dir))
114
115 (efs-defun efs-dired-manual-move-to-filename ms-unix
116 (&optional raise-error bol eol)
117 ;; In dired, move to the first char of filename on this line.
118 ;; Returns (point) or nil if raise-error is nil, and there is no
119 ;; no filename on this line.
120 ;; This version is for ms-unix.
121 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
122 (let (case-fold-search)
123 (if bol
124 (goto-char bol)
125 (skip-chars-backward "^\n\r")
126 (setq bol (point)))
127 (if (re-search-forward efs-ms-unix-month-and-time-regexp eol t)
128 (point)
129 (and raise-error (error "No file on this line")))))
130
131 (efs-defun efs-dired-manual-move-to-end-of-filename ms-unix
132 (&optional no-error bol eol)
133 ;; Assumes point is at the beginning of filename.
134 ;; So, it should be called only after (dired-move-to-filename t)
135 ;; On failure signals an error, or returns nil.
136 ;; This is the ms-unix version.
137 (let ((opoint (point)))
138 (and selective-display
139 (null no-error)
140 (eq (char-after
141 (1- (or bol (save-excursion
142 (skip-chars-backward "^\r\n")
143 (point)))))
144 ?\r)
145 ;; File is hidden or omitted.
146 (cond
147 ((dired-subdir-hidden-p (dired-current-directory))
148 (error
149 (substitute-command-keys
150 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
151 ((error
152 (substitute-command-keys
153 "File line is omitted. Type \\[dired-omit-toggle] to un-omit.")))))
154 (if (eolp)
155 (progn
156 (goto-char opoint)
157 (if no-error
158 nil
159 (error "No file on this line")))
160 (end-of-line)
161 (if (char-equal (preceding-char) ?/)
162 (forward-char -1))
163 (point))))
164
165 ;;; end of efs-ms-unix.el