1 ;; -*- mode: emacs-lisp -*-
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ;; This program is free software; you can redistribute it and/or ;;
5 ;; modify it under the terms of the GNU General Public License as ;;
6 ;; published by the Free Software Foundation; either version 3, or (at ;;
7 ;; your option) any later version. ;;
9 ;; This program is distributed in the hope that it will be useful, but ;;
10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;
12 ;; General Public License for more details. ;;
14 ;; You should have received a copy of the GNU General Public License ;;
15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;
17 ;; Written by and Copyright (C) Francois Fleuret ;;
18 ;; Contact <francois@fleuret.org> for comments & bug reports ;;
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 ;; The selector/select function provides a simple interface for
22 ;; selecting an object with on-the-fly pattern matching in a standard
23 ;; buffer (i.e. not in the minibuffer). You can either use it in your
24 ;; own functions or directly use selector/quick-pick-recent or
25 ;; selector/quick-move-in-buffer.
27 ;; For instance, you can add in your .emacs.el
32 ;; (when (load "selector" t t)
33 ;; (define-key global-map [(control x) (control r)] 'selector/quick-pick-recent)
34 ;; (define-key global-map [(control c) (control s)] 'selector/quick-move-in-buffer)
35 ;; (define-key global-map [(control x) (control b)] 'selector/switch-buffer)
39 "Major mode for selection of entries with dynamic pattern matching"
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43 ;; User-configurable variables
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
46 (defcustom selector/memorize-entry-only-on-motions t
47 "If non-nil, only the cursor motions memorize the current selection.
48 Restriction of the selection does not. This means that if you
49 change the pattern and then edit it to cancel the change, the
50 cursor will come back to its original location, unless you have
51 explicitely moved it with the arrow keys at some point."
55 (defcustom selector/info-in-mode-line nil
56 "If nil, the pattern is shown in the menu header.
57 Otherwise use the mode-line."
61 (defcustom selector/always-create-buffer nil
62 "If nil, re-use existing similar buffer when possible."
66 (defcustom selector/mode-hook nil
67 "Hook called at the end of the selector mode initialization."
71 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73 (defface selector/selection
75 '((t (:background "chartreuse")))
76 "The face for the current selection.")
79 '((t (:foreground "gray70")))
80 "The face for dimmed entries.")
82 (defface selector/date
83 '((t (:foreground "dark violet")))
84 "The face for the dates in selector/quick-pick-recent.")
86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88 (defvar selector/pattern
90 "The pattern to match to appear in the selector buffer.")
92 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 (defun selector/string-match-all (regexps string)
95 "Return if STRING matches all regular expressions in REGEXPS."
97 (and (string-match (car regexps) string)
98 (selector/string-match-all (cdr regexps) string))
101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103 (defun selector/move-highlight-overlay ()
104 "Move the highlight overlay to highlight the current line."
105 (if (get-text-property (point) 'entry)
106 (move-overlay selector/highlight-overlay
107 (or (previous-single-property-change (1+ (point)) 'entry)
109 (or (next-single-property-change (point) 'entry)
111 ;; (move-overlay selector/highlight-overlay 0 0)
112 (delete-overlay selector/highlight-overlay)
115 (unless (and selector/memorize-entry-only-on-motions
117 '(selector/delete-backward-char
118 selector/self-insert-command)))
119 (setq selector/current-entry (get-text-property (point) 'entry)))
122 (defun selector/refresh ()
123 "Erase and reconstruct the content of the current buffer
124 according to `selector/entries' and `selector/pattern'."
126 (let ((inhibit-read-only t)
128 (line-beginning (line-beginning-position))
129 (regexps (mapcar 'regexp-quote (split-string selector/pattern ";")))
131 (nb-shown-entries 0))
136 (when (selector/string-match-all regexps (car s))
137 (setq nb-shown-entries (1+ nb-shown-entries))
138 (if (eq (cdr s) selector/current-entry)
139 (setq newpos (+ (- pos line-beginning) (point))))
141 (propertize (concat (car s) "\n")
143 ;; 'face 'compilation-error
147 (setq newpos (min newpos (point-max)))
148 (setq selector/nb-shown-entries (number-to-string nb-shown-entries))
150 (goto-char (or (and (get-text-property newpos 'entry) newpos)
151 (previous-single-property-change newpos 'entry)
155 (force-mode-line-update)
158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160 (defun selector/self-insert-command ()
161 "Insert the last pressed key at the end of `selector/pattern'."
163 (setq selector/pattern (concat selector/pattern
164 (this-command-keys)))
168 (defun selector/delete-backward-char ()
169 "Remove the last character of `selector/pattern'."
171 (when (> (length selector/pattern) 0)
172 (setq selector/pattern (substring selector/pattern 0 -1)))
176 (defun selector/kill-line ()
177 "Move the content of `selector/pattern' to the kill ring."
179 (kill-new selector/pattern t)
180 (setq selector/pattern "")
183 (defun selector/yank (&optional arg)
184 "Append the content of the kill ring to `selector/pattern'."
186 (setq selector/pattern (concat selector/pattern
193 (defun selector/return ()
194 "Call the function specified by `selector/callback' with the
195 entry at point as parameter."
197 (let ((result (get-text-property (point) 'entry))
198 (callback selector/callback))
200 (if result (funcall callback result)
201 (error "No selection"))))
203 (defun selector/goto-next-entry ()
204 "Move point to the next entry."
206 (let ((n (or (next-single-property-change (point) 'entry)
208 (if n (goto-char n))))
210 (defun selector/goto-previous-entry ()
211 "Move point to the previous entry."
213 (let ((n (or (previous-single-property-change (point) 'entry)
214 (previous-single-property-change (point-max) 'entry))))
215 (if n (goto-char n))))
217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
219 (defun selector/mode ()
220 "Mode for selection of strings. See `selector/select' for a
221 detailed explanation."
223 (unless (boundp 'selector/map)
224 (setq selector/map (make-sparse-keymap))
227 (substitute-key-definition (car p)
229 selector/map global-map)
232 ;; What are the functions to substitute by what
233 '((self-insert-command . selector/self-insert-command)
234 (delete-backward-char . selector/delete-backward-char)
235 (kill-line . selector/kill-line)
236 (yank . selector/yank)
237 (newline . selector/return)
238 ;; (keyboard-quit . kill-this-buffer)
241 (define-key selector/map "\C-g"
244 (define-key selector/map (kbd "TAB")
245 'selector/goto-next-entry)
247 (define-key selector/map [(shift iso-lefttab)]
248 'selector/goto-previous-entry)
252 (setq major-mode 'selector/mode
258 (if selector/info-in-mode-line 'mode-line-format 'header-line-format)
259 '(" " selector/nb-shown-entries "/"
260 selector/nb-total-entries " pattern: " selector/pattern)
263 (buffer-disable-undo)
264 (use-local-map selector/map)
265 (run-hooks 'selector/mode-hook)
268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
270 (defun selector/select (entries callback &optional name)
271 "Open a new buffer showing dynamically a subset of entries
272 matching a pattern that can be changed by pressing the usual
273 \"insertable\" symbols or backspace. Pressing the enter key
274 validates the selection.
276 Note that the pattern is not a regexp but a series of substrings
277 separated by `;'s that have all to be present.
279 The key mapping is hacked so that the keys associated to
280 `self-insert-command', `delete-backward-char', `kill-line',
281 `yank' and `newline' are associated to functions which do somehow
282 what they are supposed to do. The latter validating the
285 ENTRIES is a list of cons cells, each composed of a string to
286 display and an object to pass as the unique parameter to CALLBACK
287 when the user actually does a selection. The optional NAME
288 parameter specifies the name to give to the buffer.
290 Setting `selector/memorize-entry-only-on-motions' to non-nil
291 means that the entry to keep the cursor on when changing the
292 selection is set only on cursor motions. To show the pattern in
293 the modeline set `selector/info-in-mode-line'. The header line is
294 used by default. To always open a new buffer and not re-use an
295 existing buffer with the same name, set
296 `selector/always-create-buffer' to non-nil.
298 There seems to be header-line refreshing problems with emacs21."
303 (if selector/always-create-buffer 'generate-new-buffer-name 'identity)
304 (or name "*selector*"))))
306 (set (make-local-variable 'selector/entries) entries)
307 (set (make-local-variable 'selector/callback) callback)
308 (set (make-local-variable 'selector/pattern) "")
309 (set (make-local-variable 'selector/highlight-overlay) (make-overlay 0 0))
310 (set (make-local-variable 'selector/current-entry) nil)
311 (set (make-local-variable 'selector/nb-total-entries)
312 (number-to-string (length entries)))
313 (set (make-local-variable 'selector/nb-shown-entries) "?")
315 (overlay-put selector/highlight-overlay 'face 'selector/selection)
317 (add-hook 'post-command-hook 'selector/move-highlight-overlay nil t)
322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
323 ;; To open recent files
324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
326 (defun selector/filename-to-string (filename)
327 "Generate the line associated to a filename for `selector/quick-pick-recent'"
330 (if (file-remote-p s)
333 (format-time-string "%a %b %e" (elt (file-attributes s) 5))
334 'face 'selector/date))
338 (if (string-match abbreviated-home-dir s)
340 (substring s 0 (match-end 0)) 'face 'selector/dim)
341 (substring s (match-end 0)))
346 (defun selector/find-file (filename)
347 "Callback function for `selector/quick-pick-recent'. When
348 called with a universal argument, allows the user to edit the
351 (if current-prefix-arg
352 (find-file (read-file-name
354 (file-name-directory filename)
357 (file-name-nondirectory filename)))
358 (find-file filename)))
360 (defun selector/quick-pick-recent ()
361 "Open a file picked in `recentf-list' with the dynamic
362 pattern-matching search implemented in `selector/select'. With a
363 prefix argument, allows to edit the filename after selection."
366 (unless (and (boundp recentf-mode) recentf-mode)
367 (error "recentf mode must be turned on"))
373 (cons (selector/filename-to-string s) s))
377 "*selector find-file*"
380 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
381 ;; To search in the current buffer
382 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
384 (defun selector/quick-move-in-buffer ()
385 "Move the cursor in the current buffer to a line selected
386 dynamically with `selector/select'."
392 (goto-char (point-min))
393 (while (< (point) (point-max))
394 (setq l (cons (cons (buffer-substring (point-at-bol) (point-at-eol))
400 "*selector buffer move*"
403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
404 ;; To switch between buffers
405 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
407 (defun selector/switch-buffer () (interactive)
408 "Select the current buffer dynamically with `selector/select'."
414 (with-current-buffer buffer
415 (let ((name (buffer-name))
417 (file (buffer-file-name))
418 (modified (buffer-modified-p)))
419 (when (not (string-match "^ +" name))
422 (replace-regexp-in-string
428 (if modified "*" "-")
431 (replace-regexp-in-string abbreviated-home-dir
438 (reverse (buffer-list)))
441 "*selector switch-buffer*"
444 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
445 ;; To search among sentences (i.e. between periods, not between \n)
446 ;; This is work in progress, it currently looks kind of ugly but is
447 ;; already useful to navigate in a long article
448 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
450 (defun selector/search-sentence ()
451 "Move the cursor to a sentence chosen dynamically with
455 (let ((sentences nil))
457 (goto-char (point-min))
458 (while (re-search-forward "[^.]+\\." nil t)
459 (let ((s (replace-regexp-in-string "^[ \n]+" ""
460 (match-string-no-properties 0)))
461 (p (match-beginning 0)))
462 (setq s (replace-regexp-in-string "[ \n]+$" "" s))
463 (when (> (length s) 1)
467 (fill-region (point-min) (point-max))
473 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
475 (defface selector/dir
476 '((t (:foreground "red")))
477 "The face for directories.")
479 (defface selector/symlink
480 '((t (:foreground "blue")))
481 "The face for symlinks.")
483 (defun selector/rec-find-file (&optional filename) (interactive)
484 (setq filename (or filename
485 (and (buffer-file-name) (file-name-directory (buffer-file-name)))
488 (if (file-regular-p filename) (find-file filename)
492 (let ((f (car file)))
494 (if (file-regular-p f)
496 (if (file-symlink-p f)
497 (propertize f 'face 'selector/symlink)
498 (propertize f 'face 'selector/dir)))
499 (concat filename "/" f))))
500 (directory-files-and-attributes filename))
501 'selector/rec-find-file
502 (concat "selector " filename)
505 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;