--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-cms-knet.el	Mon Aug 13 09:13:56 2007 +0200
@@ -0,0 +1,245 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-cms-knet.el
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Description:  CMS support for efs using KNET/VM server
+;; Authors:	 Sandy Rutherford <sandy@ibm550.sissa.it>
+;;               Joerg-Martin Schwarz <schwarz@hal1.physik.uni-dortmund.de>
+;; Created:      Wed Mar 23 14:39:00 1994 by schwarz on hal1 from efs-cms.el
+;; Modified:     Sun Nov 27 11:45:58 1994 by sandy on gandalf
+;; Language:     Emacs-Lisp
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; This file is part of efs. See efs.el for copyright
+;;; (it's copylefted) and warrranty (there isn't one) information.
+
+(provide 'efs-cms-knet)
+(require 'efs)
+
+(defconst efs-cms-knet-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+;;;; ------------------------------------------------------------
+;;;; CMS support for KNET-VM server
+;;;; ------------------------------------------------------------
+
+;;; efs has full support, including tree dired support, for hosts running
+;;; CMS.  It should be able to automatically recognize any CMS machine.
+;;; We would be grateful if you would report any failures to automatically
+;;; recognize a CMS host as a bug.
+;;; 
+;;; Filename syntax:
+;;;
+;;; KNET/VM Support (J. M. Schwarz, Mar 12, 1994):
+;;; This code has been developed and tested with 
+;;; "KNET/VM FTP server Release 3.2.0" by Spartacus.
+;;;
+;;; This server uses not only a different listing format than the one used in
+;;; efs-cms.el, but also handles minidisks differently. 
+;;; The cd command for changing minidisk is not supported, 
+;;; instead a full filename syntax "FILENAME.FILETYPE.FM" is used, where
+;;; FM is the filemode. To access a file "PROFILE EXEC A0", efs uses a
+;;; syntax "/cms-hostname:/A:/PROFILE.EXEC"   (Note the ':')
+;;; 
+;;; In this directory notation, "/A0:" is actually a subset of the "/A:"
+;;; directory.
+
+(efs-defun efs-send-pwd cms-knet (host user &optional xpwd)
+  ;; cms-knet has no concept of current directory.
+  ;; Is it safe to always assume this is the user's home?
+  (cons "A" ""))
+
+(efs-defun efs-fix-path cms-knet (path &optional reverse)
+  ;; Convert PATH from UNIX-ish to CMS. If REVERSE is given, convert
+  ;; from CMS to UNIX. Actually, CMS doesn't have a full pathname syntax,
+  ;; so we fudge things by sending cd's.
+  (if reverse
+      ;; Since we only convert output from a pwd in this direction,
+      ;; this should never be applied, as PWD doesn't work for this server.
+      (concat "/" path "/")
+    (efs-save-match-data
+      (if (string-match "^/[A-Z]/\\([-A-Z0-9$_+@:]+\\.[-A-Z0-9$_+@:]+\\)$"
+			path)
+	  (concat
+	   (substring path (match-beginning 1) (match-end 1))
+	   "."
+	   ;; minidisk
+	   (substring path 1 2))
+	(error "Invalid CMS-KNET filename")))))
+
+(efs-defun efs-fix-dir-path cms-knet (dir-path)
+  ;; Convert path from UNIX-ish to CMS-KNET ready for a DIRectory listing.
+  (cond
+   ((string-equal "/" dir-path)
+    "*.*.*")
+   ((string-match
+     "^/[A-Z]/\\([-A-Z0-9$._+@:]+\\.[-A-Z0-9$._+@:]+\\)?$"
+     dir-path)
+    (concat 
+     (if (match-beginning 1)
+	 (substring dir-path (match-beginning 1) (match-end 1))
+       "*")
+     "."
+     (substring dir-path 1 2)))
+   (t (error "Invalid CMS-KNET pathname"))))
+
+(defconst efs-cms-knet-file-name-regexp
+  (concat
+   "^  *\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +"
+   "\\([A-Z]\\)[0-9] +[VF] +[0-9]+ "))
+
+(efs-defun efs-parse-listing cms-knet
+  (host user dir path &optional switches)
+  ;; Parse the current buffer which is assumed to be a CMS directory listing.
+  ;; HOST = remote host name
+  ;; USER = remote user name
+  ;; DIR = directory as a full remote path
+  ;; PATH = directory as a full efs-path
+  (let ((tbl (efs-make-hashtable)))
+    (goto-char (point-min))
+    (efs-save-match-data
+      (if (string-equal dir "/")
+	  (let ((case-fold (memq 'cms-knet efs-case-insensitive-host-types))
+		tbl-alist md md-tbl)
+	    (while (re-search-forward efs-cms-knet-file-name-regexp nil t)
+	      (setq md (buffer-substring (match-beginning 3) (match-end 3))
+		    md-tbl (or (cdr (assoc md tbl-alist))
+			       (let ((new-tbl (efs-make-hashtable)))
+				 (setq tbl-alist
+				       (cons (cons md new-tbl)
+					     tbl-alist))
+				 new-tbl)))
+	      (efs-put-hash-entry md '(t) tbl)
+	      (efs-put-hash-entry (concat
+				   (buffer-substring (match-beginning 1)
+						     (match-end 1))
+				   "."
+				   (buffer-substring (match-beginning 2)
+						     (match-end 2)))
+				  '(nil) md-tbl)
+	      (forward-line 1))
+	    (while tbl-alist
+	      (setq md (car (car tbl-alist))
+		    md-tbl (cdr (car tbl-alist)))
+	      (efs-put-hash-entry "." '(t) md-tbl)
+	      (efs-put-hash-entry ".." '(t) md-tbl)
+	      (efs-put-hash-entry (concat path md "/") md-tbl
+				  efs-files-hashtable case-fold)
+	      (setq tbl-alist (cdr tbl-alist))))
+	(while (re-search-forward efs-cms-knet-file-name-regexp nil t)
+	  (efs-put-hash-entry
+	   (concat (buffer-substring (match-beginning 1)
+				     (match-end 1))
+		   "."
+		   (buffer-substring (match-beginning 2)
+				     (match-end 2)))
+	   '(nil) tbl)
+	  (forward-line 1)))
+      (efs-put-hash-entry "." '(t) tbl)
+      (efs-put-hash-entry ".." '(t) tbl))
+    tbl))
+
+(efs-defun efs-allow-child-lookup cms-knet (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.
+  
+  ;; CMS file system is flat. Only minidisks are "subdirs".
+  (string-equal "/" dir))
+
+;;; Tree dired support:
+
+(defconst efs-dired-cms-re-exe
+  "^. +[-A-Z0-9$_+@:]+ +\\(EXEC\\|MODULE\\) "
+  "Regular expression to use to search for CMS executables.")
+
+(or (assq 'cms efs-dired-re-exe-alist)
+    (setq efs-dired-re-exe-alist
+	  (cons (cons 'cms-knet efs-dired-cms-re-exe)
+		efs-dired-re-exe-alist)))
+
+(efs-defun efs-dired-insert-headerline cms-knet (dir)
+  ;; CMS 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 cms-knet
+  (&optional raise-error bol eol)
+  ;; In dired, move to the first char of filename on this line.
+  ;; This is the CMS version.
+  (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
+  (let (case-fold-search)
+    (if bol
+	(goto-char bol)
+      (skip-chars-backward "^\n\r")
+      (setq bol (point)))
+    (if (re-search-forward efs-cms-knet-file-name-regexp eol t)
+	(goto-char (match-beginning 1))
+      (if raise-error
+	  (error "No file on this line.")
+	(goto-char bol)))))
+
+(efs-defun efs-dired-manual-move-to-end-of-filename cms-knet
+  (&optional no-error bol eol)
+  ;; Assumes point is at beginning of filename.
+  ;; So, it should be called only after (dired-move-to-filename t).
+  ;; case-fold-search must be nil, at least for VMS.
+  ;; On failure, signals an error or returns nil.
+  ;; This is the CMS version.
+  (and selective-display
+       (null no-error)
+       (eq (char-after
+	    (1- (or bol (save-excursion
+			  (skip-chars-backward "^\r\n")
+			  (point)))))
+	   ?\r)
+       ;; File is 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."
+	   )))))
+  (if (looking-at "[-A-Z0-9$_+@:]+ +[-A-Z0-9$_+@:]+ +[A-Z][0-9] ")
+      (goto-char (- (match-end 0) 2)) ; return point
+    (if no-error
+	nil
+      (error "No file on this line."))))
+
+(efs-defun efs-dired-get-filename cms-knet
+  (&optional localp no-error-if-not-filep)
+  (let ((name (efs-real-dired-get-filename 'no-dir no-error-if-not-filep)))
+    (and name
+	 (if (string-match
+	      "^\\([-A-Z0-9$_+@:]+\\) +\\([-A-Z0-9$_+@:]+\\) +\\([A-Z]\\)$"
+	      name)
+	     (let* ((dir (dired-current-directory))
+		    (rdir (nth 2 (efs-ftp-path dir))))
+	       (setq name (concat (substring name (match-beginning 1)
+					     (match-end 1))
+				  "."
+				  (substring name (match-beginning 2)
+					     (match-end 2))))
+	       (if (string-equal rdir "/")
+		   (setq name (concat (substring name (match-beginning 3)
+						 (match-end 3)) "/" name)))
+	       (if (eq localp 'no-dir)
+		   name
+		 (concat (if localp
+			     (dired-current-directory localp)
+			   dir)
+			 name)))
+	   (error "Strange CMS-KNET file name %s" name)))))
+
+;;; end of efs-cms-knet.el