diff lisp/hyperbole/hpath.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 1a767b41a199
children 4be1180a9e89
line wrap: on
line diff
--- a/lisp/hyperbole/hpath.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/hyperbole/hpath.el	Mon Aug 13 09:02:59 2007 +0200
@@ -6,10 +6,19 @@
 ;; KEYWORDS:     comm, hypermedia, unix
 ;;
 ;; AUTHOR:       Bob Weiner
-;; ORG:          InfoDock Associates
+;; ORG:          Brown U.
 ;;
 ;; ORIG-DATE:     1-Nov-91 at 00:44:23
-;; LAST-MOD:     20-Mar-97 at 11:52:51 by Bob Weiner
+;; LAST-MOD:     10-Oct-95 at 23:31:56 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;; DESCRIP-END.
 
 ;;; ************************************************************************
 ;;; Public variables
@@ -17,7 +26,7 @@
 
 (defvar hpath:rfc "/anonymous@ds.internic.net:rfc/rfc%s.txt"
   "*String to be used in the call: (hpath:rfc rfc-num)
-to create an path to the RFC document for `rfc-num'.")
+to create an path to the RFC document for 'rfc-num'.")
 
 (defvar hpath:suffixes '(".gz" ".Z")
   "*List of filename suffixes to add or remove within (hpath:exists-p) calls.")
@@ -30,7 +39,7 @@
 ;;; ************************************************************************
 
 (defun hpath:absolute-to (path &optional default-dirs)
-  "Returns PATH as an absolute path relative to one directory from optional DEFAULT-DIRS or `default-directory'.
+  "Returns PATH as an absolute path relative to one directory from optional DEFAULT-DIRS or 'default-directory'.
 Returns PATH unchanged when it is not a valid path or when DEFAULT-DIRS
 is invalid.  DEFAULT-DIRS when non-nil may be a single directory or a list of
 directories.  The first one in which PATH is found is used."
@@ -54,7 +63,7 @@
 
 (defun hpath:ange-ftp-at-p ()
   "Returns an ange-ftp pathname that point is within or nil.
-See the `ange-ftp' or `efs' Elisp packages for pathname format details.
+See the 'ange-ftp' or 'efs' Elisp packages for pathname format details.
 Always returns nil if (hpath:ange-ftp-available-p) returns nil."
   (if (hpath:ange-ftp-available-p)
       (let ((user (hpath:ange-ftp-default-user))
@@ -65,23 +74,23 @@
 		(cond
 		  ((hpath:url-at-p)
 		   (if (string-equal
-			 (buffer-substring (match-beginning 2) (match-end 2))
+			 (buffer-substring (match-beginning 1) (match-end 1))
 			 "ftp")
 		       (concat
 			"/"
 			;; user
-			(if (match-beginning 3)
+			(if (match-beginning 2)
 			    (buffer-substring
-			     (match-beginning 3) (match-end 3))
+			     (match-beginning 2) (match-end 2))
 			  (concat user "@"))
 			;; domain
 			(hpath:delete-trailer
-			 (buffer-substring (match-beginning 4) (match-end 4)))
+			 (buffer-substring (match-beginning 3) (match-end 3)))
 			":"
 			;; path
-			(if (match-beginning 6)
-			    (buffer-substring (match-beginning 6)
-					      (match-end 6))))
+			(if (match-beginning 5)
+			    (buffer-substring (match-beginning 5)
+					      (match-end 5))))
 		     ;; else ignore this other type of WWW path
 		     ))
 		  ;; user, domain and path
@@ -111,7 +120,7 @@
 
 (defun hpath:ange-ftp-p (path)
   "Returns non-nil iff PATH is an ange-ftp pathname.
-See the `ange-ftp' or `efs' Elisp package for pathname format details.
+See the 'ange-ftp' or 'efs' Elisp package for pathname format details.
 Always returns nil if (hpath:ange-ftp-available-p) returns nil."
   (and (stringp path)
        (or (featurep 'ange-ftp) (featurep 'efs))
@@ -121,22 +130,22 @@
 	       (cond
 		 ((hpath:url-p path)
 		  (if (string-equal
-			(substring path (match-beginning 2) (match-end 2))
+			(substring path (match-beginning 1) (match-end 1))
 			"ftp")
 		      (concat
 			"/"
 			;; user
-			(if (match-beginning 3)
-			    (substring path (match-beginning 3) (match-end 3))
+			(if (match-beginning 2)
+			    (substring path (match-beginning 2) (match-end 2))
 			  (concat user "@"))
 			;; domain
 			(hpath:delete-trailer
-			 (substring path (match-beginning 4) (match-end 4)))
+			 (substring path (match-beginning 3) (match-end 3)))
 			":"
 			;; path
-			(if (match-beginning 6)
-			    (substring path (match-beginning 6)
-				       (match-end 6))))
+			(if (match-beginning 5)
+			    (substring path (match-beginning 5)
+				       (match-end 5))))
 		    ;; else ignore this other type of WWW path
 		    ))
 		 ;; user, domain and path
@@ -177,8 +186,8 @@
 If optional TYPE is the symbol 'file or 'directory, then only that path type is
 accepted as a match.  Only locally reachable paths are checked for existence.
 With optional NON-EXIST, nonexistent local paths are allowed.
-Absolute pathnames must begin with a `/' or `~'.  Relative pathnames
-must begin with a `./' or `../' to be recognized."
+Absolute pathnames must begin with a '/' or '~'.  Relative pathnames
+must begin with a './' or '../' to be recognized."
   (cond	(;; Local file URLs
 	 (hpath:is-p (hargs:delimited
 		      "file://localhost" "[ \t\n\^M\"\'\}]" nil t)))
@@ -191,40 +200,10 @@
 			 (hargs:delimited "@file{" "}"))
 		     type non-exist))))
 
-(defun hpath:display-buffer (buffer &optional display-where)
-  "Displays BUFFER at optional DISPLAY-WHERE location or at hpath:display-where.
-BUFFER may be a buffer or a buffer name.
-
-See documentation of `hpath:display-buffer-alist' for valid values of DISPLAY-WHERE.
-Returns non-nil iff buffer is actually displayed."
-  (interactive "bDisplay buffer: ")
-  (if (stringp buffer) (setq buffer (get-buffer buffer)))
-  (if (null buffer)
-      nil
-    (if (null display-where)
-	(setq display-where hpath:display-where))
-    (funcall (car (cdr (or (assq display-where
-				 hpath:display-buffer-alist)
-			   (assq 'other-window
-				 hpath:display-buffer-alist))))
-	     buffer)
-    t))
-
-(defun hpath:display-buffer-other-frame (buffer)
-  "Displays BUFFER, in another frame.
-May create a new frame, or reuse an existing one.
-See documentation of `hpath:display-buffer' for details.
-Returns the dispalyed buffer."
-  (interactive "bDisplay buffer in other frame: ")
-  (if (= (length (frame-list)) 1)
-      (select-frame (make-frame))
-    (other-frame 1))
-  (if (br-in-browser)
-      (br-to-view-window))
-  (switch-to-buffer buffer))
-
-(defun hpath:find (filename &optional display-where)
-  "Edits file FILENAME using user customizable settings of display program and location.
+(defun hpath:find (filename &optional other-window-p)
+  "Edit file FILENAME using program from hpath:find-alist if available.
+Otherwise, switch to a buffer visiting file FILENAME, creating one if none
+already exists.
 
 FILENAME may start with a special prefix character which is
 handled as follows:
@@ -232,14 +211,7 @@
   &filename  - execute as a windowed program;
   -filename  - load as an Emacs Lisp program.
 
-Otherwise, if FILENAME matches a regular expression in the variable
-`hpath:find-alist,' the associated external display program is invoked.
-If not, `hpath:display-alist' is consulted for a specialized internal
-display function to use.  If no matches are found there,
-`hpath:display-where-alist' is consulted using the optional argument,
-DISPLAY-WHERE (a symbol) or if that is nil, the value of
-`hpath:display-where', and the matching display function is used.
-Returns non-nil iff file is displayed within a buffer (not with an external
+Return non-nil iff file is displayed within a buffer (not with an external
 program)."
   (interactive "FFind file: ")
   (let (modifier)
@@ -260,62 +232,25 @@
 		      nil)
 		     ((hypb:functionp find-program)
 		      (funcall find-program filename)
-		      t)
+		      nil)
 		     (t (setq filename (hpath:validate filename))
-			(if (null display-where)
-			    (setq display-where hpath:display-where))
-			(funcall (car (cdr (or (assq display-where
-						     hpath:display-where-alist)
-					       (assq 'other-window
-						     hpath:display-where-alist))))
-				 filename)
+			(funcall (if (and other-window-p
+					  (not (br-in-browser)))
+				     'switch-to-buffer-other-window
+				   'switch-to-buffer)
+				 (find-file-noselect filename))
 			t)))))))
 
