;;; anything.el --- open anything

[address@hidden]

This is a prototype for an idea I've been contemplating for a while.
When I want to open something I often find it cumbersome that I have
to specify *what* I want to open. Why not just type something and
emacs show me everything it can offer (configurable) and I simply
select something and let emacs worry about how to open it (files,
buffers, manual pages, etc.).

This package provides a single command (M-x anything) and as I type
the results are shown in a structured format. No need to tell emacs
first I want to switch to a buffer, open a file or a manual page. See
the commentary in the header.


Let me know what you think.


;;; anything.el --- open anything

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;
;; Start with M-x anything, narrow the list by typing some pattern,
;; select with up/down/pgup/pgdown, choose with enter, left/right
;; moves between sections.
;;
;; Tested on Emacs 22.

;; TODO:
;;   - dynamic candidates
;;   - delay on candidates if the operation is heavy

(require 'cl)

(setq anything-sources '(((heading . "Buffers")
                          (candidates . (lambda ()
                                          (mapcar 'buffer-name (buffer-
list))))
                          (action . switch-to-buffer))

                         ((heading . "File Name History")
                          (candidates . file-name-history)
                          (action . find-file))

                         ((heading . "Files from Current Directory")
                          (candidates . (lambda ()
                                          (directory-files ".")))
                          (action . find-file))

                         ((heading . "Manual Pages")
                          (candidates . (lambda ()
                                          (require 'woman)
                                          (woman-file-name "")
                                          (mapcar 'car
                                                  woman-topic-all-
completions)))
                          (action . woman)
                          (requires-pattern))))


