tc.el --- timid completion

[address@hidden]

I work with files. Lots of files. So I want to open files as
effortlessly as possible. This package is a part of the quest for the
effortless file opening.

I noticed lately that I use the file history more and more for opening
files. I use savehist with a history length of 1000, duplicates
filtered out, so there is a good chance a file I want to open is in
the history.

I use Icicles, so I can use it to match files from the history:

  find-file <delete input> <type pattern> M-h

Pretty easy. But not effortless enough for a frequent operation. In my
opinion at least.

Why do I have to tell emacs I want to complete a file from the
history, not from the file system? It should simply tell me if there
is a match from the history without me doing anything explicitly.

And that's what timid completion does.

When find-file is started there is nothing unusual. If the user
presses TAB, or looks for a file with UP/DOWN in the history, or
anything then everything works as expected.

If the user simply types a few characters and hesitates a bit
(configurable) then timid completion looks for matches in the history
and displays them if there is any and the user can select a match with
the UP/DOWN keys and ENTER (so these keys are redefined if there are
matches to select from). If more characters are typed the list of
matches is updated. If any other command (e.g. TAB) is used then timid
completion disables itself.

So timid completion shows matches from the history automatically while
being as transparent as possible. It appears only if it can offer
something to choose from and disappears instantly if the user chooses
to ignore it. It's timid, you know.

It's not tested extensively, but seems to work well. I tested it with
the standard find-file command, but it should work together with
Icicles too.

Timid completion can be enabled with M-x tc-enable and disabled with
M-x tc-disable.

;;; tc.el --- timid completion

;; Copyright (C) 2007  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:

;;

;;; Code:

(require 'cl)


;;; User options

(defvar tc-affected-commands
  '(find-file
    find-file-at-point)
  "List of commands for which timid completion is offered if it is
enabled.")

(defvar tc-search-delay 0.5
  "*Idle time after last input event before searching for matches in
the history.")

(defvar tc-editing-commands
  '(self-insert-command
    icicle-self-insert
    delete-backward-char)
  "List of commands allowed during timid completion. Any other command
disables it.")

;;;----------------------------------------------------------------------

(defvar tc-internal-commands
  '(tc-select-file
    tc-previous-line
    tc-next-line
    tc-previous-page
    tc-next-page))


(defvar tc-buffer "*tc*")

(defvar tc-saved-commands nil)

(defvar tc-window-config nil)

(defvar tc-pattern-start-position nil)

(defvar tc-overlay nil)


(defun tc-enable ()
  (interactive)
  (add-hook 'minibuffer-setup-hook  'tc-minibuffer-setup)
  (add-hook 'minibuffer-exit-hook  'tc-minibuffer-exit))


(defun tc-disable ()
  (interactive)
  (remove-hook 'minibuffer-setup-hook  'tc-minibuffer-setup)
  (remove-hook 'minibuffer-exit-hook  'tc-minibuffer-exit))


(defun tc-minibuffer-setup ()
  (when (member this-command tc-affected-commands)
    (setq tc-pattern-start-position (point))
    (add-hook 'pre-command-hook 'tc-pre-command-hook)
    (add-hook 'post-command-hook 'tc-post-command-hook)))


(defun tc-minibuffer-exit ()
  (tc-cleanup))


(defun tc-pre-command-hook ()
  (unless (or (member this-command tc-affected-commands)
              (member this-command tc-editing-commands)
              (member this-command tc-internal-commands))
      (tc-cleanup)))


(defun tc-post-command-hook ()
  (if (member this-command tc-editing-commands)
      (when (sit-for tc-search-delay)
        (let ((pattern (buffer-substring tc-pattern-start-position
(point))))
          (with-current-buffer (get-buffer-create tc-buffer)
            (erase-buffer)
            (if (not (equal pattern ""))
                (dolist (file file-name-history)
                  (if (and (string-match pattern file)
                           (not (save-excursion
                                  (re-search-backward (concat "^" file
"$")
                                                      nil t))))
                      (insert file "\n"))))))

        (if (= (buffer-size (get-buffer tc-buffer)) 0)
            (if tc-window-config
                (tc-hide-completion-window))

          (unless tc-window-config
            (setq tc-window-config (current-window-configuration))
            (save-selected-window
              (pop-to-buffer tc-buffer)
              (setq cursor-type nil))

            (tc-redefine-key (kbd "<RET>") 'tc-select-file)
            (tc-redefine-key (kbd "<up>") 'tc-previous-line)
            (tc-redefine-key (kbd "<down>") 'tc-next-line)
            (tc-redefine-key (kbd "<prior>") 'tc-previous-page)
            (tc-redefine-key (kbd "<next>") 'tc-next-page))

          (if tc-overlay
              ;; make sure the overlay belongs to the tc buffer if
              ;; it's newly created
              (move-overlay tc-overlay (point-min) (point-min)
                            (get-buffer tc-buffer))

            (setq tc-overlay (make-overlay (point-min) (point-min)
                                           (get-buffer tc-buffer)))
            (overlay-put tc-overlay 'face 'highlight))

          (save-selected-window
            (select-window (get-buffer-window tc-buffer))
            (goto-char (point-min))
            (tc-mark-current-line))))))


(defun tc-mark-current-line ()
  (move-overlay tc-overlay (point-at-bol) (point-at-eol)))


(defun tc-previous-line ()
  "Move selection to the previous line."
  (interactive)
  (tc-move-selection 'next-line -1))


(defun tc-next-line ()
  "Move selection to the next line."
  (interactive)
  (tc-move-selection 'next-line 1))


(defun tc-previous-page ()
  "Move selection back with a pageful."
  (interactive)
  (tc-move-selection 'scroll-down nil))


(defun tc-next-page ()
  "Move selection forward with a pageful."
  (interactive)
  (tc-move-selection 'scroll-up nil))


(defun tc-move-selection (movefunc movearg)
  "Move the selection marker to a new position determined by
MOVEFUNC and MOVEARG."
  (save-selected-window
    (select-window (get-buffer-window tc-buffer))

    (condition-case nil
        (funcall movefunc movearg)
      (beginning-of-buffer (goto-char (point-min)))
      (end-of-buffer (goto-char (point-max))))

    (if (eobp)
        (next-line -1))

    (tc-mark-current-line)))

(defun tc-select-file ()
  (interactive)
  (beginning-of-line)
  (kill-line)
  (insert (with-current-buffer tc-buffer
            (buffer-substring-no-properties (overlay-start tc-overlay)
                                            (overlay-end tc-
overlay))))
  (exit-minibuffer))


(defun tc-cleanup ()
  (when tc-window-config
    (tc-hide-completion-window))

  (remove-hook 'pre-command-hook 'tc-pre-command-hook)
  (remove-hook 'post-command-hook 'tc-post-command-hook))


(defun tc-hide-completion-window ()
  (set-window-configuration tc-window-config)
  (setq tc-window-config nil)
  (with-current-buffer tc-buffer
    (setq cursor-type t))

  (dolist (def tc-saved-commands)
    (define-key minibuffer-local-completion-map (car def) (cdr def)))
  (setq tc-saved-commands nil))


(defun tc-redefine-key (key command)
  (push (cons key (lookup-key minibuffer-local-completion-map key))
        tc-saved-commands)
  (define-key minibuffer-local-completion-map key command))


(provide 'tc)