home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-netware.el.z / efs-netware.el
Encoding:
Text File  |  1998-05-21  |  6.5 KB  |  197 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-netware.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.5 $
  7. ;; RCS:          
  8. ;; Description:  efs support for the Novell Netware FTP server
  9. ;; Author:       Sandy Rutherford <sandy@math.ubc.ca>
  10. ;; Created:      Fri Oct 15 00:30:50 1993 by sandy on gauss.math.ubc.ca
  11. ;; Modified:     Tue Nov 22 00:11:46 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. ;;; Works for (at least) Novell NetWare v3.11. This is a DOS FTP server,
  19. ;;; however, it returns a unix-ish path format.
  20.  
  21. (provide 'efs-netware)
  22. (require 'efs)
  23.  
  24. (defconst efs-netware-version
  25.   (concat (substring "$efs release: 1.15 $" 14 -2)
  26.       "/"
  27.       (substring "#Revision: 1.5 $" 11 -2)))
  28.  
  29. ;;; Basic efs support
  30.  
  31. (defconst efs-netware-date-regexp
  32.   (concat
  33.    "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|"
  34.    "Dec\\) [ 0-3][0-9] \\([0-9][0-9] \\)?[0-2][0-9]:[0-6][0-9] +"))
  35.  
  36. (efs-defun efs-fix-path netware (path &optional reverse)
  37.   ;; Convert PATH from UNIX-ish to netware.
  38.   (efs-save-match-data
  39.     (if reverse
  40.     (cond ((string-match "^[^/][^:]*:" path)
  41.            (concat "/" path))
  42.           ((string-match "^/" path)
  43.            path)
  44.           ((error "%s not a valid netware path." path)))
  45.       (if (string-match ":" path)
  46.       (substring path 1)
  47.     path))))
  48.  
  49. (efs-defun efs-fix-dir-path netware (dir-path)
  50.   ;; Convert DIR-PATH from UN*X-ish to Netware for a DIR listing.
  51.   (efs-fix-dir-path nil (efs-fix-path 'netware dir-path)))
  52.  
  53. (defun efs-netware-bogus-listing-p (dir path)
  54.   (save-excursion
  55.     (and
  56.      (not (eobp))
  57.      (save-excursion (forward-line 1) (eobp))
  58.      (not (string-equal dir "/"))
  59.      (re-search-forward efs-netware-date-regexp nil t)
  60.      (search-forward "/.\n"))))
  61.  
  62. (efs-defun efs-parse-listing netware (host user dir path &optional switches)
  63.   ;; Parse the current buffer which is assumed to be a listing from
  64.   ;; a Novell Netware FTP server (runs under DOS).
  65.   ;; format, and return a hashtable as the result. SWITCHES are never used,
  66.   ;; but they must be specified in the argument list for compatibility
  67.   ;; with the unix version of this function.
  68.   ;; HOST = remote host name
  69.   ;; USER = user name
  70.   ;; DIR = directory in as a full remote path
  71.   ;; PATH = directory in full efs path syntax
  72.   ;; SWITCHES = ls switches (not relevant here)
  73.   (goto-char (point-min))
  74.   (efs-save-match-data
  75.     (if (re-search-forward efs-netware-date-regexp nil t)
  76.     (progn
  77.       (beginning-of-line)
  78.       (and (not (efs-netware-bogus-listing-p dir path))
  79.            (let ((tbl (efs-make-hashtable))
  80.              dir-p file size)
  81.          (while (let ((eol (save-excursion (end-of-line) (point))))
  82.               (setq dir-p (= (following-char) ?d))
  83.               (re-search-forward efs-netware-date-regexp eol t))
  84.            (setq file (buffer-substring (point)
  85.                         (progn (end-of-line) (point)))
  86.              size (progn
  87.                 (goto-char (match-beginning 0))
  88.                 (skip-chars-backward " ")
  89.                 (buffer-substring (point)
  90.                           (progn
  91.                             (skip-chars-backward "0-9")
  92.                             (point)))))
  93.            (if (string-equal size "")
  94.                (setq size nil)
  95.              (setq size (string-to-int size)))
  96.            (efs-put-hash-entry file (list dir-p size) tbl)
  97.            (forward-line 1))
  98.          (efs-put-hash-entry "." '(t) tbl)
  99.          (efs-put-hash-entry ".." '(t) tbl)
  100.          tbl))))))
  101.  
  102. ;;; Sorting dir listings.
  103.  
  104. (efs-fset 'efs-t-converter 'netware 'efs-unix-t-converter)
  105.  
  106. ;;; Dired support
  107.  
  108. (defconst efs-dired-netware-re-exe "\\.\\(exe\\|EXE\\)$")
  109. (or (assq 'netware efs-dired-re-exe-alist)
  110.     (setq efs-dired-re-exe-alist
  111.       (cons (cons 'netware efs-dired-netware-re-exe)
  112.         efs-dired-re-exe-alist)))
  113.  
  114. (defconst efs-dired-netware-re-dir "^.[ \t]+d ")
  115. (or (assq 'netware efs-dired-re-dir-alist)
  116.     (setq efs-dired-re-dir-alist
  117.       (cons (cons 'netware  efs-dired-netware-re-dir)
  118.         efs-dired-re-dir-alist)))
  119.  
  120. (efs-defun efs-dired-manual-move-to-filename netware
  121.   (&optional raise-error bol eol)
  122.   ;; In dired, move to the first char of filename on this line.
  123.   ;; Returns (point) or nil if raise-error is nil, and there is no
  124.   ;; no filename on this line.
  125.   ;; This is the Netware version.
  126.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  127.   (let (case-fold-search)
  128.     (if bol
  129.     (goto-char bol)
  130.       (skip-chars-backward "^\n\r"))
  131.     ;; move over marker
  132.     (if (re-search-forward efs-netware-date-regexp eol t)
  133.     (goto-char (match-end 0)) ; returns (point)
  134.       (and raise-error (error "No file on this line")))))
  135.  
  136. (efs-defun efs-dired-manual-move-to-end-of-filename netware
  137.   (&optional no-error bol eol)
  138.   ;; Assumes point is at the beginning of filename.
  139.   ;; So, it should be called only after (dired-move-to-filename t)
  140.   ;; On failure signals an error, or returns nil.
  141.   ;; This is the Netware version.
  142.   (let ((opoint (point)))
  143.     (and selective-display
  144.      (null no-error)
  145.      (eq (char-after
  146.           (1- (or bol (save-excursion
  147.                 (skip-chars-backward "^\r\n")
  148.                 (point)))))
  149.          ?\r)
  150.      ;; File is hidden or omitted.
  151.      (cond
  152.       ((dired-subdir-hidden-p (dired-current-directory))
  153.        (error
  154.         (substitute-command-keys
  155.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  156.       ((error
  157.         (substitute-command-keys
  158.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  159.          )))))
  160.     (skip-chars-forward "^A-Z\n\r")
  161.     (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
  162.     (if no-error
  163.         nil
  164.       (error "No file on this line"))
  165.       (point))))
  166.  
  167. (efs-defun efs-dired-insert-headerline netware (dir)
  168.   ;; Insert a blank line for aesthetics.
  169.   (insert " \n")
  170.   (forward-char -2)
  171.   (efs-real-dired-insert-headerline dir))
  172.  
  173. (efs-defun efs-dired-fixup-listing netware
  174.   (file path &optional switches wildcard)
  175.   ;; listings come out in random order
  176.   (let (case-fold-search)
  177.     (if (or (null switches)
  178.         ;; In case efs is handling the switches itself.
  179.         (not (string-match "t" switches)))
  180.     (progn
  181.       (goto-char (point-max))
  182.       (if (re-search-backward efs-netware-date-regexp nil t)
  183.           (save-restriction
  184.         (forward-line 1)
  185.         (narrow-to-region (point-min) (point))
  186.         (forward-line -1)
  187.         ;; Count how many fields
  188.         (let ((fields 0))
  189.           (skip-chars-forward " \t")
  190.           (while (not (eolp))
  191.             (skip-chars-forward "^  \t\n")
  192.             (skip-chars-forward " \t")
  193.             (setq fields (1+ fields)))
  194.           (sort-fields fields (point-min) (point-max)))))))))
  195.  
  196. ;;; end of efs-netware.el
  197.