[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
;;; anything.el --- open anything
From: |
address@hidden |
Subject: |
;;; anything.el --- open anything |
Date: |
Fri, 22 Jun 2007 04:38:35 -0700 |
User-agent: |
G2/1.0 |
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)