--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-vos.el	Mon Aug 13 08:50:29 2007 +0200
@@ -0,0 +1,285 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-vos.el
+;; Description:  VOS support for efs
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
+;; Created:      Sat Apr  3 03:05:00 1993 by sandy on ibm550
+;; Modified:     Sun Nov 27 18:45:24 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.
+
+;;; The original ange-ftp VOS support was written by Joe Wells <jbw@cs.bu.edu>
+
+;;; Thank you to Jim Franklin <jimf%shared@uunet.uu.net> for providing
+;;; information on the VOS operating system.
+
+(provide 'efs-vos)
+(require 'efs)
+
+(defconst efs-vos-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+;;;;---------------------------------------------------------------
+;;;; VOS support for efs
+;;;;---------------------------------------------------------------
+
+;;; A legal VOS pathname is of the form:
+;;; %systemname#diskname>dirname>dirname>dir-or-filename
+;;;
+;;; Each of systemname, diskname, dirname, dir-or-filename can be
+;;; at most 32 characters.
+;;; Valid characters are all alpha, upper and lower case, all digits,
+;;; plus: @[]\^`{|}~"$+,-./:_
+;;; restrictions: name cannot begin with hyphen (-) or period (.)
+;;;               name must not end with a period (.)
+;;;               name must not contain two adjacent periods (.)
+;;;
+;;; Invalid characters are:
+;;;               non-printing control characters
+;;;               SPACE and DEL
+;;;               !#%&'()*;<=>?
+;;;               all other ascii chars
+;;;
+;;; The full pathname must be less than or equal to 256 characters.
+;;; VOS pathnames are CASE-SENSITIVE.
+;;; The may be a directory depth limitation of 10 (newer versions may have
+;;; eliminated this).
+
+;;; entry points
+
+(efs-defun efs-fix-path vos (path &optional reverse)
+  ;; Convert PATH from UNIX-ish to VOS.
+  ;; If REVERSE given then convert from VOS to UNIX-ish.
+  ;; Does crude checking for valid path syntax, but is by no means exhaustive.
+  (efs-save-match-data
+    (if reverse
+	(if (string-match "^\\(\\(%[^#>%]+\\)?#[^>#%]+\\)?>[^>#%]" path)
+	    (let ((marker (1- (match-end 0)))
+		  (result "/")
+		  system drive)
+	      (if (match-beginning 1)
+		  (if (match-beginning 2)
+		      (setq system (substring path 1 (match-end 2))
+			    drive (substring path (1+ (match-end 2))
+					     (match-end 1)))
+		    (setq drive (substring 1 (match-end 1)))))
+	      (while (string-match ">" path marker)
+		(setq result (concat result
+				     (substring path marker
+						(match-beginning 0))
+				     "/")
+		      marker (match-end 0)))
+	      (if drive
+		  (if system
+		      (concat "/" system "/" drive result
+			    (substring path marker))
+		    (concat "/" drive result (substring path marker)))
+		(concat result (substring path marker))))
+	  (error "Invalid VOS pathname %s" path))
+    (if (string-match "^/\\([^/]+\\)/\\([^/]+\\)/[^/]" path)
+	(let ((marker (1- (match-end 0)))
+	      (result (concat "%"
+			      (substring path
+					 (match-beginning 1)
+					 (match-end 1))
+			      "#"
+			      (substring path
+					 (match-beginning 2)
+					 (match-end 2))
+			      ">")))
+	  ;; I'm guessing that VOS doesn't have a directory syntax.
+	  (setq path (efs-internal-directory-file-name path))
+	  (while (string-match "/" path marker)
+	    (setq result
+		  (concat result
+			  (substring path marker
+				     (match-beginning 0))
+			  ">")
+		  marker (match-end 0)))
+	  (concat result (substring path marker)))
+      (error "Cannot convert path %s to VOS." path)))))
+
+(efs-defun efs-fix-dir-path vos (dir-path)
+  ;; Convert path from UNIX-ish to VMS ready for a DIRectory listing.
+  (cond ((string-equal dir-path "/")
+	 (error "Cannot gork VOS system names"))
+	((string-match "^/[^/]/$" dir-path)
+	 (error "Cannot grok VOS devices"))
+	((efs-fix-path 'vos dir-path))))
+
+(defconst efs-vos-date-and-time-regexp
+  (concat
+   "\\(^\\| \\)" ; For links, this must match at the beginning of the line.
+   "[678901][0-9]-[01][0-9]-[0-3][0-9] [012][0-9]:[0-6][0-9]:[0-6][0-9]  "))
+;; Regexp to match a VOS file line. The end of the regexp must correspond
+;; to the start of the filename.
+
+(defmacro efs-vos-parse-filename ()
+  ;; Return the VOS filename on the current line of a listing.
+  ;; Assumes that the point is at the beginning of the line.
+  ;; Return nil if no filename is found.
+  (` (let ((eol (save-excursion (end-of-line) (point))))
+       (and (re-search-forward efs-vos-date-and-time-regexp eol t)
+	    (buffer-substring (point) eol)))))
+
+(efs-defun efs-parse-listing vos
+  (host user dir path &optional switches)
+  ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
+  ;; format, and return a hashtable as the result. SWITCHES are never used,
+  ;; but they must be specified in the argument list for compatibility
+  ;; with the unix version of this function.
+  ;; HOST = remote host name
+  ;; USER = user name
+  ;; DIR = directory in as a full remote path
+  ;; PATH = directory in full efs path syntax
+  ;; SWITCHES = ls switches (not relevant here)
+  (goto-char (point-min))
+  (efs-save-match-data
+    (let (tbl file)
+      ;; Look file files.
+      (if (search-forward "\nFiles: " nil t)
+	  (progn
+	    (setq tbl (efs-make-hashtable))
+	    (forward-line 1)
+	    (skip-chars-forward "\n")
+	    (while (setq file (efs-vos-parse-filename))
+	      (efs-put-hash-entry file '(nil) tbl)
+	      (forward-line 1))))
+      ;; Look for directories.
+      (if (search-forward "\nDirs: " nil t)
+	  (progn
+	    (or tbl (setq tbl (efs-make-hashtable)))
+	    (forward-line 1)
+	    (skip-chars-forward "\n")
+	    (while (setq file (efs-vos-parse-filename))
+	      (efs-put-hash-entry file '(t) tbl)
+	      (forward-line 1))))
+      ;; Look for links
+      (if (search-forward "\nLinks: " nil t)
+	  (let (link)
+	    (or tbl (setq tbl (efs-make-hashtable)))
+	    (forward-line 1)
+	    (skip-chars-forward "\n")
+	    (while (setq file (efs-vos-parse-filename))
+	      (if (string-match " ->  \\([^ ]+\\)" file)
+		  ;; VOS puts a trailing blank after the name of a symlink
+		  ;; target. Go figure...
+		  (setq link (substring file (match-beginning 1) (match-end 1))
+			file (substring file 0 (match-beginning 0)))
+		(setq link "")) ; weird?
+	      (efs-put-hash-entry file (list link) tbl)
+	      (forward-line 1))))
+      ;; This returns nil if no headings for files, dirs, or links
+      ;; are found. In this case, we're assuming that it isn't a valid
+      ;; listing.
+      (if tbl
+	  (progn
+	    (efs-put-hash-entry "." '(t) tbl)
+	    (efs-put-hash-entry ".." '(t) tbl)))
+      tbl)))
+	
+(efs-defun efs-allow-child-lookup vos (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.
+  ;; Directoried don't have a size.
+  (string-match ": not a file\\.$"
+		(cdr (efs-send-size host user (concat dir file)))))
+
+;;; Tree Dired Support
+
+(defconst efs-dired-vos-re-exe
+  "^.  +e ")
+
+(or (assq 'vos efs-dired-re-exe-alist)
+    (setq efs-dired-re-exe-alist
+	  (cons (cons 'vos  efs-dired-vos-re-exe)
+		efs-dired-re-exe-alist)))
+
+(defconst efs-dired-vos-re-dir
+  "^.  +[nsm] +[0-9]+ +[678901][0-9]-")
+
+(or (assq 'vos efs-dired-re-dir-alist)
+    (setq efs-dired-re-dir-alist
+	  (cons (cons 'vos  efs-dired-vos-re-dir)
+		efs-dired-re-dir-alist)))
+
+(efs-defun efs-dired-manual-move-to-filename vos
+  (&optional raise-error bol eol)
+  ;; In dired, move to the first char of filename on this line, where
+  ;; line can be delimited by either \r or \n.
+  ;; Returns (point) or nil if raise-error is nil and there is no
+  ;; filename on this line. In the later case, leaves the point at the
+  ;; beginning of the line.
+  ;; This version is for VOS.
+  (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
+  (let (case-fold-search)
+    (if bol
+	(goto-char bol)
+      (skip-chars-backward "^\n\r"))
+    (if (re-search-forward efs-vos-date-and-time-regexp eol t)
+	(point)
+      (and raise-error (error "No file on this line")))))
+
+(efs-defun efs-dired-manual-move-to-end-of-filename vos
+  (&optional no-error bol eol)
+  ;; Assumes point is at the 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 VOS 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-zA-Z0-9@[]\\^`{|}~\"$+,./:_")
+    (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
+	(if no-error
+	    nil
+	  (error "No file on this line"))
+      (point))))
+
+(efs-defun efs-dired-fixup-listing vos (file path &optional switches wildcard)
+  ;; VOS listing contain some empty lines, which is inconvenient for dired.
+  (goto-char (point-min))
+  (skip-chars-forward "\n")
+  (delete-region (point-min) (point))
+  (while (search-forward "\n\n" nil t)
+    (forward-char -2)
+    (delete-char 1)))
+
+(efs-defun efs-dired-ls-trim vos ()
+  ;; Trims VOS dir listings for single files, so that they are exactly one line
+  ;; long.
+  (goto-char (point-min))
+  (let (case-fold-search)
+    (re-search-forward efs-vos-date-and-time-regexp))
+  (beginning-of-line)
+  (delete-region (point-min) (point))
+  (forward-line 1)
+  (delete-region (point) (point-max)))
+
+;;; end of efs-vos.el