;; ======================================================================== ;; lib-complete.el -- Completion etc. for libraries ;; Author : Mike Williams ;; Created On : Sat Apr 20 17:47:21 1991 ;; Last Modified By: Mike Williams ;; Last Modified On: Mon May 27 16:14:26 1991 ;; RCS Info : $Revision: 1.0 $ $Locker: $ ;; ======================================================================== ;; NOTE: this file must be recompiled if changed. ;; ;; Copyright (C) Mike Williams 1991 ;; ;; This file is not part of GNU Emacs, but is made available under the ;; same conditions. ;; ;; 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. (provide 'lib-complete) ;;=== Usage =============================================================== ;; ;; (fmakunbound 'load-library) ;; (autoload 'load-library "lib-complete" nil t) ;; (autoload 'locate-file "lib-complete" nil t) ;; (autoload 'library-all-completions "lib-complete") ;; (autoload 'read-library "lib-complete") ;;=== Locate a file in a search path ====================================== (defun locate-file (FILE SEARCH-PATH &optional SUFFIX-LIST) "Search for FILE on SEARCH-PATH (list). If optional SUFFIX-LIST is provided, allow file to be followed by one of the suffixes." (if (not SUFFIX-LIST) (setq SUFFIX-LIST '(""))) (if (file-name-absolute-p FILE) (setq SEARCH-PATH '(nil))) (if (equal FILE "") (error "Empty filename")) (let ((filelist (mapcar '(lambda (ext) (concat FILE ext)) SUFFIX-LIST))) ;; Search SEARCH-PATH for a readable file in filelist (catch 'found (while SEARCH-PATH (let ((filelist filelist)) (while filelist (let ((filepath (expand-file-name (car filelist) (car SEARCH-PATH)))) (if (file-readable-p filepath) (throw 'found filepath))) (setq filelist (cdr filelist)))) (setq SEARCH-PATH (cdr SEARCH-PATH)))) )) ;;=== Determine completions for filename in search path =================== (defun library-all-completions (FILE SEARCH-PATH &optional FULL) "Return all completions for FILE in any directory on SEARCH-PATH. If optional third argument FULL is non-nil, returned pathnames should be absolute rather than relative to some directory on the SEARCH-PATH." (setq SEARCH-PATH (mapcar '(lambda (dir) (if dir (file-name-as-directory dir) default-directory)) SEARCH-PATH)) (if (file-name-absolute-p FILE) ;; It's an absolute file name, so don't need SEARCH-PATH (progn (setq FILE (expand-file-name FILE)) (file-name-all-completions (file-name-nondirectory FILE) (file-name-directory FILE))) (let ((subdir (file-name-directory FILE)) (file (file-name-nondirectory FILE)) file-lists) ;; Append subdirectory part to each element of SEARCH-PATH (if subdir (setq SEARCH-PATH (mapcar '(lambda (dir) (concat dir subdir)) SEARCH-PATH) FILE )) ;; Make list of completions in each directory on SEARCH-PATH (while SEARCH-PATH (let* ((dir (car SEARCH-PATH)) (subdir (if FULL dir subdir))) (if (file-directory-p dir) (progn (setq file-lists (cons (mapcar '(lambda (file) (concat subdir file)) (file-name-all-completions file (car SEARCH-PATH))) file-lists)))) (setq SEARCH-PATH (cdr SEARCH-PATH)))) ;; Compress out duplicates while building complete list (slloooow!) (let ((sorted (sort (apply 'nconc file-lists) '(lambda (x y) (not (string-lessp x y))))) compressed) (while sorted (if (equal (car sorted) (car compressed)) nil (setq compressed (cons (car sorted) compressed))) (setq sorted (cdr sorted))) compressed)))) ;;=== Read a filename, with completion in a search path =================== (defvar read-library-internal-cache nil "Used within read-library and read-library-internal to prevent costly repeated calls to library-all-completions. Format is a cons-cell (cons ).") (defun read-library-internal (FILE PRED FLAG) "Don't call this." ;; Relies on read-library-internal-search-path being let-bound (let (completion-table) (if (and read-library-internal-cache (equal (file-name-directory FILE) (file-name-directory (car read-library-internal-cache))) (string-match (concat "^" (regexp-quote (car read-library-internal-cache))) FILE)) (setq completion-table (cdr read-library-internal-cache)) (setq completion-table (mapcar 'list (library-all-completions FILE read-library-internal-search-path))) (setq read-library-internal-cache (cons FILE completion-table))) (cond ((not completion-table) nil) ((eq FLAG nil) (try-completion FILE completion-table PRED)) ((eq FLAG t) (all-completions FILE completion-table PRED)) ((eq FLAG 'lambda) (eq (try-completion FILE completion-table PRED) t)) ))) (defun read-library (PROMPT SEARCH-PATH &optional DEFAULT MUST-MATCH FULL PRED) "Read library name, prompting with PROMPT and completing in directories from SEARCH-PATH. A nil in the search path represents the current directory. Default to DEFAULT if user enters a null string. Optional fourth arg MUST-MATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. Optional fifth argument FULL non-nil causes a full pathname, rather than a relative pathname, to be returned. Note that FULL implies MUST-MATCH. Optional sixth argument PRED further restricts the completion." (let* ((read-library-internal-search-path SEARCH-PATH) (read-library-internal-cache nil) (library (completing-read PROMPT 'read-library-internal PRED (or MUST-MATCH FULL) nil))) (cond ((equal library "") DEFAULT) (FULL (locate-file library SEARCH-PATH)) (t library)))) ;; NOTE: as a special case, read-library may be used to read a filename ;; relative to the current directory, returning a *relative* pathname ;; (read-file-name returns a full pathname). ;; ;; eg. (read-library "Local header: " '(nil) nil) ;;=== Replacement for load-library with completion ======================== (defun load-library (LIBRARY) "Load the library named LIBRARY." (interactive (list (locate-file (read-library "Load Library: " load-path nil) load-path '("" ".el" ".elc")))) (load LIBRARY))