diff lisp/efs/efs-guardian.el @ 98:0d2f883870bc r20-1b1

Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 7e54bd776075 9f59509498e1
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/efs/efs-guardian.el	Mon Aug 13 09:13:56 2007 +0200
@@ -0,0 +1,241 @@
+;; -*-Emacs-Lisp-*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:         efs-guardian.el
+;; Release:      $efs release: 1.15 $
+;; Version:      $Revision: 1.1 $
+;; RCS:          
+;; Description:  Guardian support for efs
+;; Author:       Sandy Rutherford <sandy@math.ubc.ca>
+;; Created:      Sat Jul 10 12:26:12 1993 by sandy on ibm550
+;; Language:     Emacs-Lisp
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; This file is part of efs. See efs.el for copyright
+;;; (it's copylefted) and warrranty (there isn't one) information.
+
+;;; Acknowledgements:
+;;; Adrian Philips and David Karr for answering questions
+;;; and debugging. Thanks.
+
+(defconst efs-guardian-version
+  (concat (substring "$efs release: 1.15 $" 14 -2)
+	  "/"
+	  (substring "$Revision: 1.1 $" 11 -2)))
+
+(provide 'efs-guardian)
+(require 'efs)
+
+;;;; ------------------------------------------------------------
+;;;; Support for Tandem's GUARDIAN operating system.
+;;;; ------------------------------------------------------------
+
+;;;  Supposed to work for (Version 2.7 TANDEM 01SEP92).
+
+;;;  File name syntax:
+;;;
+;;;  File names are of the form volume.subvolume.file where
+;;;  volume is $[alphanumeric characters]{1 to 7}
+;;;  subvolume is <alpha character>[<alphanumeric character>]{0 to 7}
+;;;  and file is the same as subvolume.
+
+(defconst efs-guardian-date-regexp
+  (concat
+   " [ 1-3][0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
+   "Sep\\|Oct\\|Nov\\|Dec\\)-[0-9][0-9] "))
+
+;;; entry points -- 2 of 'em.
+
+(efs-defun efs-fix-path guardian (path &optional reverse)
+  ;; Convert PATH from unix-ish to guardian.
+  ;; If REVERSE is non-nil do just that.
+  (efs-save-match-data
+    (let ((case-fold-search t))
+      (if reverse
+	  (if (string-match
+	       (concat
+		"^\\(\\\\[A-Z0-9]+\\.\\)?"
+		"\\(\\$[A-Z0-9]+\\)\\.\\([A-Z0-9]+\\)\\(\\.[A-Z0-9]+\\)?$")
+	       path)
+	      (concat
+	       "/"
+	       (substring path (match-beginning 2) (match-end 2))
+	       "/"
+	       (substring path (match-beginning 3) (match-end 3))
+	       "/"
+	       (and (match-beginning 4)
+		    (substring path (1+ (match-beginning 4)))))
+	    (error "path %s is invalid for the GUARDIAN operating system"
+		   path))
+	(if (string-match
+	     "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$" path)
+	    (apply 'concat
+		   (substring path 1 (match-end 1))
+		   "."
+		   (substring path (match-beginning 2) (match-end 2))
+		   (and (match-beginning 3)
+			(/= (- (match-end 3) (match-beginning 3)) 1)
+			(list "."
+			      (substring path (1+ (match-beginning 3))))))
+	  (error "path %s is invalid for the guardian operating system"
+		 path))))))
+  
+(efs-defun efs-fix-dir-path guardian (dir-path)
+  ;; Convert DIR-PATH from unix-ish to guardian fir a DIR listing.
+  (efs-save-match-data
+    (let ((case-fold-search t))
+      (cond
+       ((string-equal "/" dir-path)
+	(error "Can't grok guardian disk volumes."))
+       ((string-match "^/\\$[A-Z0-9]+/?$" dir-path)
+	(error "Can't grok guardian subvolumes."))
+       ((string-match "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$"
+		      dir-path)
+	(apply 'concat
+	       (substring dir-path 1 (match-end 1))
+	       "."
+	       (substring dir-path (match-beginning 2) (match-end 2))
+	       (and (match-beginning 3)
+		    (/= (- (match-end 3) (match-beginning 3)) 1)
+		    (list "."
+			  (substring dir-path (1+ (match-beginning 3)))))))
+       (t
+	(error "path %s is invalid for the guardian operating system"))))))
+
+(efs-defun efs-parse-listing guardian
+  (host user dir path &optional switches)
+  ;; Parses a GUARDIAN DIRectory listing.
+  ;; 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.
+  (efs-save-match-data
+    (goto-char (point-min))
+    (if (re-search-forward efs-guardian-date-regexp nil t)
+	(let ((tbl (efs-make-hashtable))
+	      file size)
+	  (while
+	      (progn
+		(beginning-of-line)
+		(setq file (buffer-substring (point)
+					     (progn
+					       (skip-chars-forward "A-Z0-9")
+					       (point))))
+		(skip-chars-forward " ")
+		(skip-chars-forward "^ ")
+		(skip-chars-forward " ")
+		(setq size (string-to-int (buffer-substring
+					   (point)
+					   (progn
+					     (skip-chars-forward "0-9")))))
+		(efs-put-hash-entry file (list nil size) tbl)
+		(forward-line 1)
+		(re-search-forward efs-guardian-date-regexp nil t)))
+	  (efs-put-hash-entry "." '(t) tbl)
+	  (efs-put-hash-entry ".." '(t) tbl)
+	  tbl))))
+
+(efs-defun efs-allow-child-lookup guardian (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.
+  (efs-save-match-data
+    (let ((case-fold-search t))
+      (string-match "^/\\$[A-Z0-9]+/$" dir))))
+
+(efs-defun efs-internal-file-directory-p guardian (file)
+  ;; Directories pop into existence simply by putting files in them.
+  (efs-save-match-data
+    (let ((case-fold-search t))
+      (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
+	  t
+	(efs-internal-file-directory-p nil file)))))
+
+(efs-defun efs-internal-file-exists-p guardian (file)
+  ;; Directories pop into existence simply by putting files in them.
+  (efs-save-match-data
+    (let ((case-fold-search t))
+      (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
+	  t
+	(efs-internal-file-exists-p nil file)))))
+
+;;; Tree Dired support
+
+(defconst efs-dired-guardian-re-exe nil)
+
+(or (assq 'guardian efs-dired-re-exe-alist)
+    (setq efs-dired-re-exe-alist
+	  (cons (cons 'guardian  efs-dired-guardian-re-exe)
+		efs-dired-re-exe-alist)))
+
+(defconst efs-dired-guardian-re-dir nil)
+
+(or (assq 'guardian efs-dired-re-dir-alist)
+    (setq efs-dired-re-dir-alist
+	  (cons (cons 'guardian  efs-dired-guardian-re-dir)
+		efs-dired-re-dir-alist)))
+
+(efs-defun efs-dired-manual-move-to-filename guardian
+  (&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 guardian version.
+  (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
+  (if bol
+      (goto-char bol)
+    (skip-chars-backward "^\n\r")
+    (setq bol (point)))
+  (if (save-excursion (re-search-forward efs-guardian-date-regexp eol t))
+      (progn
+	(if (looking-at ". [^ ]")
+	    (forward-char 2))
+	(point))
+    (and raise-error (error "No file on this line"))))
+
+(efs-defun efs-dired-manual-move-to-end-of-filename guardian
+  (&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 guardian 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 (and
+       (>= (following-char) ?A)
+       (<= (following-char) ?Z)
+       (progn
+	 (skip-chars-forward "A-Z0-9")
+	 (= (following-char) ?\ )))
+      (point)
+    (and (null no-error)
+	 (error "No file on this line"))))
+
+(efs-defun efs-dired-ls-trim guardian ()
+  (goto-char (point-min))
+  (let (case-fold-search)
+    (if (re-search-forward efs-guardian-date-regexp nil t)
+	(progn
+	  (beginning-of-line)
+	  (delete-region (point-min) (point))
+	  (forward-line 1)
+	  (delete-region (point) (point-max))))))
+
+;;; end of efs-guardian.el