@@ -8,6 +8,6 @@ loaddefs = Builder(action = "$EMACS $EFLAGS -eval '(progn (load-library \"autolo src_suffix = '.el', suffix = '.elc') -env = Environment(BUILDERS = {'Elisp' : elisp, 'Loaddefs' : loaddefs}, EMACS = 'emacs-cvs', EFLAGS = '-L custom -L lib -batch -l ~/.emacs-local', ENV = os.environ) +env = Environment(BUILDERS = {'Elisp' : elisp, 'Loaddefs' : loaddefs}, EMACS = 'emacs-cvs', EFLAGS = '-L custom -L lib -l ~/.emacs-local -batch', ENV = os.environ) SConscript(['custom/SConscript', 'config/SConscript', 'lib/SConscript'], exports='env') SConstruct @@ -215,6 +215,8 @@ will be part of the list returned." commands)))))) commands)) + (require 'rcirc-late-fix) + (defun-rcirc-command retake (arg) "Retake your nick from NickServ. This sends a RECOVER <nick> <password> to NickServ, @@ -237,11 +239,11 @@ command. This uses `rcirc-default-nick'." (concat "RECOVER " rcirc-default-nick " " password)) (sit-for 1) (rcirc-send-message process "NickServ" - (concat "RELEASE " rcirc-default-nick " " password)) + (concat "RELEASE " rcirc-default-nick " " password)) (sit-for 1) (rcirc-send-string process (concat "NICK " rcirc-default-nick)))) - - (require 'rcirc-late-fix))) + + )) (provide 'rcirc-config) ;;; rcirc-config.el ends here config/rcirc-config.el @@ -604,7 +604,6 @@ With prefix argument, turn on if ARG > 0; else turn off." (setq js2-use-font-lock-faces t) (require 'epa-dired) -(add-hook 'dired-mode-hook 'epa-dired-mode-hook) (epa-file-enable) (add-hook 'mail-mode-hook 'epa-mail-mode) dotemacs.el @@ -1,35 +1,89 @@ -;;; buff-menu-plus.el --- Extensions to `buff-menu.el'. New bindings. -;;; FILE NAME SHOULD BE buff-menu+.el, but EmacsWiki doesn't like that. -;; -;; Emacs Lisp Archive Entry +;;; buff-menu+.el --- Extensions to `buff-menu.el'. -*- coding:utf-8 -*- +;; ;; Filename: buff-menu+.el ;; Description: Extensions to `buff-menu.el' ;; Author: Drew Adams ;; Maintainer: Drew Adams -;; Copyright (C) 1996-2004, Drew Adams, all rights reserved. +;; Copyright (C) 1996-2008, Drew Adams, all rights reserved. ;; Created: Mon Sep 11 10:29:56 1995 -;; Version: $Id: buff-menu+.el 195 2006-06-25 15:37:05Z yann $ -;; Last-Updated: Wed Jul 21 15:01:33 2004 +;; Version: 21.0 +;; Last-Updated: Sat Feb 9 17:15:15 2008 (Pacific Standard Time) ;; By: dradams -;; Update #: 741 -;; Keywords: mouse, local -;; Compatibility: GNU Emacs 20.x -;; +;; Update #: 2423 +;; URL: http://www.emacswiki.org/cgi-bin/wiki/buff-menu+.el +;; Keywords: mouse, local, convenience +;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x +;; +;; Features that might be required by this library: +;; +;; `avoid', `fit-frame', `frame-fns', `misc-cmds', `misc-fns'. +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: ;; -;; Extensions to `buff-menu.el'. New bindings & fonts & menu. +;;; Commentary: +;; +;; Extensions to `buff-menu.el', including: new bindings, faces, +;; and menus; selective column display; and directional column +;; sorting. ;; -;; `Buffer-menu-mouse-3-menu' popup menu added. -;; New prefix arg options for `buffer-menu'. +;; Faces defined here: ;; -;; Main new functions defined here: +;; `buffer-menu-headings', `buffer-menu-current-buffer', +;; `buffer-menu-directory-buffer', `buffer-menu-flagged-buffer', +;; `buffer-menu-marked-buffer', `buffer-menu-star-buffer', +;; `buffer-menu-view-mark', `buffer-menu-delete-mark', +;; `buffer-menu-save-mark', `buffer-menu-modified-mark', +;; `buffer-menu-read-only-mark', `buffer-menu-buffer-name', +;; `buffer-menu-mode', `buffer-menu-size', `buffer-menu-time', +;; `buffer-menu-file-name'. ;; +;; User options defined here (Emacs 22+): +;; +;; `Buffer-menu-file-flag', `Buffer-menu-mode-flag', +;; `Buffer-menu-time-flag', `Buffer-menu-time-format'. +;; +;; Commands defined here: +;; +;; `buffer-menu-decrease-max-buffer+size' (Emacs 22+), +;; `Buffer-menu-delete-flagged', +;; `buffer-menu-increase-max-buffer+size' (Emacs 22+), ;; `Buffer-menu-mouse-3-menu', `Buffer-menu-mouse-delete', ;; `Buffer-menu-mouse-execute', `Buffer-menu-mouse-modified', ;; `Buffer-menu-mouse-other-window', `Buffer-menu-mouse-save', -;; `Buffer-menu-mouse-unmark'. +;; `Buffer-menu-mouse-unmark', `buffer-menu-toggle-file-column' +;; (Emacs 22+), `buffer-menu-toggle-mode-column' (Emacs 22+), +;; `buffer-menu-toggle-time-column' (Emacs 22+), +;; `buffer-menu-toggle-time-format' (Emacs 22+). +;; +;; Internal variables defined here: +;; +;; `buffer-menu-buffer-name', +;; `Buffer-menu-buffer+size-computed-width', +;; `buffer-menu-current-buffer', `buffer-menu-directory-buffer', +;; `buffer-menu-flagged-buffer', `buffer-menu-marked-buffer', +;; `buffer-menu-star-buffer', `buffer-menu-delete-mark', +;; `buffer-menu-file-name', `buffer-menu-font-lock-keywords', +;; `buffer-menu-headings', `buffer-menu-mode', +;; `buffer-menu-modified-mark', `buffer-menu-read-only-mark', +;; `buffer-menu-save-mark', `buffer-menu-size', `buffer-menu-time', +;; `buffer-menu-view-mark'. +;; +;; Other functions defined here: +;; +;; `Buffer-menu-fontify-and-adjust-frame', +;; `buffer-menu-set-default-value'. +;; +;; +;; ***** NOTE: The following user option (variable) defined in +;; `buff-menu.el' has been REDEFINED HERE: +;; +;; `Buffer-menu-sort-column' - A user option now. Numeric, default=1. +;; +;; +;; ***** NOTE: The following hook defined in `buff-menu.el' +;; has been REDEFINED HERE: +;; +;; `buffer-menu-mode-hook' - Fontifies buffer and fits its frame. ;; ;; ;; ***** NOTE: The following functions defined in `buff-menu.el' @@ -40,23 +94,171 @@ ;; 2. Prefix ARG =< 0 now means list (all) buffers alphabetically. ;; (It used to mean the same as ARG > 0.) ;; Prefix ARG >= 0 means list just file buffers. -;; 3. Call `font-lock-fontify-buffer' at end. +;; 3. Use pop-to-buffer instead of switch-to-buffer. +;; `Buffer-menu-beginning' - Protected with `boundp' for Emacs 20. +;; `Buffer-menu-buffer+size' - Use computed width for Buffer + Size. ;; `Buffer-menu-execute' - Deletes windows (frame) when kills buffer. +;; `Buffer-menu-make-sort-button' - +;; 1. If same column as last sort, flip direction of sort. +;; 2. Column header face indicates sort direction. +;; 3. CRM is indicated by COLUMN = 1, not by nil COLUMN. ;; `Buffer-menu-mode' - ;; 1. Doc string reflects new bindings. ;; 2. mouse-face on whole line, not just buffer name. +;; 3. Compatible with Emacs prior to Emacs 22 also. ;; `Buffer-menu-select' - When Buffer Menu is `window-dedicated-p', ;; uses `pop-to-buffer' to display. +;; `Buffer-menu-sort' - +;; 1. Allow negative COLUMN. Allow COLUMN = 1 or -1. +;; 2. When COLUMN = `Buffer-menu-sort-column', then flip that. +;; 3. Added message at end indicating the kind of sort. +;; `list-buffers-noselect' - Change sort direction if same column. +;; - Add sort button for CRM (visited order). +;; - Bug fix: Temporarily set +;; `window-dedicated-p' to nil to allow +;; revert-buffer. (Emacs 21 only) ;; ;; ;; This file should be loaded after loading the standard GNU file ;; `buff-menu.el'. So, in your `~/.emacs' file, do this: ;; (eval-after-load "buff-menu" '(require 'buff-menu+)) ;; +;; Note: This file must be saved with encoding UTF-8 or equivalent, +;; because it contains an em-dash character. +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; +;; ;;; Change log: -;; +;; +;; 2008/02/09 dadams +;; Added: Buffer-menu-delete-flagged. Bound to C-M-x and added to Buffer-menu-mouse-3-menu. +;; 2008/02/05 dadams +;; Added: buffer-menu-toggle-time-format, Buffer-menu-time-format. +;; buffer-menu-font-lock-keywords, list-buffers-noselect: Treat short and long time formats. +;; list-buffers-noselect: Extend column buttons from one column to the next (beyond text). +;; Removed optional arg for column toggles. +;; Renamed buffer-menu-set-flag to buffer-menu-set-default-value. +;; Buffer-menu-buffer+size: Add name-props and size-props only if non-nil. +;; 2008/02/04 dadams +;; buffer-menu-font-lock-keywords: Highlight Dired buffer name even if no Mode. +;; Allow multiple digits in <N>. +;; list-buffers-noselect: +;; Compute longest buffer name + size combination, and use when indenting file name. +;; Added: Buffer-menu-buffer+size, buffer-menu-(de|in)crease-max-buffer+size (and bound), +;; Buffer-menu-buffer+size-computed-width. +;; buffer-menu: Updated doc string. +;; Thx to Tom Wurgler for suggestions. +;; 2008/02/03 dadams +;; buffer-menu-font-lock-keywords: Highlight Dired buffer name, if file flag but no mode flag. +;; 2008/02/01 dadams +;; Allow <0-9> after star buffer names. Thx to Tom Wurgler. +;; 2008/01/31 dadams +;; Added options to hide columns. Thx to Tom Wurgler for the suggestion. +;; Buffer-menu-*-flag, and changed buffer-menu-font-lock-keywords accordingly. +;; list-buffers-noselect: Update for Buffer-menu-*-flag. +;; Added: *-set-flag, *-toggle-*-column, buffer-menu-font-lock-keywords (function). +;; Group Buffer-Menu-Plus: Remove prefix. Different parent group for Emacs 22. +;; 2008/01/05 dadams +;; list-buffers-noselect: Eval underline char at compile time - see comment. +;; Buffer-menu-sort-column: Made it a user option. +;; Removed: Buffer-menu-sort-button-map, Buffer-menu-sort-by-column. +;; Don't define for Emacs before version 22: Buffer-menu-make-sort-button, Buffer-menu-sort*. +;; 2007/09/23 dadams +;; Removed second arg to undefine-killer-commands. +;; Brought up to date with Emacs 22. +;; 2007/02/28 dadams +;; buffer-menu-font-lock-keywords: regexp tweaks. +;; 2007/02/26 dadams +;; Added: buffer-menu-(star|directory|marked|flagged)-buffer. +;; buffer-menu-font-lock-keywords: Treat new faces. Thx to Tom Wurgler <twurgl@goodyear.com>. +;; 2007/02/16 dadams +;; buffer-menu: Fixed use of negative arg when using header line. +;; list-buffers-noselect: +;; Don't sort if sort column is 1 or -1. Instead, just don't reverse list if -1. +;; Go to point-min if desired-point is not defined. +;; Buffer-menu-make-sort-button: Different help echoes for CRM and Buffer. +;; Buffer-menu-sort, Buffer-menu-make-sort-button: +;; Add to help message for CRM sort: mention Buffer-menu-use-frame-buffer-list. +;; Buffer-menu-mode: Mention sorting columns in doc string. +;; Add defvar for Buffer-menu-use-frame-buffer-list to quiet byte compiler. +;; Changed all Emacs 22 tests to test emacs-major-version. +;; 2007/02/05 dadams +;; list-buffers-noselect: Use ?\u2014 for the EM dash. Thx to Henry Atting. +;; 2007/02/02 dadams +;; Added coding declaration to file header. Thx to Henry Atting. +;; Changed temporary emacs version tests to > emacs 21. +;; 2006/04/10 dadams +;; list-buffers-noselect: Updated Emacs 22 version wrt latest CVS version. +;; 2006/01/07 dadams +;; Added :link for sending bug report. +;; 2006/01/06 dadams +;; Added defgroup 'Buffer-Menu-Plus. Added :link. +;; 2005/11/04 dadams +;; Added: Buffer-menu-sort-button-map, Buffer-menu-sort-by-column, if not available in Emacs. +;; 2005/11/01 dadams +;; Buffer-menu-make-sort-button: Updated to reflect latest CVS version: +;; Added text property: column. Use Buffer-menu-sort-button-map. +;; Mention mouse-1 in :help. +;; 2005/07/08 dadams +;; Buffer-menu-fontify-and-adjust-frame: Wrapped in save-*excursion's. +;; 2005/07/04 dadams +;; Buffer-menu-fontify-and-adjust-frame: Fixed typo: boundp -> fboundp. +;; 2005/06/22 dadams +;; Use defface for faces now. +;; Renamed faces: *-face to *. +;; No longer require def-face-const.el. +;; 2005/06/21 dadams +;; list-buffers-noselect: Emacs 22 renamed Buffer-menu-buffer-face to Buffer-menu-buffer. +;; 2005/05/17 dadams +;; Updated to work with Emacs 22.x. +;; 2004/12/05 dadams +;; Buffer-menu-execute, Buffer-menu-mouse-execute: minor corrections. +;; 2004/11/30 dadams +;; Added Time column (with sorting). +;; Added buffer-menu-time-face. +;; Buffer-menu-sort, Buffer-menu-make-sort-button, list-buffers-noselect, +;; list-buffers-noselect: Major changes: Time column, updated to latest CVS (new 2nd arg) etc. +;; buffer-menu-font-lock-keywords: Rewrote for time etc. +;; Sort CRM column also now. +;; Buffer-menu-fontify-and-fit-frame renamed to Buffer-menu-fontify-and-adjust-frame. +;; Added raise-frame (but Emacs bug, so raise doesn't work on Windows). +;; turn-on-font-lock, instead of font-lock-fontify-buffer. +;; Removed defvar ;;;###autoload's. +;; 2004/11/23 dadams +;; buffer-menu-mode-hook: call font-lock-fontify-buffer. +;; buffer-menu: Do not call font-lock-fontify-buffer. +;; Added Buffer-menu-fontify-and-fit-frame. Hook fits frame too. +;; Require fit-frame.el. +;; Removed Buffer-menu-revert. +;; 2004/11/20 dadams +;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x) +;; 2004/11/19 dadams +;; Protected tests of Buffer-menu-use-header-line with boundp for older versions. +;; 2004/11/13 dadams +;; buffer-menu-font-lock-keywords: overwrite for *-mode-face, *-size-face, *-file-name-face. +;; 2004/10/17 dadams +;; Updated to include Daniel Pfeiffer's fix to buff-menu.el of bug I reported on losing +;; marks when you sort columns: +;; 1) Added Buffer-menu-revert-function, 2) Added (and modified) Buffer-menu-beginning, +;; 3) Use Buffer-menu-beginning in Buffer-menu-execute and Buffer-menu-select, +;; 4) Buffer-menu-sort: incorporated Daniel's mark-saving code. +;; Note: when the new version comes out (from CVS), I will 1) update list-buffers-noselect +;; to new version that uses 4-arg version of format-mode-line and 2) remove new definition +;; of Buffer-menu-revert-function added here now. +;; 2004/10/16 dadams +;; Added directional column sorting, with highlighting: +;; Added: Buffer-menu-make-sort-button, Buffer-menu-sort. +;; list-buffers-noselect: Add sort button for CRM. Sort directionally. +;; Only require cl.el when compile. +;; Buffer-menu-revert: Fontify for Emacs 21 also (needed after revert). +;; 2004/10/15 dadams +;; Buffer-menu-mode: Don't skip first two lines if Buffer-menu-use-header-line. +;; 2004/10/13 dadams +;; Updated for Emacs 21: +;; buffer-menu-font-lock-keywords, Buffer-menu-mode, Buffer-menu-execute, Buffer-menu-select +;; Added list-buffers-noselect for Emacs 21 (bug fix). +;; require cl.el only when compile on Emacs 20. +;; Added Buffer-menu-revert: Fontifies. ;; 2004/07/21 dadams ;; Buffer-menu-mode: Don't set Buffer-menu-buffer-column unless < Emacs 20. ;; 2001/01/02 dadams @@ -98,9 +300,9 @@ ;; Buffer-menu-mode: Added bindings list to doc string. ;; 1995/09/11 dadams ;; Redefined Buffer-menu-execute: deletes frame w/ kill. -;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; +;; ;; This program 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) @@ -112,105 +314,457 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: +;; +;;; Code: ;; Cannot do (require 'buff-menu), because `buff-menu.el' does no `provide'. ;; Don't want to do a (load-library "buff-menu") either, because it wouldn't ;; allow doing (eval-after-load "buff-menu" '(progn (require 'buff-menu+))) -(require 'cl) ;; push, pop, unless - -;; Get macro `define-face-const' when this is compiled, -;; or run interpreted, but not when the compiled code is loaded. -(eval-when-compile (require 'def-face-const)) +(eval-when-compile (require 'cl)) ;; case, (plus, for Emacs 20: push, pop, dolist, + ;; and, for Emacs <20: cadr, when, unless) (require 'misc-fns nil t) ;; (no error if not found): undefine-killer-commands (require 'misc-cmds nil t) ;; (no error if not found): kill-buffer-and-its-windows +(require 'fit-frame nil t) ;; (no error if not found): fit-frame +;; To quiet the byte compiler: +(unless (> emacs-major-version 21) + (defvar Buffer-menu-use-header-line) + (defvar Buffer-menu-use-frame-buffer-list) + (defvar Buffer-menu-files-only) + (defvar Buffer-menu-mode-width) + (defvar Buffer-menu-buffer+size-width) + (defvar Buffer-menu-time-flag) + (defvar Buffer-menu-mode-flag) + (defvar Buffer-menu-file-flag) + (defvar Buffer-menu-sort-column) + (defvar Buffer-menu-sort-button-map) + (defvar header-line-format)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Undefine some bindings that would try to modify a buffer-menu buffer. -;;; Their key sequences will then appear to the user as available for -;;; local (Buffer Menu) definition. -(when (fboundp 'undefine-killer-commands) - (undefine-killer-commands Buffer-menu-mode-map (current-global-map))) +;;;###autoload +(unless (> emacs-major-version 21) + (defgroup Buffer-Menu-Plus nil + "Enhancements to the buffer menu." + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +buff-menu+.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") + :link '(url-link :tag "Download" + "http://www.emacswiki.org/cgi-bin/wiki/buff-menu+.el") + :link '(url-link :tag "Description" + "http://www.emacswiki.org/cgi-bin/wiki/BufferMenu#BufferMenuPlus") + :link '(emacs-commentary-link :tag "Commentary" "buff-menu+") + :group 'tools :group 'convenience)) + +;;;###autoload +(when (> emacs-major-version 21) + (defgroup Buffer-Menu-Plus nil + "Enhancements to the buffer menu." + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +buff-menu+.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") + :link '(url-link :tag "Download" + "http://www.emacswiki.org/cgi-bin/wiki/buff-menu+.el") + :link '(url-link :tag "Description" + "http://www.emacswiki.org/cgi-bin/wiki/BufferMenu#BufferMenuPlus") + :link '(emacs-commentary-link :tag "Commentary" "buff-menu+") + :group 'Buffer-menu :group 'tools :group 'convenience) + + (defvar Buffer-menu-buffer+size-computed-width 0 + "Max width of all buffer names, plus 4 for initial `CRM '.") + + (defun buffer-menu-increase-max-buffer+size () + "Increase option `Buffer-menu-buffer+size-width' by one." + (interactive) + (when (> (1+ Buffer-menu-buffer+size-width) 150) (error "Cannot increase further")) + (setq Buffer-menu-buffer+size-width (1+ Buffer-menu-buffer+size-width)) + (buffer-menu) + (message "New max width: %s" Buffer-menu-buffer+size-width)) + + (defun buffer-menu-decrease-max-buffer+size () + "Decrease option `Buffer-menu-buffer+size-width' by one." + (interactive) + (let ((orig Buffer-menu-buffer+size-width)) + (condition-case nil + (progn + (setq Buffer-menu-buffer+size-width (1- Buffer-menu-buffer+size-width)) + (buffer-menu) + (message "New max width: %s" Buffer-menu-buffer+size-width)) + (error (progn (setq Buffer-menu-buffer+size-width orig) + (buffer-menu) + (error "Cannot decrease further")))))) + + (define-key Buffer-menu-mode-map "+" 'buffer-menu-increase-max-buffer+size) + (define-key Buffer-menu-mode-map "-" 'buffer-menu-decrease-max-buffer+size) + (define-key Buffer-menu-mode-map "\C-\M-x" 'Buffer-menu-delete-flagged) + + (defun buffer-menu-toggle-time-format () + "Toggle `Buffer-menu-time-format' and redisplay Buffer Menu." + (interactive) + (buffer-menu-set-default-value 'Buffer-menu-time-format + (if (eq 'short Buffer-menu-time-format) 'long 'short)) + (buffer-menu)) + + (defun buffer-menu-toggle-time-column () + "Toggle `Buffer-menu-time-flag' and redisplay Buffer Menu." + (interactive) + (buffer-menu-set-default-value 'Buffer-menu-time-flag (not Buffer-menu-time-flag)) + (buffer-menu)) + + (defun buffer-menu-toggle-mode-column () + "Toggle `Buffer-menu-mode-flag' and redisplay Buffer Menu." + (interactive) + (buffer-menu-set-default-value 'Buffer-menu-mode-flag (not Buffer-menu-mode-flag)) + (buffer-menu)) + + (defun buffer-menu-toggle-file-column () + "Toggle `Buffer-menu-file-flag' and redisplay Buffer Menu." + (interactive) + (buffer-menu-set-default-value 'Buffer-menu-file-flag (not Buffer-menu-file-flag)) + (buffer-menu)) + + (defun buffer-menu-set-default-value (symb val) + "Set default value of SYMB to VAL. +Update `buffer-menu-font-lock-keywords' accordingly." + (set-default symb val) + (setq buffer-menu-font-lock-keywords (buffer-menu-font-lock-keywords))) + + (defun buffer-menu-font-lock-keywords () + "Returns the list of font lock keywords for the buffer menu." + (list + (list "^\\(CRM.*\\)" 1 'buffer-menu-headings) ; CRM + (list "^....\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+\\(.* \\(AM\\|PM\\)\\)?\\([^/\n]+\\)" + (list 1 'buffer-menu-buffer-name)) ; Default buffer name + (cond (Buffer-menu-mode-flag ; Directory buffer name + (list "^....\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+[a-zA-Z :0-9]*[ \t]+Dired" + 1 'buffer-menu-directory-buffer t t)) + (Buffer-menu-file-flag + (list "^....\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+[^/\n]+[ \t\n]\ +\\(\\([~]\\|\\([a-zA-Z]:\\)\\)?/.*/\\)$" + 1 'buffer-menu-directory-buffer t t)) + ;; We can't show that it's a directory, because we have no way of knowing that + (t (list ""))) + (list "^....\\(\\*.*[^ \t\n]\\*\\(<[0-9]+>\\)?\\)[ \t]+" ; Star buffer name (e.g. *scratch*) + 1 'buffer-menu-star-buffer t t) + ;; Time & Mode + (cond ((and Buffer-menu-time-flag Buffer-menu-mode-flag (eq 'short Buffer-menu-time-format)) + (list "^.*[ \t][0-9]+[ \t]+\\([0-2][0-9]:[0-5][0-9]:[0-5][0-9]\\)?\\([^\n]+\\)" + (list 1 'buffer-menu-time t t) (list 2 'buffer-menu-mode t t))) + ((and Buffer-menu-time-flag Buffer-menu-mode-flag) + (list "^.*[ \t][0-9]+[ \t]+\\(.* \\(AM\\|PM\\)\\)?\\([^\n]+\\)" + (list 1 'buffer-menu-time t t) (list 3 'buffer-menu-mode t t))) + (Buffer-menu-time-flag + (if (eq 'short Buffer-menu-time-format) + (list "^.*[ \t][0-9]+[ \t]+\\([0-2][0-9]:[0-5][0-9]:[0-5][0-9]\\)?" + (list 1 'buffer-menu-time t t)) + (list "^.*[ \t][0-9]+[ \t]+\\(.* \\(AM\\|PM\\)\\)?" (list 1 'buffer-menu-time t t)))) + (Buffer-menu-mode-flag + (list "^.*[ \t][0-9]+[ \t]+\\([^/\n]+\\)" 1 'buffer-menu-mode t t)) + (t "")) + (list "^.*[ \t]\\([0-9]+\\)\\( \\|[\n]\\)" 1 'buffer-menu-size t t) ; Size + (if Buffer-menu-file-flag + (list "^.*[ \t][0-9]+[ \t]+[^/\n]+[ \t\n]\ +\\(\\(\\([~]\\|\\([a-zA-Z]:\\)\\)*/.*\\)\\|([^ \t]+).*\\)$" ; File name of Info file + node + 1 'buffer-menu-file-name t t) + "") + (list "^\\([.]\\)" 1 'buffer-menu-current-buffer t t) ; Current buffer mark (.) + (list "^\\(>\\)" 1 'buffer-menu-view-mark t t) ; To view mark (>) + (list "^>...\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+\\(.* \\(AM\\|PM\\)\\)?\\([^/\n]+\\)" + (list 1 'buffer-menu-marked-buffer 'prepend t)) ; Buffer name when marked (>) + (list "^D...\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+\\(.* \\(AM\\|PM\\)\\)?\\([^/\n]+\\)" + (list 1 'buffer-menu-flagged-buffer t t)) ; Buffer name when flagged (D) + (list "^\\(D\\)" 1 'buffer-menu-delete-mark t t) ; Deletion flag (D) + (list "^..\\(S\\)" 1 'buffer-menu-save-mark t t) ; Save flag (S) + (list "^..\\([*]\\)" 1 'buffer-menu-modified-mark t t) ; Buffer-modified-p (*) + (list "^.\\(%\\)" 1 'buffer-menu-read-only-mark t t) ; Read-only-p (%) + )) + + (defcustom Buffer-menu-time-format 'short + "*Format for Time column of buffer menu." + :type '(choice + (const :tag "Short: hh:mm:ss" short) + (const :tag "Long: day hh:mm:ss AM/PM" long)) + :group 'Buffer-Menu-Plus) + + (defcustom Buffer-menu-time-flag t + "*Non-nil means Buffer Menu displays the last time the buffer was displayed." + :type 'boolean :group 'Buffer-Menu-Plus + :initialize 'custom-initialize-default + :set 'buffer-menu-set-default-value) + + (defcustom Buffer-menu-mode-flag t + "*Non-nil means Buffer Menu displays the buffer's mode." + :type 'boolean :group 'Buffer-Menu-Plus + :initialize 'custom-initialize-default + :set 'buffer-menu-set-default-value) + + (defcustom Buffer-menu-file-flag t + "*Non-nil means Buffer Menu displays the buffer's file." + :type 'boolean :group 'Buffer-Menu-Plus + :initialize 'custom-initialize-default + :set 'buffer-menu-set-default-value) + + + + ;; REPLACES ORIGINAL in `buff-menu.el'. + ;; A user option now. It must be numeric. Initial value is 1, not nil. + ;; + (defcustom Buffer-menu-sort-column 1 + "Sorted by (1) visit, (2) buffer, (3) size, (4) time, (5) mode, (6) file. +Click a column heading to sort by that field and update this option." + :type '(choice + (const :tag "Sort by time of last visit" 1) + (const :tag "Sort by buffer name" 2) + (const :tag "Sort by buffer size" 3) + (const :tag "Sort by time of last use" 4) + (const :tag "Sort by file name" 5)) + :group 'Buffer-Menu-Plus) + + + ;; This is needed because `buff-menu.el' is preloaded and set to nil. + (setq Buffer-menu-sort-column (or Buffer-menu-sort-column 1)) + + + ;; REPLACES ORIGINAL in `buff-menu.el'. + ;; Use `Buffer-menu-buffer+size-computed-width', not `Buffer-menu-buffer+size-width'. + ;; + (defun Buffer-menu-buffer+size (name size &optional name-props size-props) + (if (> (+ (length name) (length size) 1) Buffer-menu-buffer+size-computed-width) + (setq name (if (string-match "<[0-9]+>$" name) + (concat (substring name 0 (- Buffer-menu-buffer+size-computed-width + (max (length size) 3) + (match-end 0) + (- (match-beginning 0)) + 2)) + "[" ; Cut-off character. + (match-string 0 name)) + (concat (substring name 0 (- Buffer-menu-buffer+size-computed-width + (max (length size) 3) + 2)) + "["))) ; Cut-off character. + (setq name (copy-sequence name))) ; Don't put properties on (buffer-name). + (when name-props (add-text-properties 0 (length name) name-props name)) + (when size-props (add-text-properties 0 (length size) size-props size)) + (concat name (make-string (- Buffer-menu-buffer+size-computed-width + (length name) + (length size)) + ?\s- ) + size)) + ) ;;; Faces used to fontify buffer. -(unless (boundp 'orange-on-darkgreen-face) - (define-face-const "Orange" "DarkGreen")) -(defvar buffer-menu-headings-face orange-on-darkgreen-face - "Face used for headings in *Buffer List* buffer.") -(unless (boundp 'red-on-aquamarine-face) - (define-face-const "Red" "Aquamarine")) -(defvar buffer-menu-current-buffer-face red-on-aquamarine-face - "Face used for current buffer mark in *Buffer List* buffer.") -(unless (boundp 'red-on-aquamarine-face) - (define-face-const "Red" "Aquamarine")) -(defvar buffer-menu-view-mark-face red-on-aquamarine-face - "Face used for buffers to view mark (>) in *Buffer List* buffer.") -(unless (boundp 'aquamarine-on-red-face) - (define-face-const "Aquamarine" "Red")) -(defvar buffer-menu-delete-mark-face aquamarine-on-red-face - "Face used for buffers to delete mark (D) in *Buffer List* buffer.") -(unless (boundp 'orange-on-blue-face) - (define-face-const "Orange" "Blue")) -(defvar buffer-menu-save-mark-face orange-on-blue-face - "Face used for buffers to save mark (S) in *Buffer List* buffer.") -(unless (boundp 'darkorange-foreground-face) - (define-face-const "DarkOrange" nil)) -(defvar buffer-menu-modified-mark-face darkorange-foreground-face - "Face used for modified buffers mark (*) in *Buffer List* buffer.") -(unless (boundp 'yellow-foreground-face) - (define-face-const "Yellow" nil)) -(defvar buffer-menu-read-only-mark-face yellow-foreground-face - "Face used for read-only buffers mark (%) in *Buffer List* buffer.") -(unless (boundp 'blue-foreground-face) - (define-face-const "Blue" nil)) -(defvar buffer-menu-buffer-name-face blue-foreground-face - "Face used for buffer names in *Buffer List* buffer.") -(unless (boundp 'darkgreen-foreground-face) - (define-face-const "DarkGreen" nil)) -(defvar buffer-menu-mode-face darkgreen-foreground-face - "Face used for buffer modes in *Buffer List* buffer.") -(unless (boundp 'darkred-foreground-face) - (define-face-const "DarkRed" nil)) -(defvar buffer-menu-size-face darkred-foreground-face - "Face used for buffer sizes in *Buffer List* buffer.") -(unless (boundp 'darkmagenta-foreground-face) - (define-face-const "DarkMagenta" nil)) -(defvar buffer-menu-file-name-face darkmagenta-foreground-face - "Face used for file names in *Buffer List* buffer.") +(defface buffer-menu-headings + '((t (:foreground "Orange" :background "DarkGreen"))) + "*Face used for headings in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-headings 'buffer-menu-headings) + +(defface buffer-menu-current-buffer + '((t (:foreground "Red" :background "Aquamarine"))) + "*Face used for current buffer mark in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-current-buffer 'buffer-menu-current-buffer) + +(defface buffer-menu-view-mark + '((t (:foreground "Red" :background "Aquamarine"))) + "*Face used for buffers to view mark (>) in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-view-mark 'buffer-menu-view-mark) + +(defface buffer-menu-star-buffer + '((t (:foreground "DarkBlue"))) + "*Face used for buffers named \"*...*\"in *Buffer List* buffer." + :group 'Buffer-Menu-Plus :group 'font-lock-highlighting-faces) +(defvar buffer-menu-star-buffer 'buffer-menu-star-buffer) + +(defface buffer-menu-directory-buffer + '((t (:foreground "Blue" :background "LightBlue"))) + "*Face used for directory buffers in *Buffer List* buffer." + :group 'Buffer-Menu-Plus :group 'font-lock-highlighting-faces) +(defvar buffer-menu-directory-buffer 'buffer-menu-directory-buffer) + +(defface buffer-menu-marked-buffer + '((t (:underline t))) + "*Face used for buffers marked with `>' in *Buffer List* buffer." + :group 'Buffer-Menu-Plus :group 'font-lock-highlighting-faces) +(defvar buffer-menu-marked-buffer 'buffer-menu-marked-buffer) + +(defface buffer-menu-flagged-buffer + '((t (:foreground "Red"))) + "*Face used for buffers marked with `D' in *Buffer List* buffer." + :group 'Buffer-Menu-Plus :group 'font-lock-highlighting-faces) +(defvar buffer-menu-flagged-buffer 'buffer-menu-flagged-buffer) + +(defface buffer-menu-delete-mark + '((t (:foreground "Aquamarine" :background "Red"))) + "*Face used for buffers to delete mark (D) in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-delete-mark 'buffer-menu-delete-mark) + +(defface buffer-menu-save-mark + '((t (:foreground "Orange" :background "Blue"))) + "*Face used for buffers to save mark (S) in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-save-mark 'buffer-menu-save-mark) + +(defface buffer-menu-modified-mark + '((t (:foreground "DarkOrange"))) + "*Face used for modified buffers mark (*) in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-modified-mark 'buffer-menu-modified-mark) + +(defface buffer-menu-read-only-mark + '((t (:foreground "Yellow"))) + "*Face used for read-only buffers mark (%) in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-read-only-mark 'buffer-menu-read-only-mark) + +(defface buffer-menu-buffer-name + '((t (:foreground "Blue"))) + "*Face used for buffer names in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-buffer-name 'buffer-menu-buffer-name) +;; Redefine standard face `Buffer-menu-buffer' as `buffer-menu-buffer-name'. +(put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer-name) + +(defface buffer-menu-mode + '((t (:foreground "DarkGreen"))) + "*Face used for buffer modes in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-mode 'buffer-menu-mode) + +(defface buffer-menu-size + '((t (:foreground "DarkRed"))) + "*Face used for buffer sizes in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-size 'buffer-menu-size) + +(defface buffer-menu-time + '((t (:foreground "DarkGoldenrod4"))) + "*Face used for buffer time in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-time 'buffer-menu-time) + +(defface buffer-menu-file-name + '((t (:foreground "DarkMagenta"))) + "*Face used for file names in *Buffer List* buffer." + :group 'Buffer-Menu-Plus + :group 'font-lock-highlighting-faces) +(defvar buffer-menu-file-name 'buffer-menu-file-name) + +(if (> emacs-major-version 21) + (defvar buffer-menu-font-lock-keywords (buffer-menu-font-lock-keywords) ; Emacs 22 + "*Expressions to highlight in Buffer Menu mode.") + (defvar buffer-menu-font-lock-keywords ; Emacs 20, 21 + (list + (list "^\\( M.*\\)" 1 'buffer-menu-headings) + (list "^....\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+" ; Default buffer name + 1 'buffer-menu-buffer-name) + (list "^....\\(.*[^ \t\n]\\)[ \t]+[0-9]+[ \t]+[a-zA-Z :0-9]*[ \t]+Dired" + 1 'buffer-menu-directory-buffer t t) ; Directory buffer name + (list "^....\\(\\*.*[^ \t\n]\\*\\(<[0-9]+>\\)?\\)[ \t]+" ; Star buffer name + 1 'buffer-menu-star-buffer t t) + (list "^.*[ \t][0-9]+[ \t]+\\([^/\n]+\\)" 1 'buffer-menu-mode t t) ; Mode + (list "^.*[ \t]\\([0-9]+\\)[ \t]+[^/\n]+" 1 'buffer-menu-size t t) ; Size + (list "^.*[ \t][0-9]+[ \t]+[^/\n]+[ \t\n]\\(\\([~]\\|\\([a-zA-Z]:\\)\\)*/.*\\)$" + 1 'buffer-menu-file-name t t) ; File name + (list "^\\([.]\\)" 1 'buffer-menu-current-buffer t t) ; Current buffer mark (.) + (list "^\\(>\\)" 1 'buffer-menu-view-mark t t) ; To view mark (>) + (list "^>...\\(.*[^ \t\n]\\)[ \t\]+[0-9]" ; Buffer name when marked (>) + 1 'buffer-menu-marked-buffer 'prepend t) + (list "^D...\\(.*[^ \t\n]\\)[ \t\]+[0-9]" ; Buffer name when flagged (D) + 1 'buffer-menu-flagged-buffer t t) + (list "^\\(D\\)" 1 'buffer-menu-delete-mark t t) ; Deletion flag (D) + (list "^.\\(S\\)" 1 'buffer-menu-save-mark t t) ; Save flag (S) + (list "^.\\([*]\\)" 1 'buffer-menu-modified-mark t t) ; Buffer-modified-p (*) + (list "^..\\(%\\)" 1 'buffer-menu-read-only-mark t t) ; Read-only-p (%) + ) "*Expressions to highlight in Buffer Menu mode.")) + + +;; Undefine some bindings that would try to modify a buffer-menu buffer. Their key sequences +;; will then appear to the user as available for local (Buffer Menu) definition. +(when (fboundp 'undefine-killer-commands) (undefine-killer-commands Buffer-menu-mode-map)) + + + +;; REPLACES ORIGINAL in `buff-menu.el'. +;; +;; Protect `Buffer-menu-files-only' with boundp (for Emacs 20). +;; +(defun Buffer-menu-revert-function (ignore1 ignore2) + (or (eq buffer-undo-list t) + (setq buffer-undo-list nil)) + ;; We can not use save-excursion here. The buffer gets erased. + (let ((opoint (point)) + (eobp (eobp)) + (ocol (current-column)) + (oline (progn (move-to-column 4) + (get-text-property (point) 'buffer))) + (prop (point-min)) + ;; do not make undo records for the reversion. + (buffer-undo-list t)) + (list-buffers-noselect (and (boundp 'Buffer-menu-files-only) Buffer-menu-files-only)) + (if oline + (while (setq prop (next-single-property-change prop 'buffer)) + (when (eq (get-text-property prop 'buffer) oline) + (goto-char prop) + (move-to-column ocol))) + (goto-char (if eobp (point-max) opoint))))) + +(defun Buffer-menu-fontify-and-adjust-frame () + "Use for `buffer-menu-mode-hook'. Fontify, fit and raise frame." + (save-window-excursion + (save-excursion + (pop-to-buffer "*Buffer List*") + (when (< emacs-major-version 21) (make-local-variable 'font-lock-defaults)) + (setq font-lock-defaults '(buffer-menu-font-lock-keywords t)) + (turn-on-font-lock) + (when (and (fboundp 'fit-frame) (one-window-p t)) (fit-frame)) + (raise-frame)))) + +;; Fontify buffer, then fit and raise its frame. +(add-hook 'buffer-menu-mode-hook 'Buffer-menu-fontify-and-adjust-frame) + + + +;; REPLACES ORIGINAL in `buff-menu.el'. +;; +;; Treat Emacs 20 too. +;; +(defun Buffer-menu-beginning () + (goto-char (point-min)) + (unless (and (boundp 'Buffer-menu-use-header-line) Buffer-menu-use-header-line) + (forward-line))) -;;;###autoload -(defvar buffer-menu-font-lock-keywords - '( - ("^\\( M.*\\)" 1 buffer-menu-headings-face) ; Headings - ("^\\([.]\\)" 1 buffer-menu-current-buffer-face) ; Current buffer mark (.) - ("^\\(>\\)" 1 buffer-menu-view-mark-face) ; To view mark (>) - ("^\\(D\\)" 1 buffer-menu-delete-mark-face) ; Deletion flag (D) - ("^.\\(S\\)" 1 buffer-menu-save-mark-face) ; Save flag (S) - ("^.\\([*]\\)" 1 buffer-menu-modified-mark-face) ; Buffer-modified-p (*) - ("^..\\(%\\)" 1 buffer-menu-read-only-mark-face) ; Read-only-p (%) - ("^....\\(.+\\)[ \t\n][0-9]" 1 buffer-menu-buffer-name-face) ; Buffer name - ("^.*[ \t][0-9]+[ \t]+\\([^/\n]+\\)" 1 buffer-menu-mode-face) ; Mode - ("^.*[ \t]\\([0-9]+\\)[ \t]+[^/\n]+" 1 buffer-menu-size-face) ; Size - ("\\(/.*\\)$" 1 buffer-menu-file-name-face) ; File name - ) "Expressions to highlight in Buffer Menu mode.") - -;; Fontify by default. -(add-hook 'buffer-menu-mode-hook - '(lambda () - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(buffer-menu-font-lock-keywords t)))) ;; REPLACES ORIGINAL in `buff-menu.el': @@ -218,40 +772,42 @@ ;; 2. Prefix ARG =< 0 now means list all buffers alphabetically. ;; (It used to mean the same as ARG > 0.) ;; Prefix ARG >= 0 means list just file buffers. +;; 3. Use pop-to-buffer instead of switch-to-buffer. ;;;###autoload (defun buffer-menu (&optional arg) - "Make a menu of buffers so you can save, delete or select them. + "Show a menu to let you save, delete or select buffers. By default (no or null prefix arg), the buffers are listed in order of -last access. With a non-nil prefix ARG: - ARG >= 0 => Only buffers visiting files are listed. - ARG =< 0 => The buffers are listed alphabetically. - (ARG = 0 => Only buffers visiting files, listed alphabetically.) +last access (visit). With a non-nil prefix ARG: + ARG >= 0 means only buffers visiting files are listed. + ARG <= 0 means the buffers are listed alphabetically. + (ARG = 0 means only buffers visiting files, listed alphabetically.) -Type `?' in buffer \"*Buffer List*\" to get help on available commands. +Type `?' in buffer \"*Buffer List*\" for more information. Type `q' there to quit the buffer menu." (interactive "P") (let ((num-arg (prefix-numeric-value arg))) - (if (and arg (< num-arg 0)) - (list-buffers) - (list-buffers arg)) + (if (and arg (< num-arg 0)) (list-buffers) (list-buffers arg)) (let ((newpoint (save-excursion (set-buffer "*Buffer List*") (point)))) (pop-to-buffer "*Buffer List*") (when (and arg (not (> num-arg 0))) ; Sort lines after header. (let ((buffer-read-only nil)) - (goto-char (point-min)) (forward-line 2) (forward-char 4) ; Header. - (sort-columns nil (point) - (save-excursion (goto-char (point-max)) - (when (bolp) (backward-char 1)) - (point))))) + (goto-char (point-min)) + (unless Buffer-menu-use-header-line (forward-line 2)) ; Header. + (forward-char 4) + (sort-columns nil (point) (save-excursion (goto-char (point-max)) + (when (bolp) (backward-char 1)) + (point))))) (goto-char newpoint))) - (font-lock-fontify-buffer) (message "Help: ?; Menu: mouse-3; Show: v; Mark: u,m,s,d; \ Save/Delete: x; Misc: g,~,%%,t")) + ;; REPLACES ORIGINAL in `buff-menu.el': ;; 1. Doc string reflects new bindings. ;; 2. mouse-face on whole line, not just buffer name. +;; 3. Compatible with Emacs prior to Emacs 22 also. +;; ;;;###autoload (defun Buffer-menu-mode () "Major mode for editing a list of buffers. @@ -260,14 +816,43 @@ In Buffer menu mode, chars do not insert themselves, but are commands. \\<Buffer-menu-mode-map> \(\"Current line\" here is the line of the text cursor or the mouse.) -Also, pressing `mouse-3' on a buffer name in this mode provides a -popup menu that duplicates most of the functions below. - -Display buffers: +Display Options --------------- -\\[Buffer-menu-mouse-select], \\[Buffer-menu-select] -- Select current line's \ -buffer. +Click `mouse-3' for a context-sensitive menu of buffer operations. + +These features are available for Emacs 22 and later: + +* You can click a column heading to sort by that column. Clicking + again reverses the sort direction. The current sort column is + indicated by an underlined or overlined column heading. Sorting by + column `CRM' depends on the value of option + `Buffer-menu-use-frame-buffer-list'. + +* You can resize the Buffer and Size columns using `+' and `-'. + +* You can toggle the display of columns Time, Mode, and File using + commands `buffer-menu-toggle-time-column', + `buffer-menu-toggle-mode-column', and + `buffer-menu-toggle-file-column'. You can toggle the Time format + using command `buffer-menu-toggle-time-format'. + +Column `CRM': + `C' shows `>' if you have marked the buffer to be displayed, + `D' if you have marked it for deletion, and + `.' for the buffer from which you came (current). + `R' shows `%' if the buffer is read-only. + `M' shows `*' if the buffer is modified, and + `S' if you have marked it for saving. + +The other columns are the Buffer name, its Size in characters, the +last Time the buffer was displayed, its major Mode, and the visited +File name (if any). + +Displaying Buffers +------------------ +\\[Buffer-menu-mouse-select], \\[Buffer-menu-select], \\[Buffer-menu-this-window] -- \ +Select current line's buffer. \\[Buffer-menu-mark]\t-- Mark current line's buffer `>' to be displayed (via \ `\\[Buffer-menu-select]'). \\[Buffer-menu-select]\t-- Show buffers marked `>'. Select current line's \ @@ -277,26 +862,32 @@ full-frame window. \\[Buffer-menu-2-window]\t-- Select current line's buffer in one window. \t Display previous buffer in a second window. \\[Buffer-menu-switch-other-window]\t-- Display current line's buffer in \ -another window. No select. +another window. No select. +\\[Buffer-menu-view]\t-- select current line's buffer, but in view-mode. +\\[Buffer-menu-view-other-window]\t-- select that buffer in + another window, in view-mode. +\\[Buffer-menu-toggle-files-only]\t-- toggle whether the menu displays only file buffers. -Mark/Unmark buffers to be Saved/Deleted: ---------------------------------------- +Marking/Unmarking Buffers to be Saved/Deleted +--------------------------------------------- \\[Buffer-menu-save]\t-- Mark current line's buffer `S' to be saved. \ Cursor down. \\[Buffer-menu-delete]\t-- Mark current line's buffer `D' to be deleted. \ Cursor down. \\[Buffer-menu-delete-backwards]\t-- Mark current line's buffer `D' to be \ deleted. Cursor up. -\\[Buffer-menu-unmark]\t-- Unmark current line. Cursor down. (Prefix arg: \ +\\[Buffer-menu-unmark]\t-- Unmark current line. Cursor down. (Prefix arg: \ Cursor up.) \\[Buffer-menu-backup-unmark]\t-- Cursor up, then unmark line. -Save/Delete buffers: -------------------- +Saving/Deleting Buffers +----------------------- \\[Buffer-menu-execute]\t-- Save / Delete marked buffers (marks `S', `D'). +\\[Buffer-menu-delete-flagged]\t-- Delete all buffers marked `D', even if modified. -Miscellaneous: +Miscellaneous ------------- +\\[Buffer-menu-revert]\t-- Update the list of buffers. \\[Buffer-menu-not-modified]\t-- Clear modified-flag on current line's buffer. \\[Buffer-menu-toggle-read-only]\t-- Toggle read-only status of current \ line's buffer. @@ -314,34 +905,85 @@ Bindings in Buffer Menu mode: (setq mode-name "Buffer Menu") (save-excursion (goto-char (point-min)) - (when (< emacs-major-version 20) ; Hardcoded to 4, starting in Emacs 20 + (when (< emacs-major-version 20) ; Hardcoded to 4, starting in Emacs 20 (search-forward "Buffer") (backward-word 1) (setq Buffer-menu-buffer-column (current-column))) - (forward-line 2) + (when (or (not (boundp 'Buffer-menu-use-header-line)) (not Buffer-menu-use-header-line)) + (forward-line 2)) ; First two lines are title, unless use header line. (while (not (eobp)) (put-text-property (point) (save-excursion (end-of-line) (point)) 'mouse-face 'highlight) (forward-line 1))) - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'Buffer-menu-revert-function) + (set (make-local-variable 'revert-buffer-function) 'Buffer-menu-revert-function) + (when (> emacs-major-version 21) + (set (make-local-variable 'buffer-stale-function) #'(lambda (&optional noconfirm) 'fast))) (setq truncate-lines t) (setq buffer-read-only t) - (run-hooks 'buffer-menu-mode-hook)) + (if (> emacs-major-version 21) + (run-mode-hooks 'buffer-menu-mode-hook) + (run-hooks 'buffer-menu-mode-hook))) + +;;;###autoload +(defun Buffer-menu-delete-flagged () + "Delete all buffers marked `D', even if they have been modified. +If there are any file buffers that have been modified since the last +save, then you must confirm the deletion of all at once. + +You can mark a buffer for deletion (`D') using command `\\<Buffer-menu-mode-map>\ +\\[Buffer-menu-delete]'." + (interactive) + (save-excursion + (Buffer-menu-beginning) + (let ((buff-menu-buffer (current-buffer)) + (buffer-read-only nil) + (bufs ()) + (mod-bufs ()) + (kill-fn (if (fboundp 'kill-buffer-and-its-windows) + #'kill-buffer-and-its-windows + #'kill-buffer)) + buf) + (while (re-search-forward "^D" nil t) + (forward-char -1) + (setq buf (Buffer-menu-buffer nil)) + (unless (or (eq buf nil) (eq buf buff-menu-buffer)) + (push buf bufs) + (when (and (buffer-file-name buf) (buffer-modified-p buf)) (push buf mod-bufs))) + (forward-line 1)) + (unless bufs (error "No buffers flagged for deletion")) + (when (and mod-bufs (let ((visible-bell t)) (ding) t) + (let ((last-nonmenu-event nil) + (use-dialog-box t)) + (not (yes-or-no-p + (concat "Modified buffers. Delete all anyway? (`" + (mapconcat (lambda (b) (buffer-name b)) mod-bufs "', `") + "')"))))) + (error "OK, no buffers deleted")) + (dolist (buf bufs) + (save-excursion + (set-buffer buf) + (set-buffer-modified-p nil) + (funcall kill-fn buf))) + (Buffer-menu-revert)))) -;; REPLACES ORIGINAL in `buff-menu.el': Deletes frame when kills buffer. + +;; REPLACES ORIGINAL in `buff-menu.el': +;; 1. Deletes frame when kills buffer. +;; 2. Compatible with Emacs prior to Emacs 22 also. +;; ;;;###autoload (defun Buffer-menu-execute () - "Save or delete buffers marked `S' or `D', respectively. -Buffers are so marked using command `\\<Buffer-menu-mode-map>\ -\\[Buffer-menu-save]' or `\\<Buffer-menu-mode-map>\\[Buffer-menu-delete]', respectively." + "Save or delete buffers marked `S' (\"save\") or `D' (\"delete\"). +Buffers can be so marked using commands `\\<Buffer-menu-mode-map>\ +\\[Buffer-menu-save]' and `\\[Buffer-menu-delete]', respectively." (interactive) (save-excursion - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward "^.S" nil t) + (Buffer-menu-beginning) + (while (if (> emacs-major-version 21) + (re-search-forward "^..S" nil t) + (re-search-forward "^.S" nil t)) (let ((modp nil)) (save-excursion (set-buffer (Buffer-menu-buffer t)) @@ -351,40 +993,43 @@ Buffers are so marked using command `\\<Buffer-menu-mode-map>\ (delete-char -1) (insert (if modp ?* ? )))))) (save-excursion - (goto-char (point-min)) - (forward-line 1) + (Buffer-menu-beginning) (let ((buff-menu-buffer (current-buffer)) (buffer-read-only nil)) - (while (search-forward "\nD" nil t) + (while (re-search-forward "^D" nil t) (forward-char -1) (let ((buf (Buffer-menu-buffer nil))) (or (eq buf nil) (eq buf buff-menu-buffer) (save-excursion (if (fboundp 'kill-buffer-and-its-windows) (kill-buffer-and-its-windows buf) - (kill-buffer buf))))) - (if (Buffer-menu-buffer nil) - (progn (delete-char 1) (insert ? )) - (delete-region (point) (progn (forward-line 1) (point))) - (forward-char -1)))))) + (kill-buffer buf)))) + (if (and buf (buffer-name buf)) + (progn (delete-char 1) (insert ? )) + (delete-region (point) (progn (forward-line 1) (point))) + (unless (bobp) + (forward-char -1)))))))) + ;; REPLACES ORIGINAL in `buff-menu.el': ;; When Buffer Menu is `window-dedicated-p', uses `pop-to-buffer' to display. +;; ;;;###autoload (defun Buffer-menu-select () "Select this line's buffer; also display buffers marked with `>'. -You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] \ -command." +You can mark buffers with command `\\<Buffer-menu-mode-map>\\[Buffer-menu-mark]'. +If the window is `window-dedicated-p', then another window is used; +else, all windows previously in the frame are replaced by this one." (interactive) (let ((buff (Buffer-menu-buffer t)) - (menu (current-buffer)) + (menu (current-buffer)) (others ()) tem) - (goto-char (point-min)) - (while (search-forward "\n>" nil t) + (Buffer-menu-beginning) + (while (re-search-forward "^>" nil t) (setq tem (Buffer-menu-buffer t)) (let ((buffer-read-only nil)) (delete-char -1) (insert ?\ )) - (or (eq tem buff) (memq tem others) (push tem others))) + (or (eq tem buff) (memq tem others) (setq others (cons tem others)))) (setq others (nreverse others)) (cond ((window-dedicated-p (selected-window)) ; Can't split dedicated win. (pop-to-buffer buff) @@ -410,9 +1055,339 @@ command." (split-window nil tem) (other-window 1) (switch-to-buffer (car others)) - (pop others)) - (other-window 1)))))) ; Back to the beginning. + (setq others (cdr others))) + (other-window 1)))))) ;back to the beginning! ; Back to the beginning. + + +;; REPLACES ORIGINAL in `buff-menu.el'. +;; Allow negative COLUMN. Allow COLUMN = 1 or -1. +;; When COLUMN = `Buffer-menu-sort-column', then flip `Buffer-menu-sort-column'. +;; Message at end. +;; +;;;###autoload +(when (> emacs-major-version 21) + (defun Buffer-menu-sort (column) + "Sort the buffer menu by COLUMN. +Consecutive executions of the same COLUMN reverse the sort order." + (interactive "P") + (when column + (setq column (prefix-numeric-value column)) + (when (= column 0) (setq column 1)) + (when (> column 6) (setq column 6)) + (when (< column -6) (setq column -6))) + (if (equal Buffer-menu-sort-column column) + (setq Buffer-menu-sort-column (- column)) + (setq Buffer-menu-sort-column column)) + (let (buffer-read-only l buf m1 m2) + (save-excursion + (Buffer-menu-beginning) + (while (not (eobp)) + (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer))) + (setq m1 (char-after) + m1 (if (memq m1 '(?> ?D)) m1) + m2 (char-after (+ (point) 2)) + m2 (if (eq m2 ?S) m2)) + (if (or m1 m2) + (push (list buf m1 m2) l))) + (forward-line))) + (Buffer-menu-revert) + (setq buffer-read-only) + (save-excursion + (Buffer-menu-beginning) + (while (not (eobp)) + (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l)) + (setq m1 (cadr buf) + m2 (cadr (cdr buf))) + (when m1 + (delete-char 1) + (insert m1) + (backward-char 1)) + (when m2 + (forward-char 2) + (delete-char 1) + (insert m2))) + (forward-line)))) + (message "Buffers are now sorted %s%s." + (case (abs column) + (1 "by time of last visit - see `Buffer-menu-use-frame-buffer-list'") + (2 "by buffer name") + (3 "by size") + (4 "by time of last display") + (5 "by major-mode name") + (otherwise "by associated file (including path)")) + (if (natnump Buffer-menu-sort-column) ", ascending" ", descending")))) + + +;; REPLACES ORIGINAL in `buff-menu.el'. +;; If same column as last sort, then flip direction of sort. +;; CRM is indicated by COLUMN = 1, not by nil COLUMN. +;; Apply different face to sort column heading, depending on direction. +;; +;;;###autoload +(when (> emacs-major-version 21) + (defun Buffer-menu-make-sort-button (name button-column) + (let ((the-sort-column-p nil)) + (when (equal button-column (abs Buffer-menu-sort-column)) + (setq the-sort-column-p t) + (setq button-column (- button-column))) + (propertize name 'column button-column + 'help-echo (case (abs button-column) + (1 (if Buffer-menu-use-header-line + "mouse-1, mouse-2: sort by time of last visit - \ +see `Buffer-menu-use-frame-buffer-list'" + "mouse-2, RET: sort by time of last visit - \ +see `Buffer-menu-use-frame-buffer-list'")) + (2 (if Buffer-menu-use-header-line + "mouse-1, mouse-2: sort by buffer name" + "mouse-2, RET: sort by buffer name")) + (4 "mouse-1, mouse-2: sort by time of last display/access") + (t (if Buffer-menu-use-header-line + (concat "mouse-1, mouse-2: sort by " (downcase name)) + (concat "mouse-2, RET: sort by " (downcase name))))) + 'mouse-face 'highlight + (when the-sort-column-p 'face) (when the-sort-column-p + (if (natnump Buffer-menu-sort-column) + '(:underline t) + '(:overline t))) + 'keymap Buffer-menu-sort-button-map)))) + + +;; REPLACES ORIGINAL in `buff-menu.el' +;; +;; Compute longest buffer name + size combination, and use when indenting file name. +;; Add sort buttons for CRM and Time also. +;; The test for column 1 (CRM) is =1, not null. +;; Sort direction depends on sign of `Buffer-menu-sort-column'. +;; Temporarily sets `window-dedicated-p' to nil when it does the +;; `set-window-buffer'. Otherwise, *Buffer List* cannot be dedicated. +;; Go to beginning of buffer if `desired-point' is not defined. +;; +;;;###autoload +(when (> emacs-major-version 21) + (defun list-buffers-noselect (&optional files-only buffer-list) + "Create and return a buffer with a list of names of existing buffers. +The buffer is named `*Buffer List*'. +Note that buffers with names starting with spaces are omitted. +Non-null optional arg FILES-ONLY means mention only file buffers. + +If BUFFER-LIST is non-nil, it should be a list of buffers; +it means list those buffers and no others. + +For more information, see the function `buffer-menu'." + ;; Compute longest buffer name + size combination. + ;; $$$$$$ Could be costly if lots of buffers - maybe have an option to be able to not do it? + (let ((len 0) + buf+size) + (setq Buffer-menu-buffer+size-computed-width Buffer-menu-buffer+size-width) + (dolist (buffer (buffer-list)) + (setq buf+size (concat (buffer-name buffer) (number-to-string (buffer-size buffer)))) + (when (and (not (string= (substring buf+size 0 1) " ")) ; Don't count internal buffers. + (> (length buf+size) len)) + (setq len (length buf+size)))) + (when (< (+ len 1) Buffer-menu-buffer+size-width) + (setq Buffer-menu-buffer+size-computed-width (+ len 1)))) + (let* ((old-buffer (current-buffer)) + (standard-output standard-output) + (mode-end (if Buffer-menu-mode-flag (make-string (- Buffer-menu-mode-width 4) ?\ ) "")) + (header (concat (Buffer-menu-make-sort-button "CRM" 1) " " + (Buffer-menu-buffer+size (Buffer-menu-make-sort-button "Buffer" 2) + (Buffer-menu-make-sort-button "Size" 3)) + " " + (and Buffer-menu-time-flag + (if (eq 'short Buffer-menu-time-format) + (Buffer-menu-make-sort-button "Time " 4) + (Buffer-menu-make-sort-button "Time " 4))) + (and Buffer-menu-time-flag " ") + (and Buffer-menu-mode-flag + (Buffer-menu-make-sort-button (concat "Mode" mode-end) 5)) + (if Buffer-menu-mode-flag + (if Buffer-menu-time-flag " " " ") + (and (not Buffer-menu-time-flag) " ")) + (and Buffer-menu-file-flag (Buffer-menu-make-sort-button + "File " 6)) + "\n")) + list desired-point name buffer-time mode file) + (when (and (boundp 'Buffer-menu-use-header-line) Buffer-menu-use-header-line) + (let ((pos 0)) + ;; Turn whitespace chars in the header into stretch specs so + ;; they work regardless of the header-line face. + (while (string-match "[ \t\n]+" header pos) + (setq pos (match-end 0)) + (put-text-property (match-beginning 0) pos 'display + ;; Assume fixed-size chars in the buffer. + (list 'space :align-to pos) + header) + (put-text-property (match-beginning 0) (1- pos) 'mouse-face 'highlight header))) + ;; REMOVED: + ;; Try to better align the one-char headers. + ;; (put-text-property 0 3 'face 'fixed-pitch header) + ;; Add a "dummy" leading space to align the beginning of the header + ;; line with the beginning of the text (rather than with the left + ;; scrollbar or the left fringe). --Stef + (setq header (concat (propertize " " 'display '(space :align-to 0)) header))) + (with-current-buffer (get-buffer-create "*Buffer List*") + (setq buffer-read-only nil) + (erase-buffer) + (setq standard-output (current-buffer)) + (unless (and (boundp 'Buffer-menu-use-header-line) Buffer-menu-use-header-line) + ;; Use U+2014 (EM DASH) to underline if possible, else use U+002D (HYPHEN-MINUS). + ;; Must eval this at compile time. + ;; Tried a runtime check of (char-displayable-p ?\u2014), but if this is compiled in + ;; an Emacs version before 22 then get an error that `char-displayable-p' is called + ;; with two args (since ?\u is interpreted as ?u). + (let ((underline (eval-when-compile (if (> emacs-major-version 21) + ?\u2014 + ?-)))) + (insert header (apply 'string + (mapcar (lambda (c) (if (memq c '(?\n ?\ )) c underline)) + header))))) +;;;; (insert header (propertize "---" 'face 'fixed-pitch) " ") +;;;; (insert (Buffer-menu-buffer+size "------" "----")) +;;;; (insert " ----" mode-end "----\n") +;;;; (put-text-property 1 (point) 'intangible t)) + (if buffer-list + (setq list buffer-list) + ;; Collect info for every buffer we're interested in. + (dolist (buffer (or buffer-list (buffer-list (and Buffer-menu-use-frame-buffer-list + (selected-frame))))) + (with-current-buffer buffer + (let ((name (buffer-name)) + (file buffer-file-name)) + (unless (and (not buffer-list) + (or + ;; Don't mention internal buffers. + (and (string= (substring name 0 1) " ") (null file)) + ;; Maybe don't mention buffers without files. + (and files-only (not file)) + (string= name "*Buffer List*"))) + ;; Otherwise output info. + (let ( ;; Need to record two values for time: numerical time value, for + ;; sorting, and string time value, for display. + (buffer-time (and Buffer-menu-time-flag + (cons (or (float-time buffer-display-time) 0) + (if buffer-display-time + (format-time-string + (if (eq 'short Buffer-menu-time-format) + "%02H:%02M:%02S" + "%_3a %_2l:%02M:%02S %_2p") + buffer-display-time) + (if (eq 'short Buffer-menu-time-format) + " " + " "))))) + (mode (concat + ;; `format-mode-line' takes a 4th arg, `buffer', in 22.x. + (if (string-match "22." emacs-version) + (format-mode-line mode-name nil nil buffer) + (format-mode-line mode-name)) + (and mode-line-process + (if (string-match "22." emacs-version) + (format-mode-line mode-line-process nil nil buffer) + (format-mode-line mode-line-process))))) + (bits (string (if (eq buffer old-buffer) ?. ?\ ) + ;; Handle readonly status. The output buffer + ;; is special cased to appear readonly; it is + ;; actually made so at a later date. + (if (or (eq buffer standard-output) buffer-read-only) + ?% + ?\ ) + ;; Identify modified buffers. + (if (buffer-modified-p) ?* ?\ ) + ;; Space separator. + ?\ ))) + (unless file + ;; No visited file. Check local value of + ;; list-buffers-directory and, for Info buffers, + ;; Info-current-file. + (cond ((and (boundp 'list-buffers-directory) + list-buffers-directory) + (setq file list-buffers-directory)) + ((eq major-mode 'Info-mode) + (setq file Info-current-file) + (cond + ((equal file "dir") + (setq file "*Info Directory*")) + ((eq file 'apropos) + (setq file "*Info Apropos*")) + ((eq file 'history) + (setq file "*Info History*")) + ((eq file 'toc) + (setq file "*Info TOC*")) + ((not (stringp file)) ; avoid errors + (setq file nil)) + (t + (setq file (concat "(" + (file-name-nondirectory file) + ")" + Info-current-node))))))) + (push (list buffer bits name (buffer-size) buffer-time mode file) + list)))))) + ;; Preserve original list order (by reversing). + ;; Flip it if Buffer-menu-sort-column = -1. + (unless (eq -1 Buffer-menu-sort-column) (setq list (nreverse list)))) + ;; Place the buffers's info in the output buffer, sorted if necessary. + (dolist (buffer (if (eq 1 (abs Buffer-menu-sort-column)) + list + (let* ((descending-p (natnump Buffer-menu-sort-column)) + (Buffer-menu-sort-column (abs Buffer-menu-sort-column))) + (sort list + (cond ((eq Buffer-menu-sort-column 3) ; Size + (if descending-p + (lambda (a b) (< (nth 3 a) (nth 3 b))) + (lambda (a b) (< (nth 3 b) (nth 3 a))))) + ((eq Buffer-menu-sort-column 4) ; Time (value) + (if descending-p + (lambda (a b) (< (car (nth 4 a)) (car (nth 4 b)))) + (lambda (a b) (< (car (nth 4 b)) (car (nth 4 a)))))) + (t + (if descending-p + (lambda (a b) + (string< (nth Buffer-menu-sort-column a) + (nth Buffer-menu-sort-column b))) + (lambda (a b) + (string< (nth Buffer-menu-sort-column b) + (nth Buffer-menu-sort-column a)))))))))) + (when (eq (car buffer) old-buffer) (setq desired-point (point))) + (insert (cadr buffer) + ;; Put the buffer name into a text property + ;; so we don't have to extract it from the text. + ;; This way we avoid problems with unusual buffer names. + (Buffer-menu-buffer+size (nth 2 buffer) + (int-to-string (nth 3 buffer)) + `(buffer-name ,(nth 2 buffer) buffer ,(car buffer) + ,(if (> emacs-major-version 21) + 'font-lock-face + 'face) + ,(if (facep 'Buffer-menu-buffer-face) + 'Buffer-menu-buffer-face ; < Emacs 22 + 'Buffer-menu-buffer) ; Emacs 22 + mouse-face highlight + help-echo "mouse-2: select this buffer"))) + (when Buffer-menu-time-flag (insert " " (cdr (nth 4 buffer)))) ; Time + (when Buffer-menu-mode-flag + (insert " " + (if (> (length (nth 5 buffer)) Buffer-menu-mode-width) ; Mode + (substring (nth 5 buffer) 0 Buffer-menu-mode-width) + (nth 5 buffer)))) + (when (and Buffer-menu-file-flag (nth 6 buffer)) ; File + (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-computed-width + (if Buffer-menu-mode-flag (1+ Buffer-menu-mode-width) 0) + (if Buffer-menu-time-flag + (if (eq 'short Buffer-menu-time-format) 9 16) + 0) + 3) + 1) + (princ (abbreviate-file-name (nth 6 buffer)))) + (princ "\n")) + (Buffer-menu-mode) + (when (and (boundp 'Buffer-menu-use-header-line) Buffer-menu-use-header-line) + (setq header-line-format header)) + ;; DESIRED-POINT doesn't have to be set; it is not set when the + ;; current buffer is not displayed for some reason. + (goto-char (or desired-point (point-min))) + (setq Buffer-menu-files-only files-only) + (set-buffer-modified-p nil) + (current-buffer))))) (define-key Buffer-menu-mode-map [down-mouse-3] 'Buffer-menu-mouse-3-menu) (define-key Buffer-menu-mode-map [mouse-3] 'ignore) @@ -433,8 +1408,8 @@ command." ;;(define-key Buffer-menu-mouse-3-map [Buffer-menu-mouse-select] ;; '("Select Buffer" . Buffer-menu-mouse-select)) -;; Used to highlight buffer name's line during popup of Mouse-3 menu. -(defvar Buffer-menu-overlay nil) +(defvar Buffer-menu-overlay nil + "Overlay to highlight line of buffer during popup of `mouse-3' menu.") ;;;###autoload (defun Buffer-menu-mouse-3-menu (event) @@ -470,13 +1445,13 @@ command." '("Unmark Buffer" . Buffer-menu-mouse-unmark) '("Mark to Save Buffer (S)" . Buffer-menu-mouse-save) '("Mark to Delete Buffer (D)" . Buffer-menu-mouse-delete) - '("Mark as Modified/Unmodified (*)" . - Buffer-menu-mouse-modified) + '("Mark as Modified/Unmodified (*)" . Buffer-menu-mouse-modified) '("--") ; Separator: next not buffer-specific. - '("Execute: Save/Delete Marked Buffers" . - Buffer-menu-mouse-execute)) - (list "" '("Execute: Save/Delete Marked Buffers" . - Buffer-menu-mouse-execute))))))) + '("Execute: Save/Delete Marked Buffers" . Buffer-menu-mouse-execute) + '("Delete All `D', Even If Modified" . Buffer-menu-delete-flagged)) + (list "" + '("Execute: Save/Delete Marked Buffers" . Buffer-menu-mouse-execute) + '("Delete All `D', Even If Modified" . Buffer-menu-delete-flagged))))))) (when Buffer-menu-overlay (delete-overlay Buffer-menu-overlay)) (and selection (call-interactively selection))))) @@ -570,6 +1545,7 @@ or `\\<Buffer-menu-mode-map>\\[Buffer-menu-mouse-execute]'." (insert ?\*)))) (beginning-of-line)) + ;;;###autoload (defun Buffer-menu-mouse-execute (event) "Save and/or delete buffers marked `S' or `D', respectively. @@ -580,9 +1556,10 @@ Buffers can be marked via commands `\\<Buffer-menu-mode-map>\ (interactive "e") (select-window (posn-window (event-end event))) (save-excursion - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward "^.S" nil t) + (Buffer-menu-beginning) + (while (if (> emacs-major-version 21) + (re-search-forward "^..S" nil t) + (re-search-forward "^.S" nil t)) (let ((modp nil)) (save-excursion (set-buffer (Buffer-menu-buffer t)) @@ -592,29 +1569,24 @@ Buffers can be marked via commands `\\<Buffer-menu-mode-map>\ (delete-char -1) (insert (if modp ?* ? )))))) (save-excursion - (goto-char (point-min)) - (forward-line 1) + (Buffer-menu-beginning) (let ((buff-menu-buffer (current-buffer)) (buffer-read-only nil)) - (while (search-forward "\nD" nil t) + (while (re-search-forward "^D" nil t) (forward-char -1) (let ((buf (Buffer-menu-buffer nil))) - (or (eq buf nil) - (eq buf buff-menu-buffer) + (or (eq buf nil) (eq buf buff-menu-buffer) (save-excursion (if (fboundp 'kill-buffer-and-its-windows) (kill-buffer-and-its-windows buf) - (kill-buffer buf))))) - (if (Buffer-menu-buffer nil) - (progn (delete-char 1) - (insert ? )) - (delete-region (point) (progn (forward-line 1) (point))) - (forward-char -1)))))) - + (kill-buffer buf)))) + (if (and buf (buffer-name buf)) + (progn (delete-char 1) (insert ? )) + (delete-region (point) (progn (forward-line 1) (point))) + (unless (bobp) (forward-char -1)))))))) ;;;;;;;;;;;;;;;;;;;;;;; (provide 'buff-menu+) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; FILE NAME SHOULD BE buff-menu+.el, but EmacsWiki doesn't like that. -;;; buff-menu-plus.el ends here +;;; buff-menu+.el ends here lib/buff-menu+.el @@ -7,9 +7,9 @@ ;; Copyright (C) 2006-2008, Drew Adams, all rights reserved. ;; Created: Sat Aug 26 18:17:18 2006 ;; Version: 22.0 -;; Last-Updated: Mon Jan 21 00:17:35 2008 (Pacific Standard Time) +;; Last-Updated: Mon Jan 28 10:04:35 2008 (Pacific Standard Time) ;; By: dradams -;; Update #: 217 +;; Update #: 230 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/hl-line+.el ;; Keywords: highlight, cursor, accessibility ;; Compatibility: GNU Emacs 22.x @@ -96,6 +96,9 @@ ;; ;;; Change log: ;; +;; 2008/01/28 dadams +;; Fix from Yann Yodique: Moved adding/removing hl-line-unhighlight-now as +;; pre-command-hook from hl-line-toggle-when-idle to hl-line-(un)highlight-now. ;; 2008/01/20 dadams ;; Renamed: line-show-period to hl-line-flash-show-period. ;; 2007/10/11 dadams @@ -168,7 +171,7 @@ Do NOT change this yourself; instead, use `\\[toggle-hl-line-when-idle]'.") (defalias 'toggle-hl-line-when-idle 'hl-line-toggle-when-idle) (defun hl-line-toggle-when-idle (&optional arg) -"Turn on or off using `global-hl-line-mode' when Emacs is idle. + "Turn on or off using `global-hl-line-mode' when Emacs is idle. When on, use `global-hl-line-mode' whenever Emacs is idle. With prefix argument, turn on if ARG > 0; else turn off." (interactive "P") @@ -176,11 +179,9 @@ With prefix argument, turn on if ARG > 0; else turn off." (if arg (> (prefix-numeric-value arg) 0) (not hl-line-when-idle-p))) (cond (hl-line-when-idle-p (timer-activate-when-idle hl-line-idle-timer) - (add-hook 'pre-command-hook 'hl-line-unhighlight-now) (message "Turned ON using `global-hl-line-mode' when Emacs is idle.")) (t (cancel-timer hl-line-idle-timer) - (remove-hook 'pre-command-hook 'hl-line-unhighlight-now) (message "Turned OFF using `global-hl-line-mode' when Emacs is idle.")))) (defun hl-line-when-idle-interval (secs) @@ -191,20 +192,20 @@ will be turned on. To turn on or off using `global-hl-line-mode' when idle, use `\\[toggle-hl-line-when-idle]." (interactive "nSeconds to idle, before using `global-hl-line-mode': ") - (timer-set-idle-time hl-line-idle-timer - (setq hl-line-idle-interval secs) - t)) + (timer-set-idle-time hl-line-idle-timer (setq hl-line-idle-interval secs) t)) (defun hl-line-highlight-now () "Turn on `global-hl-line-mode' and highlight current line now." (unless global-hl-line-mode (global-hl-line-mode 1) - (global-hl-line-highlight))) - + (global-hl-line-highlight) + (add-hook 'pre-command-hook 'hl-line-unhighlight-now))) + (defun hl-line-unhighlight-now () "Turn off `global-hl-line-mode' and unhighlight current line now." (global-hl-line-mode -1) - (global-hl-line-unhighlight)) + (global-hl-line-unhighlight) + (remove-hook 'pre-command-hook 'hl-line-unhighlight-now)) (defalias 'flash-line-highlight 'hl-line-flash) (defun hl-line-flash (&optional arg) lib/hl-line+.el @@ -1,388 +1,743 @@ -;;; icomplete-plus.el --- Extensions to `icomplete.el'. -;;; FILE SHOULD BE NAMED icomplete+.el, but EmacsWiki doesn't like that. -;; -;; Emacs Lisp Archive Entry -;; Filename: icomplete+.el -;; Description: Extensions to `icomplete.el'. -;; Author: Drew Adams -;; Maintainer: Drew Adams -;; Copyright (C) 1996-2004, Drew Adams, all rights reserved. -;; Created: Mon Oct 16 13:33:18 1995 -;; Version: 21.0 -;; Last-Updated: Tue Oct 05 00:27:41 2004 -;; By: dradams -;; Update #: 310 -;; Keywords: help, abbrev, internal, extensions, local -;; Compatibility: GNU Emacs 21.x, GNU Emacs 20.x -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Extensions to `icomplete.el'. -;; -;; New user options (variables) defined here: -;; -;; `icomplete-choices-face', `icomplete-determined-face'. -;; -;; -;; ***** NOTE: The following functions defined in `icomplete.el' -;; have been REDEFINED HERE: -;; -;; `icomplete-completions' - -;; Sorts alternatives and puts them in a different face. -;; `icomplete-exhibit' - Doesn't insert if input begins with `(' -;; (e.g. `repeat-complex-command'). -;; -;; -;; ***** NOTE: The following EMACS PRIMITIVES have been REDEFINED HERE -;; -;; `read-from-minibuffer' - -;; Resets `minibuffer-completion-table' to avoid icompletion. -;; `read-no-blanks-input' - -;; Resets `minibuffer-completion-table' to avoid icompletion. -;; `read-string' - -;; Resets `minibuffer-completion-table' to avoid icompletion. -;; -;; -;; This file should be loaded after loading the standard GNU file -;; `icomplete.el'. So, in your `~/.emacs' file, do this: -;; (eval-after-load "icomplete" '(progn (require 'icomplete+))) -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; 2004/09/21 dadams -;; Removed (icomplete-mode 99) at end. -;; 2004/04/13 dadams -;; I'm not sure that some of the "enhancements" here are still -;; needed. This code was written long ago. In particular, I'm not -;; sure that the changes to `icomplete-exhibit' and the -;; redefinitions of the Emacs primitives are needed. Even if they -;; are not needed, I'm leaving them in, as they are benign :). -;; 1995/12/15 dadams -;; Defined replacements that reset minibuffer-completion-table to avoid -;; icompletion: read-string, read-from-minibuffer, read-no-blanks-input. -;; 1995/11/30 dadams -;; Added redefinition of yes-or-no-p. -;; 1995/10/17 dadams -;; 1) Added icomplete-choices-face and icomplete-determined-face. -;; 2) Redefined icomplete-exhibit: Doesn't insert if input -;; begins with `(' (e.g. repeat-complex-command). -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; This program 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 program 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 this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(require 'icomplete) -(and (< emacs-major-version 20)(eval-and-compile (require 'cl))) ;; when, unless - -;; Get macro `define-face-const' when this is compiled, -;; or run interpreted, but not when the compiled code is loaded. -(eval-when-compile (require 'def-face-const)) - - -;;;;;;;;;;;;;;;;;;; - -(setq icomplete-prospects-length 150) ; Default was 80 - -;;;###autoload -(unless (boundp 'darkgoldenrod-foreground-face) - (define-face-const "DarkGoldenrod" nil)) -(defvar icomplete-choices-face darkgoldenrod-foreground-face - "*Face for minibuffer reminder of possible completion suffixes.") - -;;;###autoload -(unless (boundp 'seagreen-foreground-face) - (define-face-const "SeaGreen" nil)) -(defvar icomplete-determined-face seagreen-foreground-face - "*Face for minibuffer reminder of possible completion prefix.") - -(unless (boundp 'darkblue-foreground-face) - (define-face-const "DarkBlue" nil)) -(defvar icomplete-keys-face darkblue-foreground-face - "*Face for minibuffer reminder of possible completion key bindings.") - -;; REPLACES ORIGINAL defined in `icomplete.el': -;; Doesn't insert if input begins with `(' (e.g. `repeat-complex-command'). -;;;###autoload -(defun icomplete-exhibit () - "Insert icomplete completions display. -Should be run via minibuffer `post-command-hook'. -See `icomplete-mode' and `minibuffer-setup-hook'." - (when (icomplete-simple-completing-p) - (let* ((minibuf-begin (if (< emacs-major-version 21) - (point-min) - (minibuffer-prompt-end))) - (contents (buffer-substring minibuf-begin (point-max))) - (buffer-undo-list t)) - (save-excursion - (goto-char (point-max)) - ; Register the end of input, so we - ; know where the extra stuff - ; (match-status info) begins: - (unless (boundp 'icomplete-eoinput) - ;; In case it got wiped out by major mode business: - (make-local-variable 'icomplete-eoinput)) - (setq icomplete-eoinput (point)) - ; Insert the match-status information: - (when (and (> (point-max) minibuf-begin) - (save-excursion - (goto-char minibuf-begin) - (not (looking-at ; No (, ", ', 9 etc. at start. - "\\(\\s-+$\\|\\s-*\\(\\s(\\|\\s\"\\|\\s'\\|\\s<\\|\ -[0-9]\\)\\)"))) - (or - ;; Don't bother with delay after certain number of chars: - (> (point-max) icomplete-max-delay-chars) - ;; Don't delay if alternatives number is small enough: - (if minibuffer-completion-table - (cond ((numberp minibuffer-completion-table) - (< minibuffer-completion-table - icomplete-delay-completions-threshold)) - ((sequencep minibuffer-completion-table) - (< (length minibuffer-completion-table) - icomplete-delay-completions-threshold)) - )) - ;; Delay - give some grace time for next keystroke, before - ;; embarking on computing completions: - (sit-for icomplete-compute-delay))) - (insert - (icomplete-completions contents minibuffer-completion-table - minibuffer-completion-predicate - (not minibuffer-completion-confirm)))))))) - - -;; REPLACES ORIGINAL defined in `icomplete.el': -;; Sorts alternatives and puts them in a different face. -;;;###autoload -(defun icomplete-completions (name candidates predicate require-match) - "Identify prospective candidates for minibuffer completion. - -The display is updated with each minibuffer keystroke during -minibuffer completion. - -Prospective completion suffixes (if any) are displayed, bracketed by -\"()\", \"[]\", or \"{}\". The choice of brackets is as follows: - - \(...) - A single prospect is identified and matching is enforced. - \[...] - A single prospect is identified and matching is optional. - \{...} - Multiple prospects, separated by commas, are indicated, - and further input is required to distinguish a single one. - -The displays for unambiguous matches have \" [ Matched ]\" appended -\(whether complete or not), or \" \[ No match ]\", if no eligible -matches exist. \(Keybindings for uniquely matched commands -are exhibited within the square braces.)" - ;; 'all-completions' doesn't like empty - ;; minibuffer-completion-table's (ie: (nil)) - (when (and (listp candidates) (null (car candidates))) - (setq candidates nil)) - (let ((comps (all-completions name candidates predicate)) - ;; "-determined" - only one candidate - (open-bracket-determined (if require-match " (" " [")) - (close-bracket-determined (if require-match ")" "]"))) - ;; `concat'/`mapconcat' is the slow part. With the introduction of - ;; `icomplete-prospects-length', there is no need for `catch'/`throw'. - (if (null comps) (format "\t%sNo matches%s" - open-bracket-determined - close-bracket-determined) - (let* ((most-try (try-completion name (mapcar (function list) comps))) - (most (if (stringp most-try) most-try (car comps))) - (most-len (length most)) - (determ (and (> most-len (length name)) - (concat open-bracket-determined - (substring most (length name)) - close-bracket-determined))) - (open-bracket-prospects " { ") - (close-bracket-prospects " }") - ;; "-prospects" - more than one candidate - (prospects-len 0) - prompt prospects most-is-exact comp) - (if (eq most-try t) - (setq prospects nil) - (while (and comps (< prospects-len icomplete-prospects-length)) - (setq comp (substring (car comps) most-len) - comps (cdr comps)) - (cond ((string-equal comp "") (setq most-is-exact t)) - ((member comp prospects)) - (t (setq prospects (cons comp prospects) - prospects-len (+ (length comp) 1 prospects-len)))))) - (setq prompt - (if prospects - (concat determ - open-bracket-prospects - (and most-is-exact ",") - (mapconcat 'identity - (sort prospects (function string-lessp)) - ",") - (and comps ",...") - close-bracket-prospects) - (concat determ - "\t[Matched" - (let ((keys (and icomplete-show-key-bindings - (commandp (intern-soft most)) - (icomplete-get-keys most)))) - (if keys - (concat "; " keys) - "")) - "]"))) - (put-text-property (length determ) (length prompt) - 'face icomplete-choices-face prompt) - (put-text-property (point-min) (length determ) - 'face icomplete-determined-face prompt) - prompt)))) - - -;;; The following functions have been REDEFINED to reset the -;;; `minibuffer-completion-table' in order to avoid icompletion. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; Note: The function `read-input' is an alias for `read-string'. - -(or (fboundp 'old-read-string) -(fset 'old-read-string (symbol-function 'read-string))) - -;; REPLACES ORIGINAL: -;; Resets `minibuffer-completion-table' to avoid icompletion. -(defsubst read-string - (prompt &optional initial-input history default-value inherit-input-method) - "Read a string from the minibuffer, prompting with string PROMPT. -If non-nil, second arg INITIAL-INPUT is a string to insert before - reading. This argument has been superseded by DEFAULT-VALUE and - should normally be `nil' in new code. It behaves as in - `read-from-minibuffer'. See the documentation for that function. -The third arg HISTORY, if non-nil, specifies a history list and - optionally the initial position in that list. - See `read-from-minibuffer' for details of argument HISTORY. -Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used - for history commands and as the value to return if the user enters - an empty string. -Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer - inherits the current input method and setting of - `enable-multibyte-characters'." -; (setq minibuffer-completion-table nil) ; So won't icomplete by default. - (old-read-string prompt initial-input history default-value inherit-input-method)) - - -(or (fboundp 'old-read-from-minibuffer) -(fset 'old-read-from-minibuffer (symbol-function 'read-from-minibuffer))) - -;; REPLACES ORIGINAL: -;; Resets `minibuffer-completion-table' to avoid icompletion. -(defsubst read-from-minibuffer - (prompt - &optional initial-contents keymap read hist default-value inherit-input-method) - "Read a string from the minibuffer, prompting with string PROMPT. -The optional second arg INITIAL-CONTENTS is an obsolete alternative to - DEFAULT-VALUE. It normally should be nil in new code, except when - HIST is a cons. It is discussed in more detail below. -Third arg KEYMAP is a keymap to use while reading. - If omitted or nil, the default is `minibuffer-local-map'. -If fourth arg READ is non-nil, then interpret the result as a lisp - object and return that object. In other words, do this: - `(car (read-from-string INPUT-STRING))' -Fifth arg HIST, if non-nil, specifies a history list and optionally - the initial position in the list. - It can be a symbol, which is the history list variable to use, - or it can be a cons cell (HISTVAR . HISTPOS). - In that case, HISTVAR is the history-list variable to use, - and HISTPOS is the initial position for use by the minibuffer - history commands. For consistency, you should also specify that - element of the history as the value of INITIAL-CONTENTS. - Positions are counted starting from 1 at the beginning of the list. -Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is - available for history commands; but, unless READ is non-nil, - `read-from-minibuffer' does NOT return DEFAULT-VALUE if the user - enters empty input! It returns the empty string. -Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer - inherits the current input method and the setting of - `enable-multibyte-characters'. -If variable `minibuffer-allow-text-properties' is non-nil, then the - string returned includes whatever text properties were present in - the minibuffer. Otherwise the value has no text properties. - -The remainder of this documentation describes INITIAL-CONTENTS in more -detail. It is relevant only when studying existing code, or when HIST -is a cons. If non-nil, INITIAL-CONTENTS is a string to be inserted -into the minibuffer before reading input. Normally, point is put at -the end of that string. However, if INITIAL-CONTENTS is (STRING -. POSITION), the initial input is STRING, but point is placed at -_one-indexed_ position POSITION in the minibuffer. Any integer value -less than or equal to one puts point at the beginning of the string. -*Note* that this behavior differs from the way such arguments are used -in `completing-read' and some related functions, which use -zero-indexing for POSITION." -; (setq minibuffer-completion-table nil) ; So won't icomplete by default. - (old-read-from-minibuffer - prompt initial-contents keymap read hist default-value inherit-input-method)) - - -(or (fboundp 'old-read-no-blanks-input) -(fset 'old-read-no-blanks-input (symbol-function 'read-no-blanks-input))) - -;; REPLACES ORIGINAL: -;; Resets `minibuffer-completion-table' to avoid icompletion. -(defsubst read-no-blanks-input (prompt &optional initial-contents inherit-input-method) - "Read a string from the minibuffer, not allowing blanks. -Arg PROMPT is a prompt string. Whitespace terminates the input. - -If optional second arg INITIAL-CONTENTS is non-nil, it should be a -string, which is used as initial input, with point positioned at the -end, so that a SPACE will accept the input. INITIAL-CONTENTS can -alternatively be a cons of a string and an integer. Such values are -treated as in `read-from-minibuffer', but are normally not useful in -this function. - -Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer -inherits the current input method and the setting of -`enable-multibyte-characters'." -; (setq minibuffer-completion-table nil) ; So won't icomplete by default. - (old-read-no-blanks-input prompt initial-contents inherit-input-method)) - - -;;;@@@Emacs19 (or (fboundp 'old-yes-or-no-p) -;;;@@@Emacs19 (fset 'old-yes-or-no-p (symbol-function 'yes-or-no-p))) - -;;;@@@Emacs19 ;; REPLACES ORIGINAL (built-in function): -;;;@@@Emacs19 ;; Temporarily sets `icomplete-inhibit' to non-nil. -;;;@@@Emacs19 ;; -;;;@@@Emacs19 ;; (For some reason, the standard `yes-or-no-p' doesn't nullify -;;;@@@Emacs19 ;; `minibuffer-completion-table', and that is tested by -;;;@@@Emacs19 ;; `icomplete-pre-command-hook' to see if needs to do icompletion.) -;;;@@@Emacs19 (defsubst yes-or-no-p (prompt) -;;;@@@Emacs19 "Ask user a yes-or-no question. Return t if answer is yes. -;;;@@@Emacs19 Takes one argument, which is the string to display to ask the question. -;;;@@@Emacs19 It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it. -;;;@@@Emacs19 The user must confirm the answer with RET, -;;;@@@Emacs19 and can edit it until it has been confirmed." -;;;@@@Emacs19 (let ((icomplete-inhibit t)) (old-yes-or-no-p prompt))) - - -;;;;;;;;;;;;;;;;;;;;;;; - -(provide 'icomplete+) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; FILE SHOULD BE NAMED icomplete+.el, but EmacsWiki doesn't like that. -;;; icomplete-plus.el ends here - +;;; icomplete+.el --- Extensions to `icomplete.el'. +;; +;; Filename: icomplete+.el +;; Description: Extensions to `icomplete.el'. +;; Author: Drew Adams +;; Maintainer: Drew Adams +;; Copyright (C) 1996-2008, Drew Adams, all rights reserved. +;; Created: Mon Oct 16 13:33:18 1995 +;; Version: 21.0 +;; Last-Updated: Sun Jun 1 10:04:05 2008 (Pacific Daylight Time) +;; By: dradams +;; Update #: 866 +;; URL: http://www.emacswiki.org/cgi-bin/wiki/icomplete+.el +;; Keywords: help, abbrev, internal, extensions, local +;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x +;; +;; Features that might be required by this library: +;; +;; `icomplete'. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Extensions to `icomplete.el'. +;; +;; Faces defined here: +;; +;; `icompletep-choices', `icompletep-determined', +;; `icompletep-keys', `icompletep-nb-candidates'. +;; +;; User option defined here: +;; +;; `icompletep-prospects-length'. +;; +;; Macros defined here (but identical to those in Emacs 23): +;; +;; `with-local-quit', `with-no-input'. +;; +;; +;; ***** NOTE: The following functions defined in `icomplete.el' +;; have been REDEFINED HERE: +;; +;; `icomplete-completions' - +;; Prepends total number of candidates. +;; Sorts alternatives alphabetically, uses different face. +;; Highlights key-binding text. +;; Appends number of remaining cycle candidates (for Icicles). +;; +;; `icomplete-exhibit' - +;; Saves match-data. +;; Doesn't insert if input begins with `(' +;; (e.g. `repeat-complex-command'). +;; Ensures that the insertion doesn't deactivate mark. +;; +;; +;; This file should be loaded after loading the standard GNU file +;; `icomplete.el'. So, in your `~/.emacs' file, do this: +;; (eval-after-load "icomplete" '(progn (require 'icomplete+))) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change log: +;; +;; 2008/06/01 dadams +;; icomplete-completions (Emacs 23): Set candidates to nil if ((nil)). +;; Commented out vanilla Emacs code that's not used (last, base-size). +;; 2008/05/30 dadams +;; Updated for Emacs 23 - complete rewrite. +;; Added: macros with-local-quit and with-no-input. +;; Added and adapted icomplete-exhibit and icomplete-completions for Emacs 23. +;; icompletep-prospects-length: Use only for Emacs < 23. +;; icomplete-exhibit: Removed vestigial test of icicle-apropos-completing-p. +;; 2006/07/30 dadams +;; icomplete-exhibit: Save match-data. +;; 2006/07/16 dadams +;; Added dark-background face suggestions from Le Wang - thx. +;; 2006/06/18 dadams +;; icomplete-exhibit: Don't insert if Icicles apropos-completing. +;; 2006/01/07 dadams +;; Added :link for sending bug report. +;; 2006/01/06 dadams +;; Added defgroup. Added :link. +;; Renamed: prefix icomplete- to icompletep-. +;; 2005/12/18 dadams +;; Renamed faces without "-face". +;; Use defface. Removed require of def-face-const.el. +;; icomplete-prospects-length: defvar -> defcustom. +;; 2005/09/30 dadams +;; Commented out redefinitions of primitives, so no longer reset +;; minibuffer-completion-table to nil. Leaving the commented code in for now. +;; 2005/08/16 dadams +;; icomplete-completions: If icicles.el is loaded, change no-match message slightly. +;; 2005/07/24 dadams +;; icomplete-exhibit: Set deactivate-mark to nil at end. +;; Remove commented Emacs 19 code at end. +;; 2005/07/19 dadams +;; Added: icomplete-nb-candidates-face. +;; icomplete-completions: Add number of icomplete candidates. +;; Append number of other cycle candidates (icicle). +;; 2005/05/29 dadams +;; read-from-minibuffer: Updated to deal with new arg in Emacs 22. +;; 2004/12/02 dadams +;; Highlight keys (icomplete-completions). +;; 2004/09/21 dadams +;; Removed (icomplete-mode 99) at end. +;; 2004/04/13 dadams +;; I'm not sure that some of the "enhancements" here are still +;; needed. This code was written long ago. In particular, I'm not +;; sure that the changes to `icomplete-exhibit' and the +;; redefinitions of the Emacs primitives are needed. Even if they +;; are not needed, I'm leaving them in, as they are benign :). +;; 1995/12/15 dadams +;; Defined replacements that reset minibuffer-completion-table to avoid +;; icompletion: read-string, read-from-minibuffer, read-no-blanks-input. +;; 1995/11/30 dadams +;; Added redefinition of yes-or-no-p. +;; 1995/10/17 dadams +;; 1) Added icomplete-choices-face and icomplete-determined-face. +;; 2) Redefined icomplete-exhibit: Doesn't insert if input +;; begins with `(' (e.g. repeat-complex-command). +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program 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 program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(require 'icomplete) +(and (< emacs-major-version 20) (eval-when-compile (require 'cl))) ;; when, unless + +;;;;;;;;;;;;;;;;;;; + +(defgroup Icomplete-Plus nil + "Icomplete Enhancements." + :prefix "icompletep-" + :group 'completion :group 'convenience :group 'matching :group 'minibuffer + :link `(url-link :tag "Send Bug Report" + ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\ +icomplete+.el bug: \ +&body=Describe bug here, starting with `emacs -q'. \ +Don't forget to mention your Emacs and library versions.")) + :link '(url-link :tag "Other Libraries by Drew" + "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries") + :link '(url-link :tag "Download" + "http://www.emacswiki.org/cgi-bin/wiki/icomplete+.el") + :link '(url-link :tag "Description" + "http://www.emacswiki.org/cgi-bin/wiki/IcompleteMode#IcompleteModePlus") + :link '(emacs-commentary-link :tag "Commentary" "icomplete+") + ) + +(defface icompletep-choices + '((((background dark)) (:foreground "Snow4")) + (t (:foreground "DarkBlue"))) + "*Face for minibuffer reminder of possible completion suffixes." + :group 'Icomplete-Plus) + +(defface icompletep-determined + '((t (:foreground "SeaGreen"))) + "*Face for minibuffer reminder of possible completion prefix." + :group 'Icomplete-Plus) + +(defface icompletep-nb-candidates + '((((background dark)) (:foreground "SpringGreen")) + (t (:foreground "DarkMagenta"))) + "*Face for minibuffer reminder of number of completion candidates. +This has no effect unless library `icicles.el' is being used." + :group 'Icomplete-Plus) + +(defface icompletep-keys + '((t (:foreground "Red"))) + "*Face for minibuffer reminder of possible completion key bindings." + :group 'Icomplete-Plus) + +(when (< emacs-major-version 23) + (defcustom icompletep-prospects-length 100 ; Default was 80 + "*Length of string displaying icompletion candidates." + :type 'integer :group 'Icomplete-Plus)) + +;;; Quiet the byte-compiler. +(defvar icomplete-overlay) +(defvar icomplete-prospects-height) + + + +;; REPLACES ORIGINAL defined in `icomplete.el': +;; +;; Save match-data. +;; Don't insert if input begins with `(' (e.g. `repeat-complex-command'). +;; +;;;###autoload +(when (< emacs-major-version 23) ; Emacs 20, 21, 22. + (defun icomplete-exhibit () + "Insert icomplete completions display. +Should be run via minibuffer `post-command-hook'. +See `icomplete-mode' and `minibuffer-setup-hook'." + (when (icomplete-simple-completing-p) + (save-match-data + (let* ((minibuf-begin (if (< emacs-major-version 21) + (point-min) + (minibuffer-prompt-end))) + (contents (buffer-substring minibuf-begin (point-max))) + (buffer-undo-list t)) + (save-excursion + (goto-char (point-max)) + ;; Register the end of input, so we know where the extra stuff + ;; (match-status info) begins: + (unless (boundp 'icomplete-eoinput) + ;; In case it got wiped out by major mode business: + (make-local-variable 'icomplete-eoinput)) + (setq icomplete-eoinput (point)) + ;; Insert the match-status information: + (when (and (> (point-max) minibuf-begin) + (save-excursion ; Do nothing if looking at a list, string, etc. + (goto-char minibuf-begin) + (not (looking-at ; No (, ", ', 9 etc. at start. + "\\(\\s-+$\\|\\s-*\\(\\s(\\|\\s\"\\|\\s'\\|\\s<\\|[0-9]\\)\\)"))) + (or + ;; Don't bother with delay after certain number of chars: + (> (point-max) icomplete-max-delay-chars) + ;; Don't delay if alternatives number is small enough: + (if minibuffer-completion-table + (cond ((numberp minibuffer-completion-table) + (< minibuffer-completion-table + icomplete-delay-completions-threshold)) + ((sequencep minibuffer-completion-table) + (< (length minibuffer-completion-table) + icomplete-delay-completions-threshold)) + )) + ;; Delay - give some grace time for next keystroke, before + ;; embarking on computing completions: + (sit-for icomplete-compute-delay))) + (insert + (icomplete-completions contents minibuffer-completion-table + minibuffer-completion-predicate + (not minibuffer-completion-confirm))))) + (setq deactivate-mark nil)))))) ; Don't let the insert deactivate the mark. + + +;;; These two macros are defined in `subr.el' for Emacs 23+. +;;; They are included here only so you can, if needed, byte-compile this file using Emacs < 23 +;;; and still use the byte-compiled file in Emacs 23+. +(defmacro with-local-quit (&rest body) + "Execute BODY, allowing quits to terminate BODY but not escape further. +When a quit terminates BODY, `with-local-quit' returns nil but +requests another quit. That quit will be processed as soon as quitting +is allowed once again. (Immediately, if `inhibit-quit' is nil.)" + (declare (debug t) (indent 0)) + `(condition-case nil + (let ((inhibit-quit nil)) + ,@body) + (quit (setq quit-flag t) + ;; This call is to give a chance to handle quit-flag + ;; in case inhibit-quit is nil. + ;; Without this, it will not be handled until the next function + ;; call, and that might allow it to exit thru a condition-case + ;; that intends to handle the quit signal next time. + (eval '(ignore nil))))) + +(defmacro while-no-input (&rest body) ; Defined in `subr.el'. + "Execute BODY only as long as there's no pending input. +If input arrives, that ends the execution of BODY, +and `while-no-input' returns t. Quitting makes it return nil. +If BODY finishes, `while-no-input' returns whatever value BODY produced." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input"))) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym)) + (or (input-pending-p) + (progn ,@body))))))) + + + +;; REPLACES ORIGINAL defined in `icomplete.el': +;; +;; Save match-data. +;; Don't insert if input begins with `(' (e.g. `repeat-complex-command'). +;; +;;;###autoload +(when (> emacs-major-version 22) ; Emacs 23. + (defun icomplete-exhibit () + "Insert icomplete completions display. +Should be run via minibuffer `post-command-hook'. See `icomplete-mode' +and `minibuffer-setup-hook'." + (when (and icomplete-mode (icomplete-simple-completing-p)) + (save-match-data + (save-excursion + (goto-char (point-max)) + ;; Insert the match-status information. + (when (and (> (point-max) (minibuffer-prompt-end)) + buffer-undo-list ; Wait for some user input. + (save-excursion ; Do nothing if looking at a list, string, etc. + (goto-char (minibuffer-prompt-end)) + (not (looking-at ; No (, ", ', 9 etc. at start. + "\\(\\s-+$\\|\\s-*\\(\\s(\\|\\s\"\\|\\s'\\|\\s<\\|[0-9]\\)\\)"))) + (or + ;; Don't bother with delay after certain number of chars: + (> (- (point) (field-beginning)) icomplete-max-delay-chars) + ;; Don't delay if alternatives number is small enough: + (and (sequencep minibuffer-completion-table) + (< (length minibuffer-completion-table) + icomplete-delay-completions-threshold)) + ;; Delay - give some grace time for next keystroke, before + ;; embarking on computing completions: + (sit-for icomplete-compute-delay))) + (let ((text (while-no-input + (icomplete-completions (field-string) + minibuffer-completion-table + minibuffer-completion-predicate + (not minibuffer-completion-confirm)))) + (buffer-undo-list t) + deactivate-mark) + ;; Do nothing if `while-no-input' was aborted. + (when (stringp text) + (move-overlay icomplete-overlay (point) (point) (current-buffer)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t text) + (overlay-put icomplete-overlay 'after-string text))))))))) + + + +;; REPLACES ORIGINAL defined in `icomplete.el': +;; +;; 1. Prepends total number of candidates. +;; 2. Sorts alternatives, puts them in a different face, and separates them more. +;; 3. Highlights key-binding text. +;; 4. Appends number of remaining cycle candidates (for Icicles). +;; +;;;###autoload +(when (< emacs-major-version 23) ; Emacs 20, 21, 22. + (defun icomplete-completions (name candidates predicate require-match) + "Identify prospective candidates for minibuffer completion. +NAME is the name to complete. +CANDIDATES are the candidates to match. +PREDICATE filters matches: they succeed only if this returns non-nil. +REQUIRE-MATCH non-nil means the input must match a candidate. + +The display is updated with each minibuffer keystroke during +minibuffer completion. + +Prospective completion suffixes (if any) are displayed, bracketed by +\"()\", \"[]\", or \"{}\". The choice of brackets is as follows: + + \(...) - A single prospect is identified and matching is enforced. + \[...] - A single prospect is identified and matching is optional. + \{...} - Multiple prospects are indicated, and further input is + needed to distinguish a single one. + +The displays for unambiguous matches have \" [ Matched ]\" appended +\(whether complete or not), or \" \[ No match ]\", if no eligible +matches exist. +Keybindings for uniquely matched commands are displayed within the []. + +When more than one completion is available, the total number precedes +the suffixes display, like this: + M-x forw 14 (ard-) { char line list...} + +If library `icicles.el' is also loaded, then you can cycle +completions. When you change cycling direction, the number of +additional cycle candidates, besides the current one, is displayed +following the rest of the icomplete info: + M-x forward-line [Matched] (13 more)." + ;; `all-completions' doesn't like empty `minibuffer-completion-table's (ie: (nil)) + (when (and (listp candidates) (null (car candidates))) (setq candidates nil)) + (let ((comps (all-completions name candidates predicate)) + (open-bracket-determined (if require-match "(" " [")) + (close-bracket-determined (if require-match ") " "] ")) + (keys nil) + nb-candidates-string) + (setq nb-candidates (length comps)) + ;; `concat'/`mapconcat' is the slow part. With the introduction of + ;; `icompletep-prospects-length', there is no need for `catch'/`throw'. + (if (null comps) (format (if (fboundp 'icicle-apropos-complete) + "\t%sNo prefix matches%s" + "\t%sNo matches%s") + open-bracket-determined + close-bracket-determined) + (let* ((most-try (try-completion name (mapcar #'list comps))) + (most (if (stringp most-try) most-try (car comps))) + (most-len (length most)) + (determ (and (> most-len (length name)) + (concat open-bracket-determined + (substring most (length name)) + close-bracket-determined))) + (open-bracket-prospects "{ ") + (close-bracket-prospects " }") + (prospects-len 0) + prompt prompt-rest prospects most-is-exact comp) + (when determ + (put-text-property 0 (length determ) 'face 'icompletep-determined determ)) + (if (eq most-try t) + (setq prospects nil) + (while (and comps (< prospects-len icompletep-prospects-length)) + (setq comp (substring (car comps) most-len) + comps (cdr comps)) + (cond ((string-equal comp "") (setq most-is-exact t)) + ((member comp prospects)) + (t (setq prospects (cons comp prospects) + prospects-len (+ (length comp) 1 prospects-len)))))) + (setq prompt-rest + (if prospects + (concat open-bracket-prospects + (and most-is-exact ", ") + (mapconcat 'identity + (sort prospects (function string-lessp)) + " ") + (and comps "...") + close-bracket-prospects) + (concat "\t[ Matched" + (if (setq keys (and icomplete-show-key-bindings + (commandp (intern-soft most)) + (icomplete-get-keys most))) + (concat "; " keys) + (setq keys nil)) + " ]"))) + (put-text-property 0 (length prompt-rest) + 'face 'icompletep-choices prompt-rest) + (cond ((< nb-candidates 2) + (setq prompt (concat " " determ prompt-rest)) + (when (eq last-command this-command) + (setq icicle-nb-of-other-cycle-candidates 0))) ; We know now, so reset it. + (t + (setq nb-candidates-string (format "%7d " nb-candidates)) + (put-text-property (string-match "\\S-" nb-candidates-string) + (1- (length nb-candidates-string)) + 'face 'icompletep-nb-candidates nb-candidates-string) + (setq prompt (concat nb-candidates-string determ prompt-rest)))) + ;; Highlight keys, after "Matched; " (18 chars). + (when keys (put-text-property (+ 18 (length determ)) (1- (length prompt)) + 'face 'icompletep-keys prompt)) + ;; Append mention of number of other cycle candidates (from `icicles.el'). + (when (and (boundp 'icicle-last-completion-candidate) + (> icicle-nb-of-other-cycle-candidates 0) + (= 1 nb-candidates) + icicle-last-completion-candidate + (not (eq last-command this-command))) + (setq nb-candidates-string ; Reuse the string. + (format " (%d more)" icicle-nb-of-other-cycle-candidates)) + (put-text-property (string-match "\\S-" nb-candidates-string) + (length nb-candidates-string) + 'face 'icompletep-nb-candidates nb-candidates-string) + (setq prompt (concat prompt nb-candidates-string))) + prompt))))) + + + +;; REPLACES ORIGINAL defined in `icomplete.el': +;; +;; 1. Prepends total number of candidates. +;; 2. Sorts alternatives alphabetically, puts them in a different face, and separates them more. +;; 3. Highlights key-binding text. +;; 4. Appends number of remaining cycle candidates (for Icicles). +;; +;;;###autoload +(when (> emacs-major-version 22) ; Emacs 23. + (defun icomplete-completions (name candidates predicate require-match) + "Identify prospective candidates for minibuffer completion. +NAME is the name to complete. +CANDIDATES are the candidates to match. +PREDICATE filters matches: they succeed only if it returns non-nil. +REQUIRE-MATCH non-nil means the input must match a candidate. + +The display is updated with each minibuffer keystroke during +minibuffer completion. + +Prospective completion suffixes (if any) are displayed, bracketed by +\"()\", \"[]\", or \"{}\". The choice of brackets is as follows: + + \(...) - A single prospect is identified, and matching is enforced. + \[...] - A single prospect is identified, and matching is optional. + \{...} - Multiple prospects are indicated, and further input is + needed to distinguish a single one. + +The displays for unambiguous matches have ` [ Matched ]' appended +\(whether complete or not), or ` \[ No matches ]', if no eligible +matches exist. \(Keybindings for uniquely matched commands are +exhibited within the square brackets, [].) + +When more than one completion is available, the total number precedes +the suffixes display, like this: + M-x forw 14 (ard-) { char line list...} + +If library `icicles.el' is also loaded, then you can cycle +completions. When you change cycling direction, the number of +additional cycle candidates, besides the current one, is displayed +following the rest of the icomplete info: + M-x forward-line [Matched] (13 more)." + ;; `all-completions' doesn't like empty `minibuffer-completion-table's (ie: (nil)) + (when (and (listp candidates) (null (car candidates))) (setq candidates nil)) + (let* (;; Don't use `completion-all-sorted-completions' as in vanilla Emacs. + ;; We need the number of comps, and we don't need that sort order. + ;; (comps (completion-all-sorted-completions)) + (comps (all-completions name candidates predicate)) + (nb-candidates (length comps)) +;;; We don't use `completion-all-sorted-completions', so we don't need `last' or `base-size'. +;;; $$$$$ (last (if (consp comps) (last comps))) +;;; (base-size (cdr last)) + (open-bracket (if require-match "(" " [")) + (close-bracket (if require-match ") " "] "))) + ;; `concat'/`mapconcat' is the slow part. + (if (not (consp comps)) + (format (if (fboundp 'icicle-apropos-complete) + "\t%sNo prefix matches%s" + "\t%sNo matches%s") + open-bracket close-bracket) +;;; $$$$$ (if last (setcdr last nil)) + (let* ((most-try +;;; $$$$$ (if (and base-size (> base-size 0)) +;;; (completion-try-completion name candidates predicate (length name)) +;;; ;; If `comps' are 0-based, result should be the same with `comps'. + (completion-try-completion name comps nil (length name))) + (most (if (consp most-try) (car most-try) (if most-try (car comps) ""))) + ;; Compare name and most, so we can determine if name is + ;; a prefix of most, or something else. + (compare (compare-strings name nil nil most nil nil completion-ignore-case)) + (determ (and (not (or (eq t compare) (eq t most-try) + (= (setq compare (1- (abs compare))) (length most)))) + (concat open-bracket + (cond ((= compare (length name)) ; Typical: name is a prefix + (substring most compare)) + ((< compare 5) most) + (t (concat "..." (substring most compare)))) + close-bracket))) + (prospects-len (+ (string-width (buffer-string)) ; for prompt + 8 ; for `nb-candidates-string': "%7d " + (length determ) ; for determined part + 2 ; for "{ " + -2 ; for missing last " " after last candidate + 5)) ; for "... }" + (prospects-max + ;; Max total length to use, including the minibuffer content. + (* (+ icomplete-prospects-height + ;; If the minibuffer content already uses up more than + ;; one line, increase the allowable space accordingly. + (/ prospects-len (window-width))) + (window-width))) + (prefix-len + ;; Find the common prefix among `comps'. + (if (eq t (compare-strings (car comps) nil (length most) most nil nil + completion-ignore-case)) + (length most) ; Common case. + (let ((comps-prefix (try-completion "" comps))) + (and (stringp comps-prefix) (length comps-prefix))))) + (keys nil) + prompt nb-candidates-string prompt-rest + prospects most-is-exact comp limit) + (when determ + (put-text-property 0 (length determ) 'face 'icompletep-determined determ)) + (if (eq most-try t) ; (or (null (cdr comps)) + (setq prospects nil) + (while (and comps (not limit)) + (setq comp (if prefix-len (substring (car comps) prefix-len) (car comps)) + comps (cdr comps)) + (cond ((string-equal comp "") (setq most-is-exact t)) + ((member comp prospects)) + (t (setq prospects-len (+ (string-width comp) + 2 ; for " " + prospects-len)) + (if (< prospects-len prospects-max) + (push comp prospects) + (setq limit t)))))) +;;; $$$$$ ;; Restore the base-size info, since `completion-all-sorted-completions' is cached. +;;; (when last (setcdr last base-size)) + (setq prompt-rest + (if prospects + (concat "{ " (and most-is-exact ", ") + (mapconcat 'identity (sort prospects (function string-lessp)) " ") + (and limit "...") " }") + (concat "\t[ Matched" + (if (setq keys (and icomplete-show-key-bindings + (commandp (intern-soft most)) + (icomplete-get-keys most))) + (concat "; " keys) + (setq keys nil)) + " ]"))) + (put-text-property 0 (length prompt-rest) 'face 'icompletep-choices prompt-rest) + (cond ((< nb-candidates 2) + (setq prompt (concat " " determ prompt-rest)) + (when (eq last-command this-command) + (setq icicle-nb-of-other-cycle-candidates 0))) ; We know now, so reset it. + (t + (setq nb-candidates-string (format "%7d " nb-candidates)) + (put-text-property (string-match "\\S-" nb-candidates-string) + (1- (length nb-candidates-string)) + 'face 'icompletep-nb-candidates nb-candidates-string) + (setq prompt (concat nb-candidates-string determ prompt-rest)))) + ;; Highlight keys, after "Matched; " (18 chars). + (when keys (put-text-property (+ 18 (length determ)) (1- (length prompt)) + 'face 'icompletep-keys prompt)) + ;; Append mention of number of other cycle candidates (from `icicles.el'). + (when (and (boundp 'icicle-last-completion-candidate) + (> icicle-nb-of-other-cycle-candidates 0) + (= 1 nb-candidates) + icicle-last-completion-candidate + (not (eq last-command this-command))) + (setq nb-candidates-string ; Reuse the string. + (format " (%d more)" icicle-nb-of-other-cycle-candidates)) + (put-text-property (string-match "\\S-" nb-candidates-string) + (length nb-candidates-string) + 'face 'icompletep-nb-candidates nb-candidates-string) + (setq prompt (concat prompt nb-candidates-string))) + prompt))))) + + + +;;; The following functions have been REDEFINED to reset the +;;; `minibuffer-completion-table' in order to avoid icompletion. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;; Note: The function `read-input' is an alias for `read-string'. + +;; (or (fboundp 'old-read-string) +;; (fset 'old-read-string (symbol-function 'read-string))) + +;; ;; REPLACES ORIGINAL: +;; ;; Resets `minibuffer-completion-table' to avoid icompletion. +;; (defsubst read-string +;; (prompt &optional initial-input history default-value inherit-input-method) +;; "Read a string from the minibuffer, prompting with string PROMPT. +;; If non-nil, second arg INITIAL-INPUT is a string to insert before +;; reading. This argument has been superseded by DEFAULT-VALUE and +;; should normally be `nil' in new code. It behaves as in +;; `read-from-minibuffer'. See the documentation for that function. +;; The third arg HISTORY, if non-nil, specifies a history list and +;; optionally the initial position in that list. +;; See `read-from-minibuffer' for details of argument HISTORY. +;; Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used +;; for history commands and as the value to return if the user enters +;; an empty string. +;; Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer +;; inherits the current input method and setting of +;; `enable-multibyte-characters'." +;; (setq minibuffer-completion-table nil) ; So won't icomplete by default. +;; (old-read-string prompt initial-input history default-value inherit-input-method)) + + +;; (or (fboundp 'old-read-from-minibuffer) +;; (fset 'old-read-from-minibuffer (symbol-function 'read-from-minibuffer))) + +;; ;; REPLACES ORIGINAL: +;; ;; Resets `minibuffer-completion-table' to avoid icompletion. +;; (defsubst read-from-minibuffer +;; (prompt &optional initial-contents keymap read hist default-value +;; inherit-input-method keep-all) +;; "Read a string from the minibuffer, prompting with string PROMPT. +;; The optional second arg INITIAL-CONTENTS is an obsolete alternative to +;; DEFAULT-VALUE. It normally should be nil in new code, except when +;; HIST is a cons. It is discussed in more detail below. +;; Third arg KEYMAP is a keymap to use while reading; +;; if omitted or nil, the default is `minibuffer-local-map'. +;; If fourth arg READ is non-nil, then interpret the result as a Lisp +;; object and return that object. In other words, do this: +;; `(car (read-from-string INPUT-STRING))' +;; Fifth arg HIST, if non-nil, specifies a history list and optionally +;; the initial position in the list. +;; It can be a symbol, which is the history list variable to use, +;; or it can be a cons cell (HISTVAR . HISTPOS). +;; In that case, HISTVAR is the history-list variable to use, +;; and HISTPOS is the initial position for use by the minibuffer +;; history commands. For consistency, you should also specify that +;; element of the history as the value of INITIAL-CONTENTS. +;; Positions are counted starting from 1 at the beginning of the list. +;; Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is +;; available for history commands; but, unless READ is non-nil, +;; `read-from-minibuffer' does NOT return DEFAULT-VALUE if the user +;; enters empty input! It returns the empty string. +;; Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer +;; inherits the current input method and the setting of +;; `enable-multibyte-characters'. +;; Eighth arg KEEP-ALL, if non-nil, says to put all inputs in the history +;; list, even empty or duplicate inputs. (This argument is not available +;; in Emacs versions prior to Emacs 22.) +;; If variable `minibuffer-allow-text-properties' is non-nil, then the +;; string returned includes whatever text properties were present in +;; the minibuffer. Otherwise the value has no text properties. + +;; The remainder of this documentation describes INITIAL-CONTENTS in more +;; detail. It is relevant only when studying existing code, or when HIST +;; is a cons. If non-nil, INITIAL-CONTENTS is a string to be inserted +;; into the minibuffer before reading input. Normally, point is put at +;; the end of that string. However, if INITIAL-CONTENTS is (STRING . +;; POSITION), the initial input is STRING, but point is placed at +;; _one-indexed_ position POSITION in the minibuffer. Any integer value +;; less than or equal to one puts point at the beginning of the string. +;; *Note* that this behavior differs from the way such arguments are used +;; in `completing-read' and some related functions, which use +;; zero-indexing for POSITION." +;; (setq minibuffer-completion-table nil) ; So won't icomplete by default. +;; (if (or (string-match "22." emacs-version) (string-match "21.3.50" emacs-version)) +;; (old-read-from-minibuffer prompt initial-contents keymap read hist +;; default-value inherit-input-method keep-all) +;; (old-read-from-minibuffer prompt initial-contents keymap read hist +;; default-value inherit-input-method))) ; No KEEP-ALL + + +;; (or (fboundp 'old-read-no-blanks-input) +;; (fset 'old-read-no-blanks-input (symbol-function 'read-no-blanks-input))) + +;; ;; REPLACES ORIGINAL: +;; ;; Resets `minibuffer-completion-table' to avoid icompletion. +;; (defsubst read-no-blanks-input (prompt &optional initial-contents inherit-input-method) +;; "Read a string from the minibuffer, not allowing blanks. +;; Arg PROMPT is a prompt string. Whitespace terminates the input. + +;; If optional second arg INITIAL-CONTENTS is non-nil, it should be a +;; string, which is used as initial input, with point positioned at the +;; end, so that a SPACE will accept the input. INITIAL-CONTENTS can +;; alternatively be a cons of a string and an integer. Such values are +;; treated as in `read-from-minibuffer', but are normally not useful in +;; this function. + +;; Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer +;; inherits the current input method and the setting of +;; `enable-multibyte-characters'." +;; (setq minibuffer-completion-table nil) ; So won't icomplete by default. +;; (old-read-no-blanks-input prompt initial-contents inherit-input-method)) + +;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'icomplete+) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; icomplete+.el ends here + lib/icomplete+.el af373b6f41032d541fabc0a5b5de88c661a00573 Yann Hodique yann.hodique@gmail.com http://github.com/sigma/dotfiles/commit/97deba24f91948f7ba25aa1be1a13d4d30c937d9 97deba24f91948f7ba25aa1be1a13d4d30c937d9 2008-06-14T11:39:16-07:00 2008-06-14T11:39:16-07:00 [project @ yann.hodique@gmail.com-20080614183916-sh62eh5229p1bfai] merge from work 10537b354b37cca1cc90e2de1369c1417ebfe392 Yann Hodique yann.hodique@gmail.com