;; File: efs-mts.el
;; Release: $efs release: 1.20pre2 $
;; Version: #Revision: 1.1 $
;; Description: MTS support for efs
;; Author: Sandy Rutherford <firstname.lastname@example.org>
;; 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 warranty (there isn't one) information.
(concat (substring "$efs release: 1.20pre2 $" 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
;;; 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
;;; 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
"\\|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.
(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 "/"))
(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.
(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)))
((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))
(while (re-search-forward efs-mts-date-regexp nil t)
(if (looking-at "[rwed]+")
(setq perms (buffer-substring (match-beginning 0) (match-end 0)))
(setq perms nil))
(skip-chars-backward " ")
(let ((end (point)))
(efs-put-hash-entry (buffer-substring (point) end)
(list nil nil nil perms) tbl))
;; Don't need to bother with ..
(efs-put-hash-entry "." '(t) 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)
(null (null (string-match "w" modes))))
t)) ; guess
(efs-defun efs-internal-file-readable-p mts (user owner modes)
(if (stringp modes)
(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)
(cons (cons 'mts efs-dired-mts-re-exe)
(defconst efs-dired-mts-re-dir nil)
(or (assq 'mts efs-dired-re-dir-alist)
(cons (cons 'mts efs-dired-mts-re-dir)
(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 (re-search-forward efs-mts-date-regexp eol t)
(skip-chars-forward " ") ; Eat blanks after date
(skip-chars-forward "0-9:") ; Eat time or year
(skip-chars-forward " ") ; one space before filename
(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)))
(1- (or bol (save-excursion
;; File is hidden or omitted.
"File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
"File line is omitted. Type \\[dired-omit-toggle] to un-omit."
(if (or (= opoint (point)) (not (memq (char-after (point)) '(?\r ?\n))))
(error "No file on this line"))
(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)
(if (= (aref path (1- len)) ?/)
(setq path (substring path -2))
(setq path (substring path -1)))
(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
;;; end of efs-mts.el