--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-mts.el	Mon Aug 13 08:50:29 2007 +0200
@@ -0,0 +1,239 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-mts.el
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Description:  MTS support for efs
+;; Author:       Sandy Rutherford <sandy@itp.ethz.ch>
+;; Created:      Fri Oct 23 08:51:29 1992
+;; Modified:     Sun Nov 27 18:37:18 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-mts)
+(require 'efs)
+
+(defconst efs-mts-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+;;;; ------------------------------------------------------------
+;;;; MTS support
+;;;; ------------------------------------------------------------
+
+;;; efs has full support, including tree dired support, for hosts running
+;;; the Michigan terminal system.  It should be able to automatically
+;;; recognize any MTS machine. We would be grateful if you
+;;; would report any failures to automatically recognize a MTS host as a bug.
+;;;
+;;; Filename syntax:
+;;; 
+;;; MTS filenames are entered in a UNIX-y way. For example, if your account
+;;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
+;;; entered as
+;;;   /YYYY@mtsg.ubc.ca:/XXXX:/FILE
+;;; In other words, MTS accounts are treated as UNIX directories. Of course,
+;;; to access a file in another account, you must have access permission for
+;;; it.  If FILE were in your own account, then you could enter it in a
+;;; relative path fashion as
+;;;   /YYYY@mtsg.ubc.ca:FILE
+;;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
+;;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
+;;; like.) MTS filenames are always in upper case, and hence be sure to enter
+;;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
+;;; is.
+
+
+(defconst efs-mts-date-regexp
+  (concat
+   " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
+   "\\|Nov\\|Dec\\) [ 123]?[0-9] "))
+
+;;; The following two functions are entry points to this file.
+;;; They are put into the appropriate alists in efs.el
+
+(efs-defun efs-fix-path mts (path &optional reverse)
+  ;; Convert PATH from UNIX-ish to MTS.
+  ;; If REVERSE given then convert from MTS to UNIX-ish.
+  (efs-save-match-data
+    (if reverse
+	(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" path)
+	    (let (acct file)
+	      (if (match-beginning 1)
+		  (setq acct (substring path 0 (match-end 1))))
+	      (if (match-beginning 2)
+		  (setq file (substring path
+					(match-beginning 2) (match-end 2))))
+	      (concat (and acct (concat "/" acct "/"))
+		      file))
+	  (error "path %s didn't match" path))
+      (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" path)
+	  (concat (substring path 1 (match-end 1))
+		  (substring path (match-beginning 2) (match-end 2)))
+	;; Let's hope that mts will recognize it anyway.
+	path))))
+
+(efs-defun efs-fix-dir-path mts (dir-path)
+;; Convert path from UNIX-ish to MTS ready for a DIRectory listing.
+;; Remember that there are no directories in MTS.
+  (if (string-equal dir-path "/")
+      (error "Cannot get listing for fictitious \"/\" directory.")
+    (let ((dir-path (efs-fix-path 'mts dir-path)))
+      (cond
+       ((string-equal dir-path "")
+	"?")
+       ((efs-save-match-data (string-match ":$" dir-path))
+	(concat dir-path "?"))
+       (dir-path))))) ; It's just a single file.
+
+
+(efs-defun efs-parse-listing mts
+  (host user dir path &optional switches)
+  ;; Parse the current buffer which is assumed to be in
+  ;; mts ftp dir format.
+  ;; HOST = remote host name
+  ;; USER = remote user name
+  ;; DIR = remote directory as a remote full path
+  ;; PATH = directory as an efs full path
+  ;; SWITCHES are never used here, but they
+  ;; must be specified in the argument list for compatibility
+  ;; with the unix version of this function.
+  (let ((tbl (efs-make-hashtable))
+	perms)
+    (goto-char (point-min))
+    (efs-save-match-data
+      (while (re-search-forward efs-mts-date-regexp nil t)
+	(beginning-of-line)
+	(if (looking-at "[rwed]+")
+	    (setq perms (buffer-substring (match-beginning 0) (match-end 0)))
+	  (setq perms nil))
+	(end-of-line)
+	(skip-chars-backward " ")
+	(let ((end (point)))
+	  (skip-chars-backward "-A-Z0-9_.!")
+	  (efs-put-hash-entry (buffer-substring (point) end)
+				   (list nil nil nil perms) tbl))
+	(forward-line 1)))
+      ;; Don't need to bother with ..
+    (efs-put-hash-entry "." '(t) tbl)
+    tbl))
+
+(efs-defun efs-allow-child-lookup mts (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.
+
+  ;; MTS file system is flat. Only "accounts" are subdirs.
+  (string-equal "/" dir))
+
+(efs-defun efs-internal-file-writable-p mts (user owner modes)
+  (if (stringp modes)
+      (efs-save-match-data
+	(null (null (string-match "w" modes))))
+    t)) ; guess
+
+(efs-defun efs-internal-file-readable-p mts (user owner modes)
+  (if (stringp modes)
+      (efs-save-match-data
+	(null (null (string-match "r" modes))))
+    t)) ; guess
+
+;;; Tree dired support:
+
+;; There aren't too many systems left that use MTS. This dired support will
+;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
+;; implement ftp in the same way. If not, it might be necessary to make the
+;; following more flexible.
+
+(defconst efs-dired-mts-re-exe nil)
+
+(or (assq 'mts efs-dired-re-exe-alist)
+    (setq efs-dired-re-exe-alist
+	  (cons (cons 'mts  efs-dired-mts-re-exe)
+		efs-dired-re-exe-alist)))
+
+(defconst efs-dired-mts-re-dir nil)
+
+(or (assq 'mts efs-dired-re-dir-alist)
+    (setq efs-dired-re-dir-alist
+	  (cons (cons 'mts  efs-dired-mts-re-dir)
+		efs-dired-re-dir-alist)))
+
+(efs-defun efs-dired-manual-move-to-filename mts
+  (&optional raise-error bol eol)
+  ;; In dired, move to first char of filename on this line.
+  ;; Returns position (point) or nil if no filename on this line.
+  ;; This is the MTS version.
+  (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
+  (if bol
+      (goto-char bol)
+    (skip-chars-backward "^\n\r"))
+  (if (re-search-forward efs-mts-date-regexp eol t)
+      (progn
+	(skip-chars-forward " ")      ; Eat blanks after date
+	(skip-chars-forward "0-9:")   ; Eat time or year
+	(skip-chars-forward " ")      ; one space before filename
+	(point))
+    (and raise-error (error "No file on this line"))))
+
+(efs-defun efs-dired-manual-move-to-end-of-filename mts
+  (&optional no-error bol eol)
+  ;; Assumes point is at beginning of filename.
+  ;; So, it should be called only after (dired-move-to-filename t).
+  ;; On failure, signals an error or returns nil.
+  ;; This is the MTS version.
+  (let ((opoint (point)))
+    (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."
+	     )))))
+    (skip-chars-forward "-A-Z0-9._!")
+    (if (or (= opoint (point)) (not (memq (following-char) '(?\r ?\n))))
+	(if no-error
+	    nil
+	  (error "No file on this line"))
+      (point))))
+
+(efs-defun efs-dired-fixup-listing mts (file path &optional switches wildcard)
+  ;; If you're not listing your own account, MTS puts the
+  ;; account name in front of each filename. Scrape them off.
+  ;; PATH will have unix /'s on it.
+  ;; file-name-directory is in case of wildcards
+  (let ((len (length path)))
+    (if (> len 2)
+	(progn
+	  (if (= (aref path (1- len)) ?/)
+	      (setq path (substring path -2))
+	    (setq path (substring path -1)))
+	  (goto-char (point-min))
+	  (while (search-forward path nil t)
+	    (delete-region (match-beginning 0) (match-end 0)))))))
+
+(efs-defun efs-dired-insert-headerline mts (dir)
+  ;; MTS has no total line, so we insert a blank line for
+  ;; aesthetics.
+  (insert "\n")
+  (forward-char -1)
+  (efs-real-dired-insert-headerline dir))
+
+;;; end of efs-mts.el