-(defun hpath:find-line (filename line-num &optional display-where)
-  "Edits file FILENAME with point placed at LINE-NUM.
+(defun hpath:find-other-window (filename)
+  "Edit file FILENAME, in another window or using program from hpath:find-alist.
+May create a new window, or reuse an existing one; see the function display-buffer.
 
-`hpath:display-where-alist' is consulted using the optional argument,
-DISPLAY-WHERE (a symbol) or if that is nil, the value of
-`hpath:display-where', and the matching display function is used to determine
-where to display the file, e.g. in another frame.
-Always returns t."
-  (interactive "FFind file: ")
-  ;; Just delete any special characters preceding the filename, ignoring them.
-  (if (string-match hpath:prefix-regexp filename)
-      (setq filename (substring filename (match-end 0))))
-  (setq filename (hpath:substitute-value filename)
-	filename (hpath:validate filename))
-  (if (null display-where)
-      (setq display-where hpath:display-where))
-  (funcall (car (cdr (or (assq display-where
-			       hpath:display-where-alist)
-			 (assq 'other-window
-			       hpath:display-where-alist))))
-	   filename)
-  (if (integerp line-num)
-      (progn (widen) (goto-line line-num)))
-  t)
+Alternatively, FILENAME may start with a prefix character to indicate special
+handling.  See documentation of `hpath:find' for details.
 
-(defun hpath:find-other-frame (filename)
-  "Edits file FILENAME, in another frame.
-May create a new frame, or reuse an existing one.
-See documentation of `hpath:find' for details.
-Returns the buffer of displayed file."
-  (interactive "FFind file in other frame: ")
-  (if (= (length (frame-list)) 1)
-      (select-frame (make-frame))
-    (other-frame 1))
-  (if (br-in-browser)
-      (br-to-view-window))
-  (find-file filename))
-
-(defun hpath:find-other-window (filename)
-  "Edits file FILENAME, in another window or using an external program.
-May create a new window, or reuse an existing one; see the function display-buffer.
-See documentation of `hpath:find' for details.
-Returns non-nil iff file is displayed within a buffer."
+Return non-nil iff file is displayed within a buffer."
   (interactive "FFind file in other window: ")
-  (hpath:find filename 'other-window))
+  (hpath:find filename t))
 
 (defun hpath:is-p (path &optional type non-exist)
   "Returns PATH if PATH is a Unix path, else nil.
@@ -340,7 +275,7 @@
 	 (if (string-match hpath:prefix-regexp path)
 	     (setq path (substring path (match-end 0)))
 	   t)
-	 (not (or (string-equal path "")
+	 (not (or (string= path "")
 		  (string-match "\\`\\s \\|\\s \\'" path)))
 	 ;; Convert tabs and newlines to space.
 	 (setq path (hbut:key-to-label (hbut:label-to-key path)))
@@ -375,23 +310,19 @@
 			     (file-directory-p path))
 			    (t)))
 		     )
