Re: globalff.el --- Global find file

[spamfilteraccount]

New release.

Changes:

- Added globalff-selection-face, so that it can be set independtly from
the standard region face

- Fixed initial selection if regexp filtering is active

- Added option globalff-adaptive-selection to optionally preselect the
  last file chosen for the same input pattern automatically. If no
exact
  input match is found then the most recent input pattern which matches
  the beginning of the current input is used.

  This option makes it possible to use a short input string to
  locate a previously visited file again quickly.


;;; globalff.el --- Global find file

;; Copyright (C) 2006  Free Software Foundation, Inc.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Start with M-x globallff and type in any substring of any path on
;; your system to display the matching files. The displayed list is
;; updated dynamically as you type more characters or delete some.
;;
;; Needs an up-to-date locate database for file name searching.
;;
;; Since the search is based on locate you can use any globbing
;; characters allowed by the locate command.
;;
;; You can move up/down the list with the cursor keys (I know these
;; bindings are not very Emacsian, but I happen to like them) and
;; select a file to open with Enter.
;;
;; You can quit with C-g.
;;
;; See the variable `globalff-map' for further bindings.
;;

;;; Code:

(require 'cl)

;;
;; User configurable variables
;;

(defvar globalff-case-sensitive-search nil
  "Whether to use case sensitive pattern matching.")

(defvar globalff-regexp-search nil
  "Whether to use regular expression pattern matching.")

(defvar 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.")

(defvar globalff-filter-regexps nil
  "List of regular expressions to filter out unwanted files from the
output.")

(defvar globalff-minimum-input-length 3
  "The minimum number of characters needed to start file searching.")

(defvar globalff-search-delay 0.5
  "Idle time after last input event, before starting the search.")

(defvar 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.")

(defvar globalff-history-length 50
  "Number of previous file selections saved if
`globalff-adaptive-selection' is enabled.")

(defvar globalff-history-file "~/.globalff_history"
  "Name of the history file where previous file selections saved if
`globalff-adaptive-selection' is enabled.")

;; Face used to highlight the currently seleceted file name
(copy-face 'region 'globalff-selection-face)

(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)
    ;; I wanted to choose C-t as a homage to iswitchb, but
    ;; transpose-chars can be useful during pattern editing
    (define-key map (kbd "C-r") 'globalff-toggle-regexp-search)
    (define-key map (kbd "C-s") 'globalff-toggle-around-globs)
    (define-key map (kbd "<RET>") 'globalff-exit-minibuffer)
    map)
  "Keymap for globalff.")

;;
;; End of user configurable variables
;;

(defvar globalff-idle-timer nil
  "Idle timer for monitoring typed characters.")

(defconst globalff-buffer "*globalff*"
  "Buffer used for finding files.")

(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
      ;; Insert the text, advancing the process marker.
      (goto-char (process-mark process))

      (let ((begin (line-beginning-position)))
        (insert string)

        ;; filter out unwanted lines
        (if globalff-filter-regexps
            ;; current line can be incomplete, so store and remove
            ;; it before filtering
            (let ((line (buffer-substring (line-beginning-position)
                                          (line-end-position))))
              (delete-region (line-beginning-position)
(line-end-position))

              (dolist (regexp globalff-filter-regexps)
                (goto-char begin)
                (flush-lines regexp))

              (goto-char (point-max))
              (insert line)))

        (set-marker (process-mark process) (point))))

    (if (= (overlay-start globalff-overlay) ; no selection yet
           (overlay-end globalff-overlay))
      (unless (= (line-end-position) (point-max)) ; incomplete line
        (globalff-mark-current-line))

      ;; try to select previously chosen file if enabled
      (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 line end is point-max then it's either an incomplete line
or
      ;; the end of the output, so move up a line
      (if (= (line-end-position) (point-max))
          (next-line -1))

      ;; if the user moved the selection then adaptive selection
      ;; shouldn't touch it
      (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."
  (if (eq nil (process-status globalff-buffer))
      (globalff-set-state "finished")))


(defun globalff-check-input ()
  "Check input string and start/stop search if necessary."
  (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))
      (let ((process (apply 'start-process "globalff-process"
globalff-buffer
                            "locate"
                            (append
                             (unless globalff-case-sensitive-search
                               (list "-i"))

                             (if globalff-regexp-search
                               (list "-r"))

                             (when globalff-databases
                               (list (concat "--database="
                                             globalff-databases)))

                             (list input)))))
        (globalff-set-state "searching")
        (move-overlay globalff-overlay 0 0)

        (if globalff-adaptive-selection
            (let ((item (assoc input globalff-history)))
              ;; if no exact match found then try prefix match
              (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 process 'globalff-output-filter)
        (set-process-sentinel process 'globalff-process-sentinel)))))


(defun globalff-kill-process ()
  "Kill find process."
  (if (eq 'run (process-status globalff-buffer))
      (delete-process globalff-buffer)))


(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")
                                    ":" 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-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)) ?*))
                ;; remove asterisks from around pattern
                (progn
                  (beginning-of-line)
                  (delete-char 1)
                  (end-of-line)
                  (delete-char -1))

                ;; put asterisks around pattern
              (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)))
        (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))


(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 ()
  "Return the currently selected file path."
  (with-current-buffer globalff-buffer
    (buffer-substring-no-properties (overlay-start globalff-overlay)
                                    (overlay-end globalff-overlay))))


(defun globalff ()
  "Start global find file."
  (interactive)
  (let ((winconfig (current-window-configuration)))
    (pop-to-buffer globalff-buffer)
    (erase-buffer)
    (setq mode-name "GlobalFF")

    (unless globalff-overlay
      (setq globalff-overlay (make-overlay 0 0))
      (overlay-put globalff-overlay 'face 'globalff-selection-face))

    (globalff-set-state "idle")
    (setq globalff-previous-input "")
    (setq globalff-idle-timer
          (run-with-idle-timer globalff-search-delay t
'globalff-check-input))

    (with-current-buffer globalff-buffer
      (setq cursor-type nil))

    (unwind-protect
        (let ((minibuffer-local-map globalff-map))
          (read-string "substring: "))

      (globalff-kill-process)
      (cancel-timer globalff-idle-timer)

      (with-current-buffer globalff-buffer
        (setq cursor-type t))

      (set-window-configuration winconfig)))

  (unless (= (buffer-size (get-buffer globalff-buffer)) 0)
    (find-file (globalff-get-selected-file))))


(provide 'globalff)
;;; globalff.el ends here