file-registry.el

;; LCD Archive Entry (LCD maintainers, you're welcome to it!):
;; file-registry|Ken Manheimer|klm@python.org
;; |Commands to register and access commonly used files.
;; | 7-May-1993|$Id$||

;; Copyright (C) 1993-2011 Free Software Foundation, Inc.
;; Author: Ken Manheimer, klm@python.org, ken.manheimer@gmail.com

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:
;;
;; From the docstrings for the salient functions - see the full docstrings
;; in the functions, themselves.
;;
;; register-file:
;;   Add file to registry for use by 'pop-to-registered-file', or
;;   replace existing entry for same file-name.  Non-directory (tail) of
;;   file-name is used as reference handle, unless optional arg NAME is
;;   specified, in which case it is used as reference name, instead.
;; pop-to-registered-file:
;;   Like pop-to-buffer, but instead of a buffer-name, solicited NAME is
;;   resolved to a file associated with it in a registry. (The registry is
;;   manipulated via the 'register-file' function.)



(provide 'file-registry)

(defvar file-registry '(())
  "Assoc list of files for use by 'pop-to-registered-file'.
Use 'register-file' to add entries.")

(defun register-file (file-name &optional name delay)

  "Add file to registry for use by 'pop-to-registered-file', or
replace existing entry for same file-name.  Non-directory (tail) of
file-name is used as reference handle, unless optional arg NAME is
specified, in which case it is used as reference name, instead.

Second optional arg DELAY says just to accept the name, don't
poke around in order to expand the file "

  (cond ((not file-name)
         (error "non-nil file name required"))
        (delay t)
        (t (setq file-name (expand-file-name file-name))
           (if (not name) (setq name (file-name-nondirectory file-name)))))

  (let ((entry (assoc name file-registry)))
    (if entry
	(setcdr entry (list file-name))
      (setq file-registry (cons (list name file-name) file-registry))))

  file-registry)

(defun get-regfile (name)
  "Concise programmatic interface to reference registered files by name."
  (car (cdr (reference-registered-file name))))

(defun reference-registered-file (&optional name name-prompt must-exist)

  "Obtain the file-name entry registered for the optional NAME
argument.  Entries are returned as two strings, the entry name first,
and associated file name second.

If NAME is not specified (or it is nil) then the function solicits a
name with a completing read, using the optional prompt PROMPT if
specified, or a default one otherwise.

As long as third optional argument, MUST-EXIST, is unset, then
reference to unregistered files (ie, unregistered implicit or explicit
NAME) will result in the function soliciting the path to use, and the
name-file association is added to the file registry.  Non-null
MUST-EXIST causes reference to non-registered names to return nil."

  (let* ((entry
          (assoc
	   (or name
	       (setq name
		     (completing-read (or name-prompt "Registered file name: ")
				      file-registry
				      nil
				      must-exist)))
	   file-registry))
	 file-name)
    (cond (entry entry)
	  (must-exist nil)
	  ((register-file
	    (expand-file-name
	     (read-file-name (format "Path to register for %s: " name)))
	    name)))))

(defun pop-to-registered-file (&optional name)

  "Like pop-to-buffer, but instead of a buffer-name, solicited NAME is
resolved to a file associated with it in a registry. (The registry is
manipulated via the 'register-file' function.)

If the name resolves to a directory, then the user is offered a
regular find-file completion on that directory.

With universal argument, a new frame is used, if this emacs
version supports it.  Otherwise, a repeat-count causes the
current window \(rather than an alternate one) to be used.

If the NAME is not already registered then the function solicits the
path for a file to use, and the name-file association is added to the
file registry.

The entry's file name component is returned."

  ;; Can't use implicit 'interactive' mechanisms for either the
  ;; prefix-arg or the name prompt, 'cause they don't provide for the
  ;; peculiar completion of the name prompt which we require.
  (interactive)
  (let* ((name name)
	 arg				; deprecated - should rectify
	 (entry (reference-registered-file
		 name "Pop to registered file named: " t))
	 (key (car entry))
	 (file-name (car (cdr entry)))
	 (exists (file-exists-p file-name))
	 is-dir
	 (func (if arg (if (fboundp 'pop-to-buffer-frame)
			   'pop-to-buffer-frame
			 'switch-to-buffer)
		 'pop-to-buffer)))

    (if (not exists)
	(setq file-name
	      (read-file-name (format "Complete file name (ref %s): " key)
			      file-name
			      file-name)))

    (setq is-dir (and exists (file-directory-p file-name)))

    (if is-dir
	(setq file-name
	      (read-file-name (format "Pop to file (ref %s): " key)
			      (concat file-name "/")
			      file-name)))
    (message "'%s' %s> %s"
	     key
	     (if (string= (car entry) file-name) "==" "~~")
	     (if (fboundp 'abbreviate-file-name)
		 (abbreviate-file-name file-name)
	       file-name))
    (apply func (list (find-file-noselect file-name)))
    (if (not is-dir)			; Repeat the message to force update:
	(message "'%s' %s> %s"
		 key
		 (if exists "==" "+~")
                 (if (fboundp 'abbreviate-file-name)
                     (abbreviate-file-name file-name)
                   file-name)))
    file-name))
(defun pop-to-registered-file-other-frame ()
  "Like pop-to-registered-file, but in new frame."
  (interactive)
  (pop-to-registered-file 4))

(defun insert-registered-file-name (&optional arg)

  "Like pop-to-registered-file, but instead just inserts resolved file
name at point.  With optional repeat-count, directory names are
accepted, otherwise users are further solicited for file names within
resolved directories, and the entire resulting path is inserted.

If the NAME is not already registered then the function solicits the
path for a file to use, and the name-file association is added to the
file registry.

The entry's file name component is returned."

  ;; Can't use implicit 'interactive' mechanisms for either the
  ;; prefix-arg or the name prompt, 'cause they don't provide for the
  ;; peculiar completion of the name prompt which we require.
  (interactive "P")
  (let* (name
	 (entry (reference-registered-file
		 name "Registered file key: " t))
	 (key (car entry))
	 (file-name (car (cdr entry))))

    (if (and (not arg) (file-directory-p file-name))
	(setq file-name
	      (read-file-name (format "Registered file key (ref %s): " key)
			      (if (string-match "/$" file-name)
				  file-name
				(concat file-name "/")))))
    (insert file-name)
    file-name))