-	       (progn
-		 ;; Quote any but last %s within rtn-path.
-		 (setq rtn-path (hypb:replace-match-string "%s" rtn-path "%%s")
-		       rtn-path (hypb:replace-match-string "%%s\\'" rtn-path "%s"))
-		 ;; Return path if non-nil return value.
-		 (if (stringp suffix);; suffix could = t, which we ignore
-		     (if (string-match
-			  (concat (regexp-quote suffix) "%s") rtn-path)
-			 ;; remove suffix
-			 (concat (substring rtn-path 0 (match-beginning 0))
-				 (substring rtn-path (match-end 0)))
-		       ;; add suffix
-		       (format rtn-path suffix))
-		   (format rtn-path ""))))))))
+	       ;; Return path if non-nil return value
+	       (if (stringp suffix) ;; suffix could = t, which we ignore
+		   (if (string-match
+			(concat (regexp-quote suffix) "%s") rtn-path)
+		       ;; remove suffix
+		       (concat (substring rtn-path 0 (match-beginning 0))
+			       (substring rtn-path (match-end 0)))
+		     ;; add suffix
+		     (format rtn-path suffix))
+		 (format rtn-path "")))))))
 
 (defun hpath:relative-to (path &optional default-dir)
-  "Returns PATH relative to optional DEFAULT-DIR or `default-directory'.
+  "Returns PATH relative to optional DEFAULT-DIR or 'default-directory'.
 Returns PATH unchanged when it is not a valid path."
   (if (not (and (stringp path) (hpath:is-p path)))
       path
@@ -418,7 +349,7 @@
 
 (defun hpath:rfc (rfc-num)
   "Return pathname to textual rfc document indexed by RFC-NUM.
-See the documentation of the `hpath:rfc' variable."
+See the documentation of the 'hpath:rfc' variable."
   (format hpath:rfc rfc-num))
 
 (defun hpath:substitute-value (path)
@@ -443,7 +374,7 @@
       t)))
 
 (defun hpath:substitute-var (path)
-  "Replaces up to one match in PATH with first matching variable from `hpath:variables'."
+  "Replaces up to one match in PATH with first matching variable from 'hpath:variables'."
   (if (not (and (stringp path) (string-match "/" path) (hpath:is-p path)))
       path
     (setq path (hpath:symlink-referent path))
@@ -465,7 +396,7 @@
 				    (hpath:substitute-var-name var (car val) path))
 				(setq new-path result))
 			    (setq val (cdr val))))
