fff-install-map
locateupdatedb
(defvar fff-locate-program "locate"
"*Name of program to invoke which reads the `locate' database.
This variable is used by the function `fff-locate-files-in-locate-db'.")
(defvar fff-locate-program-args nil
"*Additional args to the program which searches the `locate' database.
This variable is used by the function `fff-locate-files-in-locate-db'.")
(defvar fff-match-predicate 'fff-file-nondirectory-p
"*Default matching predicate for commands in this package.
If `nil', no predicate is used; all files match.
This variable only used by interactive commands defined in this package.
Utility functions in this package which take a predicate argument do not
refer to this variable for a default; if no predicate is specified, none is
used and all files match.")
(defvar fff-sorting-predicate nil
"*Predicate used to sort file names in display menu.
If `nil', no predicate is used; files are presented in the order listed.
This is used by `fff-display-matches'.")
(defvar fff-emacs-lisp-def-regexp
"^(\\bdef\\w+\\s-+'?%s\\s-"
"The regexp used to find symbol definitions in an emacs lisp source file.
This regexp must contain a `%s' where the symbol name is to be inserted in
the template.")
(defvar fff-map-prefix "\C-c\C-f"
"*Default prefix on which keybindings will go.
If you change this at runtime, you will need to re-invoke `fff-install-map'.")
(defvar fff-map nil
"*Keymap for FFF commands.
Type ``\\[fff-command-prefix] \\<fff-map>\\[describe-prefix-bindings]'' \
for a list of bindings.")
(defsubst fff-length1-p (l)
(and (consp l)
(not (consp (cdr l)))))
(defconst fff-default-obarray-size 29)
(defun fff-find-emacs-lisp-library (lib &optional allp)
"Visit the first emacs lisp source file named LIB.
The variable `load-path' is searched for candidates.
If load-history is supported and no matches are found in load-path but a
lisp file was loaded by that name previously, then visit that file instead.
If called interactively with a prefix argument and there is more than one
possible match, a list is displayed. If called from a program and there is
more than one match, an error is signalled.
If no matches are found, an error is signalled.
If called interactively, you may attempt to complete a name in the
minibuffer if that library has previously been loaded."
(interactive (list (completing-read "Find library (fff emacs-lisp): "
'fff-complete-emacs-lisp-library)
current-prefix-arg))
(fff-<op>-emacs-lisp-library lib allp fff-match-predicate
'find-file (interactive-p)))
(defun fff-insert-emacs-lisp-library (lib &optional allp)
"Insert the emacs lisp source file named LIB in the current buffer.
This function behaves exactly like `fff-find-emacs-lisp-library', except
that the contents of the library file is inserted in the current buffer
instead of being visited in another buffer."
(interactive (list (completing-read "Insert library (fff emacs-lisp): "
'fff-complete-emacs-lisp-library)
current-prefix-arg))
(fff-<op>-emacs-lisp-library lib allp fff-match-predicate
'insert-file (interactive-p)))
(defun fff-<op>-emacs-lisp-library (lib &optional allp pred op interactivep)
(let ((file (fff-locate-emacs-lisp-library lib allp pred '(".el" ""))))
(cond ((fff-length1-p file)
(message "%s" (car file))
(funcall op (car file)))
((null file)
(setq file
(cond ((fff-locate-loaded-emacs-lisp-library lib))
((and (stringp lib)
(setq lib (intern-soft lib)))
(fff-locate-loaded-emacs-lisp-library lib))))
(cond ((stringp file)
(setq file
(or (fff-emacs-lisp-bytecode-source-file-name file)
file))
(funcall op file)
(message "Library %s not found in load-path, %s"
lib "but found in load-history."))
(t
(signal 'file-error
(list (format "Library %s not found in load-path"
lib))))))
(t
(if interactivep
(fff-display-matches lib file op)
(signal 'file-error
(list (format "Multiple instances of %s in load-path" lib)
file)))))))
(defun fff-locate-emacs-lisp-library (lib &optional allp pred suffixes)
"Return a list of all files named LIB in the Emacs Lisp load-path.
If called interactively, display the name of the first file found. When
calling from a program, this is the same as setting the second argument
ALLP `nil'.
If called interactively with a prefix argument, display the names of those
files in a temporary buffer.
Optional third argument PREDICATE can be an arbitrary function of one
argument \(e.g. 'file-readable-p\), which should return non-`nil' if a file
name candidate should be returned.
If called from a program, the optional fourth argument SUFFIXES may
provide a list of suffixes to try before trying the literal LIB name,
e.g. '\(\".elc\" \".el\" \"\"\). If not provided, no suffixes are tried."
(interactive (list (completing-read "Locate library (fff emacs-lisp): "
'fff-complete-emacs-lisp-library)
current-prefix-arg
nil
'("" ".el" ".elc")))
(let* ((names (if suffixes
(fff-suffix lib suffixes)
(list lib)))
(matches (fff-files-in-directory-list names load-path
(not allp) pred)))
(and (interactive-p)
(cond ((null matches)
(message "%s not found in load-path" lib))
((and (fff-length1-p matches)
(> (window-width (minibuffer-window))
(length (car matches))))
(message "%s" (car matches)))
(t
(fff-display-matches lib matches))))
matches))
(defun fff-find-loaded-emacs-lisp-function (fnsym)
"Visit the file which contains the currently-loaded definition of FUNCTION.
Point is positioned at the beginning of the definition if it can be
located.
If the definition was loaded from a byte-compiled file, an attempt is made
to locate the corresponding source file.
First, look for the source file mentioned in the bytecode comment headers.
Next, try looking for the source file in the same directory as the bytecode.
Next, search for the first analogously-name source file in load-path.
This command only works in those versions of Emacs/XEmacs which have the
`load-history' variable."
(interactive "aFind function (fff emacs-lisp): ")
(and (subrp (symbol-function fnsym))
(error "%s is a primitive function" fnsym))
(let* ((data (fff-load-history-elt-by 'symbol fnsym))
(name (fff-load-history-file-name data))
(srcname nil)
(altname nil))
(and name
(not (file-name-absolute-p name))
(setq name (car (fff-locate-emacs-lisp-library name t))))
(cond (name
(setq srcname (fff-emacs-lisp-bytecode-source-file-name name))
(save-match-data
(cond ((and srcname
(file-exists-p srcname))
(find-file srcname)
(and (file-newer-than-file-p srcname name)
(message "Warning: source file newer than %s"
"byte-compiled file")))
((string-match "[^/]+\\.elc" name)
(setq altname (substring name 0 -1))
(or (file-exists-p altname)
(setq altname
(car (fff-locate-emacs-lisp-library
(substring name (match-beginning 0) -1)))))
(cond ((and altname
(file-exists-p altname))
(find-file altname)
(message "Warning: source file may not %s"
"correspond to byte-compiled file"))
(t (find-file name))))
(t (find-file name))))
(fff-emacs-lisp-goto-definition fnsym))
(t
(error "%s not defined in any currently-loaded file" fnsym)))))
(defun fff-emacs-lisp-goto-definition (fnsym)
(save-match-data
(let ((p (point))
(re (format fff-emacs-lisp-def-regexp fnsym))
(syntable (syntax-table)))
(set-syntax-table emacs-lisp-mode-syntax-table)
(goto-char (point-min))
(if (prog1
(re-search-forward re nil t)
(set-syntax-table syntable))
(beginning-of-line)
(goto-char p)
(error "Cannot find definition of %s" fnsym)))))
library(defun fff-locate-loaded-emacs-lisp-library (lib)
(cond ((and (boundp 'load-history)
load-history)
(let (data)
(and (symbolp lib)
(featurep lib)
(setq data (fff-load-history-elt-by 'feature lib)))
(cond ((null data)
(and (symbolp lib)
(setq lib (symbol-name lib)))
(setq data (fff-load-history-elt-by 'name lib))))
(and data
(fff-load-history-file-name data))))))
(defun fff-load-history-elt-by (method key)
(let ((found nil)
(hist load-history)
(cell (cons 'provide key)))
(while hist
(if (cond ((eq method 'feature)
(member cell (car hist)))
((eq method 'symbol)
(memq key (car hist)))
((eq method 'name)
(let ((elt (car (car hist))))
(or (string= key elt)
(string= key (setq elt (file-name-nondirectory elt)))
(string= key (file-name-sans-extension elt))))))
(setq found (car hist)
hist nil)
(setq hist (cdr hist))))
found))
(defun fff-load-history-file-name (data)
(and data
(let* ((dir (file-name-directory (car data)))
(name (file-name-nondirectory (car data)))
(names (fff-suffix name '("" ".el" ".elc"))))
(cond ((null dir)
(car (fff-files-in-directory-list names load-path t)))
((file-exists-p name)
name)
(t
(car (fff-files-in-directory-list names (list dir) t)))))))
(defun fff-emacs-lisp-bytecode-source-file-name (elcfile)
(let ((buf (generate-new-buffer " *emacs lisp bytecode*"))
(magic ";ELC")
(source-name nil)
(size 1024)
data)
(unwind-protect
(save-excursion
(set-buffer buf)
(buffer-disable-undo buf)
(emacs-lisp-mode)
(setq data (fff-insert-file-contents-next-region elcfile size))
(save-match-data
(cond ((< data (length magic)))
((string= (buffer-substring 1 (1+ (length magic))) magic)
(let ((case-fold-search t)
(re "^;+\\s-+from\\s-+file\\s-+\\(.*\\)\n"))
(while (and (> data 0)
(null source-name))
(beginning-of-line)
(if (re-search-forward re nil t)
(setq source-name
(buffer-substring (match-beginning 1)
(match-end 1)))
(setq data (fff-insert-file-contents-next-region
elcfile size)))))))))
(kill-buffer buf))
source-name))
(defun fff-insert-file-contents-next-region (file size)
(let* ((point (point))
(beg (buffer-size))
(end (+ beg size))
(inserted 0))
(goto-char (point-max))
(setq inserted (nth 1 (insert-file-contents file nil beg end)))
(goto-char point)
inserted))
(defun fff-find-file-in-exec-path (file &optional allp)
"Visit the first file named FILE in `exec-path'.
If called interactively with a prefix argument and there is more than one
possible match, a list is displayed. If called from a program and there is
more than one match, an error is signalled.
If no matches are found, an error is signalled."
(interactive (list (read-string "Find file (fff exec-path): ")
current-prefix-arg))
(fff-<op>-file-in-path file 'exec-path allp fff-match-predicate
'find-file (interactive-p)))
(defun fff-insert-file-in-exec-path (file &optional allp)
"Insert the file named FILE found in `exec-path' into current buffer.
This function behaves exactly like `fff-find-file-in-exec-path', except
that the contents of the file is inserted in the current buffer instead of
being visited in another buffer."
(interactive (list (read-string "Insert file (fff exec-path): ")
current-prefix-arg))
(fff-<op>-file-in-path file 'exec-path allp fff-match-predicate
'insert-file (interactive-p)))
(defun fff-find-file-in-envvar-path (file envvar &optional allp)
"Visit the file named FILE in path specified by ENVIRONMENT variable.
If called interactively with a prefix argument and there is more than one
possible match, a list is displayed. If called from a program and there is
more than one match, an error is signalled.
If no matches are found, an error is signalled."
(interactive (list (read-string "Find file (fff envvar): ")
(completing-read "In path (env var): "
'fff-complete-envvar)
current-prefix-arg))
(fff-<op>-file-in-path file (getenv envvar) allp fff-match-predicate
'find-file (interactive-p)))
(defun fff-insert-file-in-envvar-path (file envvar &optional allp)
"Insert the file named FILE found in ENVVAR path into current buffer.
This function behaves exactly like `fff-find-file-in-envvar-path', except
that the contents of the file is inserted in the current buffer instead of
being visited in another buffer."
(interactive (list (read-string "Insert file (fff envvar): ")
(completing-read "In path (env var): "
'fff-complete-envvar)
current-prefix-arg))
(fff-<op>-file-in-path file (getenv envvar) allp fff-match-predicate
'insert-file (interactive-p)))
(defun fff-find-file-in-path (file path &optional allp)
"Visit the file named FILE in PATH.
PATH may be a list of directory names,
a string consisting of colon-separated directory names,
or a symbol name whose value is one of the above.
If called interactively with a prefix argument and there is more than one
possible match, a list is displayed. If called from a program and there is
more than one match, an error is signalled.
If no matches are found, an error is signalled."
(interactive (list (read-string "Find file (fff path): ")
(fff-read-eval-sexp "In path (sexp): ")
current-prefix-arg))
(fff-<op>-file-in-path file path allp fff-match-predicate
'find-file (interactive-p)))
(defun fff-insert-file-in-path (file path &optional allp)
"Insert the file named FILE found in PATH into current buffer.
This function behaves exactly like `fff-find-file-in-path', except that the
contents of the file is inserted in the current buffer instead of being
visited in another buffer."
(interactive (list (read-string "Insert file (fff path): ")
(fff-read-eval-sexp "In path (sexp): ")
current-prefix-arg))
(fff-<op>-file-in-path file path allp fff-match-predicate
'insert-file (interactive-p)))
(defun fff-<op>-file-in-path (file path allp pred op interactivep)
(let* ((realpath (cond ((symbolp path)
(symbol-value path))
(t path)))
(matches (fff-files-in-directory-list file realpath (not allp) pred)))
(cond ((fff-length1-p matches)
(message "%s" (car matches))
(funcall op (car matches)))
((null matches)
(signal 'file-error
(list (format "File %s not found%s" file
(if (symbolp path)
(format " in %s" path)
"")))))
(t
(if interactivep
(fff-display-matches file matches op)
(signal 'file-error
(list (format "Multiple instances of %s" file)
(cons 'path: path)
(cons 'predicate: pred)
(cons 'matches: matches))))))))
locate
(defun fff-find-file-in-locate-db (file &optional allp)
"Visit the file named FILE in a buffer.
The complete file name is searched for in an external `locate' database.
FILE must be a literal filename; no regexps are allowed.
If called interactively with a prefix argument and there is more than one
possible match, a list is displayed. If called from a program and there is
more than one match, an error is signalled.
If no matches are found, an error is signalled."
(interactive (list (read-string "Find file (fff locate): ")
current-prefix-arg))
(funcall 'fff-<op>-file-in-locate-db
file allp fff-match-predicate 'find-file (interactive-p)))
(defun fff-insert-file-in-locate-db (file &optional allp)
"Insert the file named FILE into current buffer.
This function behaves exactly like `fff-find-file-in-locate-db', except
that the contents of the file is inserted in the current buffer instead of
being visited in another buffer."
(interactive (list (read-string "Insert file (fff locate): ")
current-prefix-arg))
(funcall 'fff-<op>-file-in-locate-db
file allp fff-match-predicate 'insert-file (interactive-p)))
(defun fff-<op>-file-in-locate-db (file allp pred op interactivep)
(and interactivep
(message "Searching for %s with `locate'..." file))
(let ((matches (fff-locate-files-in-locate-db file (not allp) pred)))
(cond ((fff-length1-p matches)
(message "%s" (car matches))
(funcall op (car matches)))
((null matches)
(signal 'file-error
(list (format "No matches for %s in locate database"
file)
(cons 'predicate pred))))
(t
(if interactivep
(fff-display-matches file matches op)
(signal 'file-error
(list (format "Multiple matches for %s" file)
(cons 'predicate pred)
(list 'matches: matches))))))))
(defun fff-locate-files-in-locate-db (file &optional firstp pred)
"Return a list of files named FILE meeting PRED in a `locate' database.
FILE must be a literal filename; no regexps are allowed.
Optional PRED may be any lisp function that takes one argument, a
string representing the name of a file.
It should return true if the file name should be included in the list of
return values. One common useful predicate is 'file-readable-p .
If no predicate is specified, all files names named FILE are matched.
Return a list of the names found, in the order they appeared in the
database, or `nil' if none.
Optional third arg FIRSTP means return only the first match found.
The `locate' database must be kept reasonably up-to-date or this function
cannot be expected to find all existing occurences of a file. On systems
where it is installed, it is usually run once a day via a cron job.
The database is not read directly. The program specified by the variable
``fff-locate-program'' is used to parse the database and print a list of
file names, one per line, on standard output.
Additional arguments can be specified in the variable named
``fff-locate-program-args'', which are passed to the locate
program before the name of the file."
(let* ((re-file (format "/%s$" (regexp-quote file)))
(found nil)
(args (if fff-locate-program-args
(append (copy-sequence fff-locate-program-args)
file)
(list file)))
(buf (generate-new-buffer (concat " *locate-" file "*")))
beg end candidate)
(save-excursion
(set-buffer buf)
(fundamental-mode)
(buffer-disable-undo (current-buffer))
(apply 'call-process fff-locate-program nil t nil args)
(goto-char (point-min))
(save-match-data
(while (re-search-forward re-file nil t)
(beginning-of-line)
(setq beg (point))
(end-of-line)
(setq end (point))
(setq candidate (buffer-substring beg end))
(cond ((or (null pred)
(funcall pred candidate))
(setq found (cons candidate found))
(and firstp
(goto-char (point-max))))))))
(kill-buffer buf)
found))
(put 'fff-display-matches-mode 'mode-class 'special)
(defvar fff-display-matches-buffer-name "*File Name Matches*")
(defvar fff-display-matches-mode-map)
(defvar fff-display-matches-mode-selection-data)
(defvar fff-use-current-buffer-first-call-p)
(defun fff-display-matches (file matches &optional action buffer descrip)
(and fff-sorting-predicate
(setq matches (sort matches fff-sorting-predicate)))
(let* ((buf (fff-display-matches-prepare-buffer))
(orig-buf (current-buffer))
(display-buf (or buffer orig-buf))
(startpos 0)
(l matches))
(unwind-protect
(progn
(set-buffer buf)
(goto-char (point-min))
(cond (action
(insert "In this buffer, type RET to select "
"the match near point.\n")
(cond (descrip
(insert descrip "\n"))
((and (symbolp action)
(commandp action))
(insert "That selection will invoke the command `"
(symbol-name action)
"' on it.\n"))
(t
(insert "That selection will invoke the function "
"specified by the value of the variable "
"`fff-display-matches-mode-selection-action'"
".\n")))
(insert "\n")))
(insert "Files found matching \"" file "\":\n\n")
(setq startpos (point))
(while l
(insert (car l)
(if (file-directory-p (car l))
"/\n"
"\n"))
(setq l (cdr l)))
(fff-display-matches-mode action
display-buf
(buffer-name display-buf)
(set-marker (make-marker) startpos))
(set-buffer orig-buf)))
(fff-display-buffer buf nil startpos t)
(message "Multiple matches for %s" file)))
(defun fff-display-matches-prepare-buffer ()
(let ((buf (get-buffer-create fff-display-matches-buffer-name)))
(save-excursion
(set-buffer buf)
(widen)
(fundamental-mode)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only nil)
(erase-buffer))
buf))
(defun fff-display-matches-mode (&rest data)
"Major mode for buffers showing lists of possible matches for fff commands.
Type RET in the list to select the match near point.
This mode is used to display a menu of all the matching file names found by
a search. Usually, you only get a menu if you used a prefix arg with one of
the commands and there is more than one possible match for the file name."
(widen)
(fundamental-mode)
(kill-all-local-variables)
(cond ((and (boundp 'fff-display-matches-mode-map)
(keymapp fff-display-matches-mode-map)))
(t
(let ((map (make-sparse-keymap))
(fn 'fff-display-matches-select-match)
(keys '("\n" "\r")))
(while keys
(define-key map (car keys) fn)
(setq keys (cdr keys)))
(setq fff-display-matches-mode-map map))))
(use-local-map fff-display-matches-mode-map)
(make-local-variable 'fff-display-matches-mode-selection-data)
(setq fff-display-matches-mode-selection-data data)
(buffer-disable-undo (current-buffer))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(setq major-mode 'fff-display-matches-mode)
(setq mode-name "FFF Display Matches"))
(defun fff-display-matches-select-match ()
(interactive)
(or (eq major-mode 'fff-display-matches-mode)
(error "This command is inappropriate for this mode."))
(let* ((data fff-display-matches-mode-selection-data)
(fn (nth 0 data))
(buf (nth 1 data))
(bufname (nth 2 data))
(pos (nth 3 data))
beg name)
(cond (fn
(and (< (point) pos)
(error "Point is not positioned on a file name."))
(save-excursion
(beginning-of-line)
(setq beg (point))
(end-of-line)
(setq name (buffer-substring beg (point))))
(and (= (length name) 0)
(error "Point is not positioned on a file name."))
(and buf
(cond ((or (buffer-name buf)
(fff-display-matches-use-current-buffer-p bufname
fn
pos))
(fff-display-buffer buf nil nil t)
(funcall fn name))
(t
(error "Original buffer \"%s\" killed." bufname))))))))
(defun fff-display-matches-use-current-buffer-p (bufname op pos)
(cond ((not (boundp 'fff-use-current-buffer-first-call-p))
(make-local-variable 'fff-use-current-buffer-first-call-p)
(setq fff-use-current-buffer-first-call-p t)
(let ((p (point-marker)))
(goto-char pos)
(forward-line -2)
(let ((buffer-read-only nil))
(insert-before-markers "*** Note: original buffer \""
bufname
"\" no longer exists!\n\n"))
(goto-char p))))
(yes-or-no-p (format "Perform %s from current buffer? " op)))
(defun fff-display-buffer (buffer &optional not-this-window-p point selectp)
(let ((old-win (selected-window))
(old-buf (current-buffer))
(win (display-buffer buffer not-this-window-p)))
(and point
(unwind-protect
(progn
(set-buffer buffer)
(select-window win)
(goto-char point)
(recenter '(0))
(cond ((and (pos-visible-in-window-p (point-max))
(not (pos-visible-in-window-p (point-min))))
(goto-char (point-max))
(forward-line -1)
(recenter -1)
(goto-char point))))
(select-window old-win)
(set-buffer old-buf)))
(and selectp
(progn
(set-buffer buffer)
(select-window win)))
win))
(defun fff-files-in-directory-list (file path &optional firstp pred)
"Return a list of all files named FILE located in PATH.
FILE may be a string containing a single file name or it
may be a list of file names to search for.
PATH may be a list of strings or a single string composed of
colon-separated directory names.
If more than one file name is specified, then the list returned will
contain all the matches for each element of PATH grouped together, e.g.
\(fff-files-in-directory-list '\(\"foo\" \"bar\"\) '\(\"dir1\" \"dir2\"\)\)
=> '\(\"dir1/foo\" \"dir1/bar\" \"dir2/foo\" \"dir2/bar\"\)
NOT '\(\"dir1/foo\" \"dir2/foo\" \"dir1/bar\" \"dir2/bar\"\)
Optional third argument PRED can be an arbitrary function of one
argument \(e.g. 'file-readable-p\), which should return non-`nil' if a file
name candidate should be returned.
If optional fourth argument FIRSTP is non-`nil', then return only the
first name found \(as a single-element list\)."
(and (stringp file)
(setq file (list file)))
(and (stringp path)
(setq path (fff-path-string->list path)))
(let ((matches nil)
flist f)
(while path
(setq flist file)
(while flist
(setq f (expand-file-name (concat (file-name-as-directory (car path))
(car flist))))
(setq flist (cdr flist))
(and (file-exists-p f)
(or (null pred)
(funcall pred f))
(not (member f matches))
(progn
(setq matches (cons f matches))
(and firstp
(setq file nil
flist nil
path nil)))))
(setq path (cdr path)))
(nreverse matches)))
(defun fff-suffix (str suffix-list)
(cond ((stringp str)
(mapcar (function (lambda (ext) (concat str ext))) suffix-list))
((consp str)
(apply 'nconc (mapcar (function (lambda (ext)
(mapcar (function (lambda (s)
(concat s ext)))
str)))
suffix-list)))))
(defun fff-complete-feature (string predicate &optional allp)
(let ((table (fff-symbol-list->obarray features fff-default-obarray-size))
(fn (if allp 'all-completions 'try-completion)))
(funcall fn string table predicate)))
(defun fff-complete-emacs-lisp-library (string predicate &optional allp)
(cond
((boundp 'load-history)
(let ((table (fff-symbol-list->obarray features fff-default-obarray-size))
(fn (if allp 'all-completions 'try-completion))
(lh load-history))
(save-match-data
(while lh
(intern (if (string-match "/" (car (car lh)))
(file-name-nondirectory (car (car lh)))
(car (car lh))) table)
(setq lh (cdr lh))))
(funcall fn string table predicate)))
(t
(fff-complete-feature string predicate allp))))
(defun fff-symbol-list->obarray (list &optional obarray-or-size filter)
(let ((new-obarray (if (vectorp obarray-or-size) obarray-or-size
(make-vector (or obarray-or-size
fff-default-obarray-size) 0)))
(elt nil))
(while list
(setq elt (car list))
(setq list (cdr list))
(and filter
(setq elt (funcall filter elt)))
(intern (if (symbolp elt)
(symbol-name elt)
elt)
new-obarray))
new-obarray))
(defun fff-complete-envvar (string predicate &optional allp)
(let ((table (fff-env->obarray))
(fn (if allp 'all-completions 'try-completion)))
(funcall fn string table predicate)))
(defun fff-env->obarray (&optional envlist)
(let ((new-obarray (make-vector fff-default-obarray-size 0))
(list (or envlist process-environment)))
(save-match-data
(while list
(and (string-match "=" (car list))
(intern (substring (car list) 0 (1- (match-end 0))) new-obarray))
(setq list (cdr list))))
new-obarray))
(defun fff-path-string->list (path)
"Convert a colon-separated path string into a list.
Any null paths are converted to \".\" in the returned list so that
elements of the path may be treated consistently when prepending them to
file names."
(let* ((list (fff-string-split path ":"))
(l list))
(while l
(and (string= "" (car l))
(setcar l "."))
(setq l (cdr l)))
list))
(defun fff-string-split (string separator &optional limit)
"Split STRING at occurences of SEPARATOR. Return a list of substrings.
SEPARATOR can be any regexp, but anything matching the separator will never
appear in any of the returned substrings.
If optional arg LIMIT is specified, split into no more than that many
fields \(though it may split into fewer\)."
(let ((string-list nil)
(len (length string))
(pos 0)
(splits 0)
str)
(save-match-data
(while (<= pos len)
(setq splits (1+ splits))
(cond ((and limit
(>= splits limit))
(setq str (substring string pos))
(setq pos (1+ len)))
((string-match separator string pos)
(setq str (substring string pos (match-beginning 0)))
(setq pos (match-end 0)))
(t
(setq str (substring string pos))
(setq pos (1+ len))))
(setq string-list (cons str string-list))))
(nreverse string-list)))
(defun fff-read-eval-sexp (prompt)
(let ((result nil)
(sexp nil))
(while (null result)
(condition-case errlist
(setq sexp (read-from-minibuffer prompt nil minibuffer-local-map t)
result (if (and (symbolp sexp)
(boundp sexp))
sexp
(eval sexp)))
(error (message "Error: %s: %s"
(mapconcat 'symbol-name (cdr errlist) " ")
(get (car errlist) 'error-message))
(sit-for 5))))
result))
(defun fff-file-nondirectory-p (f)
(and (file-exists-p f)
(not (file-directory-p f))))
(defun fff-emacs-variant ()
(let ((version (emacs-version))
(alist '(("XEmacs" . xemacs)
("Lucid" . lemacs)
("^GNU Emacs" . emacs)))
result)
(save-match-data
(while alist
(cond
((string-match (car (car alist)) version)
(setq result (cdr (car alist)))
(setq alist nil))
(t
(setq alist (cdr alist))))))
result))
(defconst fff-menu-bar-support-p
(and (string-lessp "19" emacs-version)
(memq (fff-emacs-variant) '(emacs))))
(defun fff-controlify-key-sequence (key-sequence)
(setq key-sequence (copy-sequence key-sequence))
(let* ((tmpl (copy-sequence "?\\C-*"))
(tmplidx (1- (length tmpl)))
(len (length key-sequence))
(i 0))
(while (< i len)
(aset tmpl tmplidx (aref key-sequence i))
(aset key-sequence i (read tmpl))
(setq i (1+ i))))
key-sequence)
(defun fff-make-sparse-keymap (&optional string)
(if (and string
fff-menu-bar-support-p
(eq (fff-emacs-variant) 'emacs))
(make-sparse-keymap string)
(make-sparse-keymap)))
(defun fff-define-key (seq fn &optional menu-descrip ctrlify-p)
(let ((fndef (if (and fff-menu-bar-support-p menu-descrip)
(cons menu-descrip fn)
fn)))
(and ctrlify-p
(setq seq (fff-controlify-key-sequence seq)))
(define-key fff-map seq fndef)))
(defun fff-install-map (&optional overridep keymap-prefix)
"Install the fff keymap."
(interactive "P")
(cond ((null fff-map)
(setq fff-map (fff-make-sparse-keymap))
(fff-define-key "\C-h" 'describe-prefix-bindings)
(fff-define-key "\C-i\C-f"
'fff-insert-file-in-locate-db
"Insert file from `locate' DB")
(fff-define-key "\C-i\C-p"
'fff-insert-file-in-path
"Insert file from path")
(fff-define-key "\C-i\C-v"
'fff-insert-file-in-envvar-path
"Insert file from environment path")
(fff-define-key "\C-i\C-e"
'fff-insert-file-in-exec-path
"Insert file from exec-path")
(fff-define-key "\C-i\C-l"
'fff-insert-emacs-lisp-library
"Insert emacs lisp library")
(fff-define-key "\C-f"
'fff-find-file-in-locate-db
"Find file from `locate' DB")
(fff-define-key "\C-p"
'fff-find-file-in-path
"Find file from path")
(fff-define-key "\C-v"
'fff-find-file-in-envvar-path
"Find file from environment path")
(fff-define-key "\C-e"
'fff-find-file-in-exec-path
"Find file from exec-path")
(fff-define-key "\C-d"
'fff-find-loaded-emacs-lisp-function
"Find emacs lisp function definition")
(fff-define-key "\C-l"
'fff-find-emacs-lisp-library
"Find emacs lisp library")
))
(fset 'fff-command-prefix fff-map)
(and keymap-prefix
(setq fff-map-prefix keymap-prefix))
(and fff-menu-bar-support-p
(boundp 'menu-bar-final-items)
(not (memq 'fff menu-bar-final-items))
(setq menu-bar-final-items (cons 'fff menu-bar-final-items)))
(let ((current-binding (key-binding fff-map-prefix))
(description (key-description fff-map-prefix)))
(cond ((eq current-binding 'fff-command-prefix))
((and current-binding
(not overridep))
(error "Prefix \"%s\" is already bound" description))
(t
(fff-uninstall-map)
(cond (fff-map-prefix
(global-set-key fff-map-prefix 'fff-command-prefix)
(and fff-menu-bar-support-p
(global-set-key [menu-bar fff]
(cons "FFF" fff-map)))))))
(and (interactive-p)
(message "fff commands are on prefix \"%s\"" description))))
(defun fff-uninstall-map ()
(interactive)
(and fff-menu-bar-support-p
(global-unset-key [menu-bar fff]))
(let ((existing (where-is-internal 'fff-command-prefix)))
(while existing
(global-unset-key (car existing))
(setq existing (cdr existing)))))
(provide 'fff)