cgit.sxemacs.org Git - packages/blob - xemacs-packages/efs/efs-cms-knet.el

   1 ;; -*-Emacs-Lisp-*-
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; File:         efs-cms-knet.el
   5 ;; Release:      $efs release: 1.24 $
   6 ;; Version:      #Revision: 1.1 $
   7 ;; RCS:
   8 ;; Description:  CMS support for efs using KNET/VM server
   9 ;; Authors:      Sandy Rutherford <sandy@ibm550.sissa.it>
  10 ;;               Joerg-Martin Schwarz <schwarz@hal1.physik.uni-dortmund.de>
  11 ;; Created:      Wed Mar 23 14:39:00 1994 by schwarz on hal1 from efs-cms.el
  12 ;; Modified:     Sun Nov 27 11:45:58 1994 by sandy on gandalf
  13 ;; Language:     Emacs-Lisp
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16
  17 ;;; This file is part of efs. See efs.el for copyright
  18 ;;; (it's copylefted) and warranty (there isn't one) information.
  19
  20 (provide 'efs-cms-knet)
  21 (require 'efs)
  22
  23 (defconst efs-cms-knet-version
  24   (concat (substring "$efs release: 1.24 $" 14 -2)
  25           "/"
  26           (substring "#Revision: 1.1 $" 11 -2)))
  27
  28 ;;;; ------------------------------------------------------------
  29 ;;;; CMS support for KNET-VM server
  30 ;;;; ------------------------------------------------------------
  31
  32 ;;; efs has full support, including tree dired support, for hosts running
  33 ;;; CMS.  It should be able to automatically recognize any CMS machine.
  34 ;;; We would be grateful if you would report any failures to automatically
  35 ;;; recognize a CMS host as a bug.
  36 ;;;
  37 ;;; Filename syntax:
  38 ;;;
  39 ;;; KNET/VM Support (J. M. Schwarz, Mar 12, 1994):
  40 ;;; This code has been developed and tested with
  41 ;;; "KNET/VM FTP server Release 3.2.0" by Spartacus.
  42 ;;;
  43 ;;; This server uses not only a different listing format than the one used in
  44 ;;; efs-cms.el, but also handles minidisks differently.
  45 ;;; The cd command for changing minidisk is not supported,
  46 ;;; instead a full filename syntax "FILENAME.FILETYPE.FM" is used, where
  47 ;;; FM is the filemode. To access a file "PROFILE EXEC A0", efs uses a
  48 ;;; syntax "/cms-hostname:/A:/PROFILE.EXEC"   (Note the ':')
  49 ;;;
  50 ;;; In this directory notation, "/A0:" is actually a subset of the "/A:"
  51 ;;; directory.
  52
  53 (efs-defun efs-send-pwd cms-knet (host user &optional xpwd)
  54   ;; cms-knet has no concept of current directory.
  55   ;; Is it safe to always assume this is the user's home?
  56   (cons "A" ""))
  57
  58 (efs-defun efs-fix-path cms-knet (path &optional reverse)
  59   ;; Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
  60   ;; from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
  61   ;; so we fudge things by sending cd's.
  62   (if reverse
  63       ;; Since we only convert output from a pwd in this direction,
  64       ;; this should never be applied, as PWD doesn't work for this server.
  65       (concat "/" path "/")
  66     (efs-save-match-data
  67       (if (string-match "^/[A-Z]/\\([-A-Z0-9$_+@:]+\\.[-A-Z0-9$_+@:]+\\)$"
  68                         path)
  69           (concat
  70            (substring path (match-beginning 1) (match-end 1))
  71            "."
  72            ;; minidisk
  73            (substring path 1 2))
  74         (error "Invalid CMS-KNET filename")))))
  75
  76 (efs-defun efs-fix-dir-path cms-knet (dir-path)
  77   ;; Convert path from UNIX-ish to CMS-KNET ready for a DIRectory listing.
  78   (cond
  79    ((string-equal "/" dir-path)
  80     "*.*.*")
  81    ((string-match
  82      "^/[A-Z]/\\([-A-Z0-9$._+@:]+\\.[-A-Z0-9$._+@:]+\\)?$"
  83      dir-path)
  84     (concat
  85      (if (match-beginning 1)
  86          (substring dir-path (match-beginning 1) (match-end 1))
  87        "*")
  88      "."
  89      (substring dir-path 1 2)))
  90    (t (error "Invalid CMS-KNET pathname"))))
  91
  92 (defconst efs-cms-knet-file-name-regexp
  93   (concat
  94    "^  *\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +"
  95    "\\([A-Z]\\)[0-9] +[VF] +[0-9]+ "))
  96
  97 (efs-defun efs-parse-listing cms-knet
  98   (host user dir path &optional switches)
  99   ;; Parse the current buffer which is assumed to be a CMS directory listing.
 100   ;; HOST = remote host name
 101   ;; USER = remote user name
 102   ;; DIR = directory as a full remote path
 103   ;; PATH = directory as a full efs-path
 104   (let ((tbl (efs-make-hashtable)))
 105     (goto-char (point-min))
 106     (efs-save-match-data
 107       (if (string-equal dir "/")
 108           (let ((case-fold (memq 'cms-knet efs-case-insensitive-host-types))
 109                 tbl-alist md md-tbl)
 110             (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
 111               (setq md (buffer-substring (match-beginning 3) (match-end 3))
 112                     md-tbl (or (cdr (assoc md tbl-alist))
 113                                (let ((new-tbl (efs-make-hashtable)))
 114                                  (setq tbl-alist
 115                                        (cons (cons md new-tbl)
 116                                              tbl-alist))
 117                                  new-tbl)))
 118               (efs-put-hash-entry md '(t) tbl)
 119               (efs-put-hash-entry (concat
 120                                    (buffer-substring (match-beginning 1)
 121                                                      (match-end 1))
 122                                    "."
 123                                    (buffer-substring (match-beginning 2)
 124                                                      (match-end 2)))
 125                                   '(nil) md-tbl)
 126               (forward-line 1))
 127             (while tbl-alist
 128               (setq md (car (car tbl-alist))
 129                     md-tbl (cdr (car tbl-alist)))
 130               (efs-put-hash-entry "." '(t) md-tbl)
 131               (efs-put-hash-entry ".." '(t) md-tbl)
 132               (efs-put-hash-entry (concat path md "/") md-tbl
 133                                   efs-files-hashtable case-fold)
 134               (setq tbl-alist (cdr tbl-alist))))
 135         (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
 136           (efs-put-hash-entry
 137            (concat (buffer-substring (match-beginning 1)
 138                                      (match-end 1))
 139                    "."
 140                    (buffer-substring (match-beginning 2)
 141                                      (match-end 2)))
 142            '(nil) tbl)
 143           (forward-line 1)))
 144       (efs-put-hash-entry "." '(t) tbl)
 145       (efs-put-hash-entry ".." '(t) tbl))
 146     tbl))
 147
 148 (efs-defun efs-allow-child-lookup cms-knet (host user dir file)
 149   ;; Returns t if FILE in directory DIR could possibly be a subdir
 150   ;; according to its file-name syntax, and therefore a child listing should
 151   ;; be attempted.
 152
 153   ;; CMS file system is flat. Only minidisks are "subdirs".
 154   (string-equal "/" dir))
 155
 156 ;;; Tree dired support:
 157
 158 (defconst efs-dired-cms-re-exe
 159   "^. +[-A-Z0-9$_+@:]+ +\\(EXEC\\|MODULE\\) "
 160   "Regular expression to use to search for CMS executables.")
 161
 162 (or (assq 'cms efs-dired-re-exe-alist)
 163     (setq efs-dired-re-exe-alist
 164           (cons (cons 'cms-knet efs-dired-cms-re-exe)
 165                 efs-dired-re-exe-alist)))
 166
 167 (efs-defun efs-dired-insert-headerline cms-knet (dir)
 168   ;; CMS has no total line, so we insert a blank line for
 169   ;; aesthetics.
 170   (insert "\n")
 171   (forward-char -1)
 172   (efs-real-dired-insert-headerline dir))
 173
 174 (efs-defun efs-dired-manual-move-to-filename cms-knet
 175   (&optional raise-error bol eol)
 176   ;; In dired, move to the first char of filename on this line.
 177   ;; This is the CMS version.
 178   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
 179   (let (case-fold-search)
 180     (if bol
 181         (goto-char bol)
 182       (skip-chars-backward "^\n\r")
 183       (setq bol (point)))
 184     (if (re-search-forward efs-cms-knet-file-name-regexp eol t)
 185         (goto-char (match-beginning 1))
 186       (if raise-error
 187           (error "No file on this line.")
 188         (goto-char bol)))))
 189
 190 (efs-defun efs-dired-manual-move-to-end-of-filename cms-knet
 191   (&optional no-error bol eol)
 192   ;; Assumes point is at beginning of filename.
 193   ;; So, it should be called only after (dired-move-to-filename t).
 194   ;; case-fold-search must be nil, at least for VMS.
 195   ;; On failure, signals an error or returns nil.
 196   ;; This is the CMS version.
 197   (and selective-display
 198        (null no-error)
 199        (eq (char-after
 200             (1- (or bol (save-excursion
 201                           (skip-chars-backward "^\r\n")
 202                           (point)))))
 203            ?\r)
 204        ;; File is hidden or omitted.
 205        (cond
 206         ((dired-subdir-hidden-p (dired-current-directory))
 207          (error
 208           (substitute-command-keys
 209            "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
 210         ((error
 211           (substitute-command-keys
 212            "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
 213            )))))
 214   (if (looking-at "[-A-Z0-9$_+@:]+ +[-A-Z0-9$_+@:]+ +[A-Z][0-9] ")
 215       (goto-char (- (match-end 0) 2)) ; return point
 216     (if no-error
 217         nil
 218       (error "No file on this line."))))
 219
 220 (efs-defun efs-dired-get-filename cms-knet
 221   (&optional localp no-error-if-not-filep)
 222   (let ((name (efs-real-dired-get-filename 'no-dir no-error-if-not-filep)))
 223     (and name
 224          (if (string-match
 225               "^\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +\\([A-Z]\\)$"
 226               name)
 227              (let* ((dir (dired-current-directory))
 228                     (rdir (nth 2 (efs-ftp-path dir))))
 229                (setq name (concat (substring name (match-beginning 1)
 230                                              (match-end 1))
 231                                   "."
 232                                   (substring name (match-beginning 2)
 233                                              (match-end 2))))
 234                (if (string-equal rdir "/")
 235                    (setq name (concat (substring name (match-beginning 3)
 236                                                  (match-end 3)) "/" name)))
 237                (if (eq localp 'no-dir)
 238                    name
 239                  (concat (if localp
 240                              (dired-current-directory localp)
 241                            dir)
 242                          name)))
 243            (error "Strange CMS-KNET file name %s" name)))))
 244
 245 ;;; end of efs-cms-knet.el