-			 (t (error "(hpath:substitute-var): `%s' has invalid value for hpath:variables" var))))))
+			 (t (error "(hpath:substitute-var): '%s' has invalid value for hpath:variables" var))))))
       (or new-path path)
       )))
 
@@ -476,9 +407,9 @@
 ;; /usr/local -> $(SERVER_LOCAL)/usr/local, /usr/bin ->
 ;; ../$(SYSTYPE)/usr/bin and /tmp -> `node_data/tmp.  It also handles
 ;; relative links properly as in /usr/local/emacs -> gnu/emacs which must
-;; be resolved relative to the `/usr/local' directory.
-;; It will fail on Apollos if the `../' notation is used to move just
-;; above the `/' directory level.  This is fairly uncommon and so the
+;; be resolved relative to the '/usr/local' directory.
+;; It will fail on Apollos if the '../' notation is used to move just
+;; above the '/' directory level.  This is fairly uncommon and so the
 ;; problem has not been fixed.
 ;;
 (defun hpath:symlink-referent (linkname)
@@ -547,37 +478,35 @@
   "Return world-wide-web universal resource locator (url) that point immediately precedes or nil.
 Use buffer-substring with match-beginning and match-end on the following
 groupings:
-  1 = optional `URL:' literal
-  2 = access protocol
-  4 = optional username
-  4 = host and domain to connect to
-  5 = optional port number to use
-  6 = optional pathname to access."
-  ;; WWW URL format:  [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>]
-  ;;             or   [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>]
+  1 = access protocol
+  2 = optional username
+  3 = host and domain to connect to
+  4 = optional port number to use
+  5 = pathname to access."
+  ;; WWW URL format:  <protocol>:/[<user>@]<domain>[:<port>]/<path>
+  ;;             or   <protocol>://[<user>@]<domain>[:<port>]<path>
   ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or
   ;; Windows.
-  (if (looking-at "\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?")
+  (if (looking-at "\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?")
       (save-excursion
 	(goto-char (match-end 0))
-	(skip-chars-backward ".,?#!*()")
-	(buffer-substring (match-beginning 2) (point)))))
+	(skip-chars-backward ".?#!*()")
+	(buffer-substring (match-beginning 0) (point)))))
 
 (defun hpath:url-p (obj)
   "Return t if OBJ is a world-wide-web universal resource locator (url) string, else nil.
 Use string-match with match-beginning and match-end on the following groupings:
-  1 = optional `URL:' literal
-  2 = access protocol
-  3 = optional username
-  4 = host and domain to connect to
-  5 = optional port number to use
-  6 = optional pathname to access."
-  ;; WWW URL format:  [URL:]<protocol>:/[<user>@]<domain>[:<port>][/<path>]
-  ;;             or   [URL:]<protocol>://[<user>@]<domain>[:<port>][<path>]
+  1 = access protocol
+  2 = optional username
+  3 = host and domain to connect to
+  4 = optional port number to use
+  5 = pathname to access."
+  ;; WWW URL format:  <protocol>:/[<user>@]<domain>[:<port>]/<path>
+  ;;             or   <protocol>://[<user>@]<domain>[:<port>]<path>
   ;; Avoid [a-z]:/path patterns since these may be disk paths on OS/2, DOS or
   ;; Windows.
   (and (stringp obj)
-       (string-match "\\`<?\\(URL:\\)?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?>?\\'"
+       (string-match "\\`<?\\([a-zA-Z][a-zA-Z]+\\)://?\\([^@/: \t\n\^M]+@\\)?\\([^/:@ \t\n\^M\"`']+\\)\\(:[0-9]+\\)?\\([/~][^]@ \t\n\^M\"`'\)\}>]*\\)?>?\\'"
 		     obj)
        t))
 
@@ -590,8 +519,8 @@
     (cond ((not include-start-and-end-p)
 	   (hpath:url-at-p))
 	  ((hpath:url-at-p)
-	   (list (buffer-substring (match-beginning 2) (match-end 0))
-		 (match-beginning 2)
+	   (list (buffer-substring (match-beginning 0) (match-end 0))
+		 (match-beginning 0)
 		 (match-end 0))))))
 
 (defun hpath:www-p (path)
@@ -605,7 +534,7 @@
 (defun hpath:ange-ftp-available-p ()
   "Return t if the ange-ftp or efs package is available, nil otherwise.
 Either the package must have been loaded already or under versions of Emacs
-19, it must be set for autoloading via `file-name-handler-alist'."
+19, it must be set for autoloading via 'file-name-handler-alist'."
   (or (featurep 'ange-ftp) (featurep 'efs)
       (and (boundp 'file-name-handler-alist) ; v19
 	   (or (rassq 'ange-ftp-hook-function file-name-handler-alist)
@@ -666,7 +595,7 @@
 (defun hpath:find-program (filename)
   "Return shell or Lisp command to execute to display FILENAME or nil.
 Return nil if FILENAME is a directory name.
-See also documentation for `hpath:find-alist' and `hpath:display-alist'."
+See also documentation for 'hpath:find-alist' and 'hpath:display-alist'."
   (let ((cmd))
     (cond ((and (stringp filename) (file-directory-p filename))
 	   nil)
@@ -710,7 +639,7 @@
 local pathname is returned."
   (let (sym val)
     (cond ((not (stringp var-name))
-	   (error "(hpath:substitute-dir): VAR-NAME arg, `%s', must be a string" var-name))
+	   (error "(hpath:substitute-dir): VAR-NAME arg, '%s', must be a string" var-name))
 	  ((not (and (setq sym (intern-soft var-name))
 		     (boundp sym)))
 	   (error "(hpath:substitute-dir): VAR-NAME arg, \"%s\", is not a bound variable"