cgit.sxemacs.org Git - packages/blob - xemacs-packages/efs/efs-ms-unix.el

   1 ;; -*-Emacs-Lisp-*-
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; File:         efs-ms-unix.el
   5 ;; Release:      $efs release: 1.24 $
   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.24 $" 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 (char-before (point)) ?/)
 162           (forward-char -1))
 163       (point))))
 164
 165 ;;; end of efs-ms-unix.el