(setq anything-map
  (let ((map (copy-keymap minibuffer-local-map)))
    (define-key map (kbd "<down>") 'anything-next-line)
    (define-key map (kbd "<up>") 'anything-previous-line)
    (define-key map (kbd "<prior>") 'anything-previous-page)
    (define-key map (kbd "<next>") 'anything-next-page)
    (define-key map (kbd "<right>") 'anything-next-section)
    (define-key map (kbd "<left>") 'anything-previous-section)
    (define-key map (kbd "<RET>") 'anything-exit-minibuffer)
    map))




(defvar anything-previous-input "")

(defconst anything-buffer "*anything*"
  "Buffer showing completions.")

(defvar anything-overlay nil
  "Overlay used to highlight the currently selected file.")

(defvar anything-face 'header-line)



(defun anything-check-input ()
  "Check input string and start/stop search if necessary."
  (unless (equal (minibuffer-contents) anything-previous-input)
    (anything-update)))


(defun anything-update ()
  (let ((input (if (window-minibuffer-p)
                   (minibuffer-contents)
                 "")))
    (setq anything-previous-input input)
    (with-current-buffer anything-buffer
      (erase-buffer)

      (dolist (source anything-sources)
        (let ((candidates (cdr (assoc 'candidates source)))
              matches)
          (setq candidates (or (and (symbolp candidates)
                                    (symbol-value candidates))
                               (funcall candidates)))

          (if (equal input "")
              (unless (assoc 'requires-pattern source)
                (setq matches candidates))

            (dolist (candidate candidates)
              (if (string-match input candidate)
                  (push candidate matches)))
            (setq matches (reverse matches)))

          (when matches
            (let ((start (point)))
              (insert (cdr (assoc 'heading source)) "\n")
              (put-text-property start (point) 'face anything-face))

            (dolist (match matches)
              (insert match "\n")))))

      (goto-char (point-min))
      (anything-next-line))))


(defun anything ()
  (interactive)
  (let ((winconfig (current-window-configuration)))
    (add-hook 'post-command-hook 'anything-check-input)
    (setq anything-previous-input "")
    (pop-to-buffer anything-buffer)
    (setq cursor-type nil)
    (setq mode-name "Anything")

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

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

    (let ((selection ""))
      (unwind-protect
          (progn
            (anything-update)
            (let ((minibuffer-local-map anything-map))
              (read-string "pattern: ")
              (unless (= (buffer-size (get-buffer anything-buffer)) 0)
                (setq selection (buffer-substring-no-properties
                                 (overlay-start anything-overlay)
                                 (1- (overlay-end anything-
overlay)))))))

        (with-current-buffer anything-buffer
          (setq cursor-type t))
        (remove-hook 'post-command-hook 'anything-check-input)
        (set-window-configuration winconfig))

      (unless (equal selection "")
        (with-current-buffer anything-buffer
          (let* ((header-end (anything-get-previous-header-pos))
                 (header (save-excursion
                           (assert header-end)
                           (goto-char header-end)
                           (forward-line -1)
                           (buffer-substring-no-properties
                            (line-beginning-position) (line-end-
position))))
                 (source (some (lambda (source)
                                 (if (equal (cdr (assoc 'heading
source))
                                            header)
                                     source))
                               anything-sources)))
            (funcall (cdr (assoc 'action source)) selection)))))))



(defun anything-previous-line ()
  "Move selection to the previous line."
  (interactive)
  (anything-move-selection 'line 'previous))


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


(defun anything-previous-page ()
  "Move selection back with a pageful."
  (interactive)
  (anything-move-selection 'page 'previous))


(defun anything-next-page ()
  "Move selection forward with a pageful."
  (interactive)
  (anything-move-selection 'page 'next))


(defun anything-previous-section ()
  "Move selection to the previous section."
  (interactive)
  (anything-move-selection 'section 'previous))


(defun anything-next-section ()
  "Move selection to the next section."
  (interactive)
  (anything-move-selection 'section 'next))


(defun anything-move-selection (unit direction)
  "Move the selection marker to a new position determined by
UNIT and DIRECTION."
  (unless (= (buffer-size (get-buffer anything-buffer)) 0)
    (save-selected-window
      (select-window (get-buffer-window anything-buffer))

      (case unit
        (line (forward-line (case direction
                              (next 1)
                              (previous -1)
                              (t (error "Invalid direction.")))))

        (page (case direction
                (next (condition-case nil
                          (scroll-up)
                        (end-of-buffer (goto-char (point-max)))))
                (previous (condition-case nil
                              (scroll-down)
                            (beginning-of-buffer (goto-char (point-
min)))))
                (t (error "Invalid direction."))))

        (section (case direction
                   (next (goto-char (or (anything-get-next-header-pos)
                                        (point-max))))
                   (previous (progn
                               (forward-line -1)
                               (unless (eq (line-beginning-position)
                                           (point-min))
                                 (if (anything-pos-header-line-p
                                      (line-end-position))
                                     (forward-line -1)
                                   (forward-line 1))
                                 (goto-char (anything-get-previous-
header-pos
                                             (line-end-position))))))
                   (t (error "Invalid direction."))))

        (t (error "Invalid unit.")))

      (when (anything-pos-header-line-p (line-end-position))
          (forward-line (if (and (eq direction 'previous)
                                 (not (eq (line-beginning-position)
                                          (point-min))))
                            -1
                          1)))

      (if (eobp)
          (forward-line -1))

      (move-overlay anything-overlay
                    (line-beginning-position)
                    (1+ (line-end-position))))))


(defun anything-exit-minibuffer ()
  (interactive)
  (exit-minibuffer))


(defun anything-get-next-header-pos ()
  (let ((pos (overlay-start anything-overlay)))
    (while (and (setq pos (next-single-property-change pos 'face))
                (not (anything-pos-header-line-p pos))))
    pos))


(defun anything-get-previous-header-pos (&optional pos)
  (unless pos
    (setq pos (overlay-end anything-overlay)))
  (while (and (setq pos (previous-single-property-change pos 'face))
              (not (anything-pos-header-line-p (1- pos)))))
  pos)


(defun anything-pos-header-line-p (pos)
  (eq (get-text-property pos 'face) anything-face))


(provide 'anything)