Download
(eval-when-compile (require 'cl))
(if (featurep 'xemacs)
(require 'overlay))
(defgroup globalff nil
"Globally find a file using locate."
:tag "GlobalFF"
:link '(url-link :tag "Home Page"
"http://www.emacswiki.org/cgi-bin/wiki/GlobalFF")
:link '(emacs-commentary-link
:tag "Commentary in globalff.el" "globalff.el")
:prefix "globalff-"
:group 'convenience)
(defcustom globalff-case-sensitive-search nil
"*Whether to use case sensitive pattern matching."
:type 'boolean
:group 'globalff)
(defcustom globalff-regexp-search nil
"*Whether to use regular expression pattern matching."
:type 'boolean
:group 'globalff)
(defcustom globalff-camelcase-search nil
"*Whether to use camelcase pattern matching. Camel case matching is
useful for languages like Java which start words with uppercase
letters. So, if you want to match the filename
\"MyLongFileWithLongName\", you can type: \"MyLoFiW\", or even MLFW,
which will usually give you a close to unique match."
:type 'boolean
:group 'globalff)
(defcustom globalff-basename-match nil
"*Whether to match on the base name of paths instead of on the whole
path."
:type 'boolean
:group 'globalff)
(defcustom globalff-databases nil
"*List of database files separated with colon to be used by the
locate command. If nil then the system default database is used."
:type 'string
:group 'globalff)
(defcustom globalff-filter-regexps nil
"*List of regular expressions to filter out unwanted files from the
output."
:type '(repeat regexp)
:group 'globalff)
(defcustom globalff-transform-regexps nil
"*List of (REGEXP . REPLACEMENT) pairs to transform matching file
path names. It's useful when the matching path names are very long and
they have a component which can safely be replaced with a shorter
indicator string.
For example this rule:
(push '(\"^/very/long/path/to/projectx/\" . \"<projx>/\")
globalff-transform-regexps)
will display file names under \"projectx\" like this:
<projx>/sources/main.c
<projx>/sources/test.c
"
:type '(repeat (cons regexp regexp))
:group 'globalff)
(defcustom globalff-minimum-input-length 3
"*The minimum number of characters needed to start file searching."
:type 'integer
:group 'globalff)
(defcustom globalff-search-delay 0.5
"*Idle time after last input event, before starting the search."
:type 'number
:group 'globalff)
(defcustom globalff-matching-filename-limit 500
"*If there are more matching file names than the given limit the
search is terminated automatically. This is useful if a too broad
search input is given and there are hundreds or thousands of matches.
If you don't want to limit the number of matches then set it to nil
instead of a very high number."
:type '(choice integer (const nil))
:group 'globalff)
(defcustom globalff-adaptive-selection nil
"*If enabled the last file chosen for the same input is preselected
automatically instead of the first one in the list. If no exact input
match is found then the most recent input pattern which matches the
beginning of the current input is used.
Doesn't do anything if the user moves the selection manually, before a
file is selected automatically.
This option makes it possible to use a short input string to locate a
previously visited file again quickly."
:type 'boolean
:group 'globalff)
(defcustom globalff-history-length 100
"*Number of previous file selections saved if
`globalff-adaptive-selection' is enabled."
:type 'integer
:group 'globalff)
(defcustom globalff-history-file "~/.globalff_history"
"*Name of the history file where previous file selections saved if
`globalff-adaptive-selection' is enabled."
:type 'file
:group 'globalff)
(defface globalff-selection-face
(if (assq :inherit custom-face-attributes)
'((t (:inherit highlight :underline nil)))
'((((class color) (background light))
(:background "darkseagreen2"))
(((class color) (background dark))
(:background "darkolivegreen"))
(t (:inverse-video t))))
"Face for highlighting the currently selected file name.")
(defvar globalff-map
(let ((map (copy-keymap minibuffer-local-map)))
(define-key map (kbd "<down>") 'globalff-next-line)
(define-key map (kbd "<up>") 'globalff-previous-line)
(define-key map (kbd "<prior>") 'globalff-previous-page)
(define-key map (kbd "<next>") 'globalff-next-page)
(define-key map (kbd "C-c") 'globalff-toggle-case-sensitive-search)
(define-key map (kbd "C-r") 'globalff-toggle-regexp-search)
(define-key map (kbd "C-t") 'globalff-toggle-camelcase-search)
(define-key map (kbd "C-w") 'globalff-toggle-basename-match)
(define-key map (kbd "C-s") 'globalff-toggle-around-globs)
(define-key map (kbd "<RET>") 'globalff-exit-minibuffer)
(define-key map (kbd "C-<return>") 'globalff-copy-file-name-and-exit)
map)
"Keymap for globalff.")
(defconst globalff-buffer "*globalff*"
"Buffer used for finding files.")
(defconst globalff-process nil
"The current search process.")
(defvar globalff-previous-input ""
"The previous input substring used for searching.")
(defvar globalff-overlay nil
"Overlay used to highlight the current selection.")
(defvar globalff-history nil
"List of the previous file selections if
`globalff-adaptive-selection' is enabled.")
(defvar globalff-adaptive-selection-target nil
"The search output filter looks for this file name in the output if
`globalff-adaptive-selection' is enabled.")
(defun globalff-output-filter (process string)
"Avoid moving of point if the buffer is empty."
(with-current-buffer globalff-buffer
(save-excursion
(goto-char (point-max))
(let ((begin (point-at-bol)))
(insert string)
(if (or globalff-filter-regexps
globalff-transform-regexps)
(let ((line (buffer-substring (point-at-bol)
(point-at-eol))))
(delete-region (point-at-bol) (point-at-eol))
(dolist (regexp globalff-filter-regexps)
(goto-char begin)
(flush-lines regexp))
(dolist (rule globalff-transform-regexps)
(goto-char begin)
(while (re-search-forward (car rule) nil t)
(let ((orig-path
(or (get-text-property (point-at-bol)
'globalff-orig-filename)
(buffer-substring-no-properties
(point-at-bol) (point-at-eol)))))
(replace-match (cdr rule))
(put-text-property (point-at-bol) (point-at-eol)
'globalff-orig-filename
orig-path))))
(goto-char (point-max))
(insert line)))))
(if (= (overlay-start globalff-overlay)
(overlay-end globalff-overlay))
(unless (= (point-at-eol) (point-max))
(globalff-mark-current-line))
(when (and globalff-matching-filename-limit
(>= (count-lines (point-min) (point-max))
globalff-matching-filename-limit))
(globalff-kill-process)
(globalff-set-state "killed")
(save-excursion
(goto-char (point-max))
(delete-region (point-at-bol) (point-at-eol))))
(if (and globalff-adaptive-selection
globalff-adaptive-selection-target)
(let ((window (get-buffer-window globalff-buffer)))
(if (window-live-p window)
(save-selected-window
(select-window window)
(when (search-forward globalff-adaptive-selection-target nil t)
(setq globalff-adaptive-selection-target nil)
(globalff-mark-current-line)))))))))
(defun globalff-mark-current-line ()
"Mark current line with a distinctive color."
(move-overlay globalff-overlay (point-at-bol) (point-at-eol)))
(defun globalff-previous-line ()
"Move selection to the previous line."
(interactive)
(globalff-move-selection 'next-line -1))
(defun globalff-next-line ()
"Move selection to the next line."
(interactive)
(globalff-move-selection 'next-line 1))
(defun globalff-previous-page ()
"Move selection back with a pageful."
(interactive)
(globalff-move-selection 'scroll-down nil))
(defun globalff-next-page ()
"Move selection forward with a pageful."
(interactive)
(globalff-move-selection 'scroll-up nil))
(defun globalff-move-selection (movefunc movearg)
"Move the selection marker to a new position determined by
MOVEFUNC and MOVEARG."
(unless (= (buffer-size (get-buffer globalff-buffer)) 0)
(save-selected-window
(select-window (get-buffer-window globalff-buffer))
(condition-case nil
(funcall movefunc movearg)
(beginning-of-buffer (goto-char (point-min)))
(end-of-buffer (goto-char (point-max))))
(if (= (point-at-eol) (point-max))
(next-line -1))
(setq globalff-adaptive-selection-target nil)
(globalff-mark-current-line))))
(defun globalff-process-sentinel (process event)
"Prevent printing of process status messages into the output buffer."
(unless (eq 'run (process-status process))
(globalff-set-state "finished")))
(defun globalff-check-input ()
"Check input string and start/stop search if necessary."
(if (sit-for globalff-search-delay)
(unless (equal (minibuffer-contents) globalff-previous-input)
(globalff-restart-search))))
(defun globalff-restart-search ()
"Stop the current search if any and start a new one if needed."
(let ((input (minibuffer-contents)))
(setq globalff-previous-input input)
(globalff-kill-process)
(with-current-buffer globalff-buffer
(erase-buffer))
(globalff-set-state "idle")
(unless (or (equal input "")
(< (length input) globalff-minimum-input-length))
(setq globalff-process
(apply 'start-process "globalff-process" nil
"locate"
(append
(unless globalff-case-sensitive-search
(list "-i"))
(if globalff-basename-match
(list "-b"))
(when globalff-databases
(list (concat "--database="
globalff-databases)))
(if globalff-regexp-search
(list "-r"))
(if globalff-camelcase-search
(list (globalff-camelcase-generate input))
(list input)))))
(globalff-set-state "searching")
(move-overlay globalff-overlay (point-min) (point-min))
(if globalff-adaptive-selection
(let ((item (assoc input globalff-history)))
(unless item
(let ((input-length (length input)))
(setq item
(some (lambda (test-item)
(let ((str (car test-item)))
(when (and (> (length str) input-length)
(string= (substring str 0
input-length)
input))
test-item)))
globalff-history))))
(setq globalff-adaptive-selection-target (cdr item))))
(set-process-filter globalff-process 'globalff-output-filter)
(set-process-sentinel globalff-process 'globalff-process-sentinel))))
(defun globalff-camelcase-generate (string)
"Generates the camel case matching by add .* before each capital
letter."
(let ((result "") (index 0) (case-fold-search nil))
(progn
(while (< index (length string))
(let ((c (substring string index (+ index 1))))
(setq result
(if (or (string= c "A") (string= c "B") (string= c "C") (string= c "D")
(string= c "E") (string= c "F") (string= c "G") (string= c "H")
(string= c "I") (string= c "J") (string= c "K") (string= c "L")
(string= c "M") (string= c "N") (string= c "O") (string= c "P")
(string= c "Q") (string= c "R") (string= c "S") (string= c "T")
(string= c "U") (string= c "V") (string= c "W") (string= c "X")
(string= c "Y") (string= c "Z"))
(concat result ".*" c)
(concat result c))
index (+ index 1))))
(concat "" result))))
(defun globalff-kill-process ()
"Kill find process."
(when globalff-process
(set-process-filter globalff-process nil)
(set-process-sentinel globalff-process nil)
(delete-process globalff-process)
(setq globalff-process nil)))
(defun globalff-set-state (state)
"Set STATE in mode line."
(with-current-buffer globalff-buffer
(setq mode-line-process (concat ":" (if globalff-case-sensitive-search
"case"
"nocase")
"/" (if globalff-regexp-search
"regexp"
"glob")
"/" (if globalff-camelcase-search
"camel"
"nocamel")
"/" (if globalff-basename-match
"base"
"whole")
":" state))
(force-mode-line-update)))
(defun globalff-toggle-case-sensitive-search ()
"Toggle state of case sensitive pattern matching."
(interactive)
(setq globalff-case-sensitive-search (not globalff-case-sensitive-search))
(globalff-restart-search))
(defun globalff-toggle-regexp-search ()
"Toggle state of regular expression pattern matching."
(interactive)
(setq globalff-regexp-search (not globalff-regexp-search))
(globalff-restart-search))
(defun globalff-toggle-camelcase-search ()
"Toggle state of camelcase pattern matching."
(interactive)
(setq globalff-camelcase-search (not globalff-camelcase-search))
(if globalff-camelcase-search
(setq globalff-case-sensitive-search t
globalff-regexp-search t))
(globalff-restart-search))
(defun globalff-toggle-basename-match ()
"Toggle matching on basename vs. on whole path."
(interactive)
(setq globalff-basename-match (not globalff-basename-match))
(globalff-restart-search))
(defun globalff-toggle-around-globs ()
"Put/remove asterisks around pattern if glob matching is used. This
make it easier to use globs, since by default glob patterns have to
match the file name exactly."
(interactive)
(unless globalff-regexp-search
(let* ((pattern (minibuffer-contents))
(len (length pattern)))
(if (> len 2)
(save-excursion
(if (and (= (aref pattern 0) ?*)
(= (aref pattern (1- len)) ?*))
(progn
(beginning-of-line)
(delete-char 1)
(end-of-line)
(delete-char -1))
(beginning-of-line)
(insert "*")
(end-of-line)
(insert "*")))))))
(defun globalff-exit-minibuffer ()
"Store the current pattern and file name in `globalff-history' if
`globalff-adaptive-selection' is enabled and exit the minibuffer."
(interactive)
(if globalff-adaptive-selection
(let ((input (minibuffer-contents))
(selected (globalff-get-selected-file t)))
(unless (or (equal input "")
(equal selected ""))
(let ((item (assoc input globalff-history)))
(if item
(setq globalff-history (delete item globalff-history)))
(push (cons input selected) globalff-history)
(if (> (length globalff-history) globalff-history-length)
(nbutlast globalff-history))))))
(exit-minibuffer))
(defun globalff-copy-file-name-and-exit ()
"Copy selected file name and abort the search."
(interactive)
(kill-new (globalff-get-selected-file))
(exit-minibuffer))
(when globalff-adaptive-selection
(load-file globalff-history-file)
(add-hook 'kill-emacs-hook 'globalff-save-history))
(defun globalff-save-history ()
"Save history of used pattern-file name pairs used by
`globalff-adaptive-selection'."
(interactive)
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp -*-\n"
";; History entries used for globalff adaptive selection.\n")
(prin1 `(setq globalff-history ',globalff-history) (current-buffer))
(insert ?\n)
(write-region (point-min) (point-max) globalff-history-file nil
(unless (interactive-p) 'quiet))))
(defun globalff-get-selected-file (&optional rendered)
"Return the currently selected file path.
If RENDERED is non-nil then the visible path name is returned instead
of the real path name of the file."
(with-current-buffer globalff-buffer
(or (and (not rendered)
(get-text-property (overlay-start globalff-overlay)
'globalff-orig-filename))
(buffer-substring-no-properties (overlay-start globalff-overlay)
(overlay-end globalff-overlay)))))
(defun globalff-do ()
"The guts of globalff.
It expects that `globalff-buffer' is selected already."
(erase-buffer)
(setq mode-name "GlobalFF")
(if globalff-overlay
(move-overlay globalff-overlay (point-min) (point-min)
(get-buffer globalff-buffer))
(setq globalff-overlay (make-overlay (point-min) (point-min)))
(overlay-put globalff-overlay 'face 'globalff-selection-face))
(globalff-set-state "idle")
(setq globalff-previous-input "")
(add-hook 'post-command-hook 'globalff-check-input)
(with-current-buffer globalff-buffer
(setq cursor-type nil))
(unwind-protect
(let ((minibuffer-local-map globalff-map))
(read-string "substring: "))
(remove-hook 'post-command-hook 'globalff-check-input)
(globalff-kill-process)
(with-current-buffer globalff-buffer
(setq cursor-type t))))
(defun globalff ()
"Start global find file."
(interactive)
(let ((winconfig (current-window-configuration)))
(pop-to-buffer globalff-buffer)
(unwind-protect
(globalff-do)
(set-window-configuration winconfig)))
(unless (or (= (buffer-size (get-buffer globalff-buffer)) 0)
(eq this-command 'globalff-copy-file-name-and-exit))
(find-file (globalff-get-selected-file))))
(setq globalff-popup-frame (make-frame '((name . "Select file")
(height . 30)
(top . 200)
(visibility . nil))))
(defun globalff-get-file-and-insert ()
"Select a file with globalff and send the path to the currently
selected application."
(interactive)
(let ((frame (selected-frame)))
(unwind-protect
(progn
(make-frame-visible globalff-popup-frame)
(select-frame globalff-popup-frame)
(switch-to-buffer globalff-buffer)
(globalff-do))
(make-frame-invisible globalff-popup-frame)))
(let ((file (globalff-get-selected-file)))
(unless (equal file "")
(sit-for 1)
(call-process "xte" nil nil nil (concat "str " file)))))
(unless (fboundp 'minibuffer-contents)
(defun minibuffer-contents ()
"Return the user input in a minbuffer as a string.
The current buffer must be a minibuffer."
(field-string (point-max))))
(provide 'globalff)