Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
6567 lines (6066 sloc) 362 KB
;;; icicles-fn.el --- Non-interactive functions for Icicles
;;
;; Filename: icicles-fn.el
;; Description: Non-interactive functions for Icicles
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2012, Drew Adams, all rights reserved.
;; Created: Mon Feb 27 09:25:53 2006
;; Version: 22.0
;; Last-Updated: Fri Jan 20 15:15:56 2012 (-0800)
;; By: dradams
;; Update #: 12853
;; URL: http://www.emacswiki.org/cgi-bin/wiki/icicles-fn.el
;; Keywords: internal, extensions, help, abbrev, local, minibuffer,
;; keys, apropos, completion, matching, regexp, command
;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
;;
;; Features that might be required by this library:
;;
;; `apropos', `apropos-fn+var', `backquote', `bytecomp', `cl',
;; `el-swank-fuzzy', `ffap', `ffap-', `fuzzy', `fuzzy-match',
;; `hexrgb', `icicles-face', `icicles-opt', `icicles-var',
;; `kmacro', `levenshtein', `naked', `regexp-opt', `thingatpt',
;; `thingatpt+', `wid-edit', `wid-edit+', `widget'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This is a helper library for library `icicles.el'. It defines
;; non-interactive functions. For Icicles documentation, see
;; `icicles-doc1.el' and `icicles-doc2.el'.
;;
;; Macros defined here:
;;
;; `icicle-maybe-cached-action'.
;;
;; Non-interactive functions defined here:
;;
;; `assq-delete-all', `icicle-2nd-part-string-less-p',
;; `icicle-abbreviate-or-expand-file-name',
;; `icicle-all-completions', `icicle-alpha-p',
;; `icicle-alt-act-fn-for-type', `icicle-any-candidates-p',
;; `icicle-apropos-any-candidates-p',
;; `icicle-apropos-any-file-name-candidates-p',
;; `icicle-apropos-candidates', `icicle-assoc-delete-all',
;; `icicle-barf-if-outside-Completions',
;; `icicle-barf-if-outside-Completions-and-minibuffer',
;; `icicle-barf-if-outside-minibuffer',
;; `icicle-buffer-file/process-name-less-p',
;; `icicle-buffer-smaller-p',
;; `icicle-call-then-update-Completions', `icicle-candidate-set-1',
;; `icicle-candidate-short-help',
;; `icicle-case-insensitive-string-less-p',
;; `icicle-case-string-less-p', `icicle-cdr-lessp',
;; `icicle-choose-completion-string', `icicle-clear-lighter',
;; `icicle-clear-minibuffer', `icicle-color-name-w-bg',
;; `icicle-color-rgb-lessp', `icicle-command-abbrev-save',
;; `icicle-command-abbrev-used-more-p',
;; `icicle-command-names-alphabetic-p',
;; `icicle-complete-again-update', `icicle-completing-p',
;; `icicle-completing-read', `icicle-completing-read-multiple',
;; `icicle-completing-read-history',
;; `icicle-completion-all-completions',
;; `icicle-completion-setup-function',
;; `icicle-completion-try-completion', `icicle-current-TAB-method',
;; `icicle-custom-type', `icicle-define-crm-completion-map',
;; `icicle-delete-alist-dups', `icicle-delete-count',
;; `icicle-delete-dups', `icicle-delete-whitespace-from-string',
;; `icicle-dired-read-shell-command',
;; `icicle-dired-smart-shell-command',
;; `icicle-dir-prefix-wo-wildcards', `icicle-dirs-first-p',
;; `icicle-dirs-last-p', `icicle-displayable-cand-from-saved-set',
;; `icicle-display-cand-from-full-cand',
;; `icicle-display-completion-list', `icicle-display-Completions',
;; `icicle-display-candidates-in-Completions',
;; `icicle-expanded-common-match',
;; `icicle-expanded-common-match-1', `icicle-expand-file-name-20',
;; `icicle-expand-file-or-dir-name',
;; `icicle-explicit-saved-completion-candidates',
;; `icicle-extra-candidates-first-p',
;; `icicle-face-valid-attribute-values', `icicle-file-directory-p',
;; `icicle-file-name-apropos-candidates',
;; `icicle-file-name-directory',
;; `icicle-file-name-directory-w-default',
;; `icicle-file-name-input-p', `icicle-file-name-nondirectory',
;; `icicle-file-name-prefix-candidates', `icicle-file-readable-p',
;; `icicle-file-remote-p', `icicle-file-type-less-p',
;; `icicle-file-writable-p', `icicle-filesets-files-under',
;; `icicle-files-within', `icicle-files-within-1',
;; `icicle-filter-alist', `icicle-filter-wo-input',
;; `icicle-first-matching-candidate', `icicle-first-N',
;; `icicle-fit-completions-window', `icicle-fix-default-directory',
;; `icicle-flat-list', `icicle-frames-on',
;; `icicle-fuzzy-candidates', `icicle-get-alist-candidate',
;; `icicle-get-candidates-from-saved-set',
;; `icicle-dired-guess-shell-command', `icicle-help-line-buffer',
;; `icicle-help-line-file',
;; `icicle-highlight-candidate-in-Completions',
;; `icicle-highlight-complete-input',
;; `icicle-highlight-initial-whitespace',
;; `icicle-highlight-input-noncompletion',
;; `icicle-highlight-input-noncompletion-rest',
;; `icicle-highlight-lighter', `icicle-historical-alphabetic-p',
;; `icicle-increment-cand-nb+signal-end',
;; `icicle-input-from-minibuffer', `icicle-insert-candidates',
;; `icicle-insert-cand-in-minibuffer',
;; `icicle-insert-Completions-help-string',
;; `icicle-isearch-complete-past-string', `icicle-join-nth-parts',
;; `icicle-key-description', `icicle-kill-a-buffer',
;; `icicle-last-modified-first-p', `icicle-levenshtein-match',
;; `icicle-levenshtein-one-match', `icicle-levenshtein-one-regexp',
;; `icicle-levenshtein-strict-match',
;; `icicle-lisp-vanilla-completing-read',
;; `icicle-local-keys-first-p', `icicle-make-plain-predicate',
;; `icicle-major-mode-name-less-p', `icicle-make-face-candidate',
;; `icicle-maybe-sort-and-strip-candidates',
;; `icicle-maybe-sort-maybe-truncate', `icicle-mctize-all',
;; `icicle-mctized-display-candidate',
;; `icicle-mctized-full-candidate',
;; `icicle-merge-saved-order-less-p',
;; `icicle-minibuffer-default-add-completions',
;; `icicle-minibuf-input', `icicle-minibuf-input-sans-dir',
;; `icicle-minibuffer-default-add-dired-shell-commands',
;; `icicle-minibuffer-prompt-end', `icicle-mode-line-name-less-p',
;; `icicle-most-recent-first-p', `icicle-msg-maybe-in-minibuffer',
;; `icicle-ms-windows-NET-USE', `icicle-multi-sort',
;; `icicle-next-candidate', `icicle-not-basic-prefix-completion-p',
;; `icicle-part-1-cdr-lessp', `icicle-part-1-lessp',
;; `icicle-part-2-lessp', `icicle-part-3-lessp',
;; `icicle-part-4-lessp', `icicle-part-N-lessp',
;; `icicle-place-cursor', `icicle-place-overlay',
;; `icicle-position', `icicle-prefix-any-candidates-p',
;; `icicle-prefix-any-file-name-candidates-p',
;; `icicle-prefix-candidates', `icicle-prefix-keys-first-p',
;; `icicle-propertize', `icicle-proxy-candidate-first-p',
;; `icicle-put-at-head', `icicle-put-whole-cand-prop',
;; `icicle-quote-file-name-part-of-cmd',
;; `icicle-readable-to-markers', `icicle-char-cands-from-charlist',
;; `icicle-read-char-by-name', `icicle-read-char-exclusive',
;; `icicle-read-char-maybe-completing', `icicle-read-face-name',
;; `icicle-read-file-name', `icicle-read-from-minibuffer',
;; `icicle-read-from-minibuf-nil-default', `icicle-read-number',
;; `icicle-read-shell-command',
;; `icicle-read-shell-command-completing', `icicle-read-string',
;; `icicle-read-string-completing',
;; `icicle-recentf-make-menu-items', `icicle-recompute-candidates',
;; `icicle-redefine-standard-options',
;; `icicle-redefine-std-completion-fns',
;; `icicle-remove-color-duplicates', `icicle-remove-dots',
;; `icicle-remove-duplicates', `icicle-remove-dups-if-extras',
;; `icicle-remove-if', `icicle-remove-if-not',
;; `icicle-remove-property', `icicle-replace-mct-cand-in-mct',
;; `icicle-require-match-p', `icicle-restore-standard-commands',
;; `icicle-restore-standard-options',
;; `icicle-restore-std-completion-fns', `icicle-reversible-sort',
;; `icicle-saved-fileset-p', `icicle-save-or-restore-input',
;; `icicle-save-raw-input', `icicle-scatter',
;; `icicle-scatter-match', `icicle-scroll-or-update-Completions',
;; `icicle-set-difference', `icicle-set-intersection',
;; `icicle-set-union', `icicle-shell-command',
;; `icicle-shell-command-on-region',
;; `icicle-show-help-in-mode-line', `icicle-show-in-mode-line',
;; `icicle-some', `icicle-special-candidates-first-p',
;; `icicle-start-of-candidates-in-Completions',
;; `icicle-strip-ignored-files-and-sort',
;; `icicle-subst-envvar-in-file-name',
;; `icicle-substring-no-properties', `icicle-substrings-of-length',
;; `icicle-take', `icicle-toggle-icicle-mode-twice',
;; `icicle-transform-candidates',
;; `icicle-transform-multi-completion', `icicle-try-switch-buffer',
;; `icicle-ucs-names', `icicle-unhighlight-lighter',
;; `icicle-unpropertize-completion',
;; `icicle-unsorted-apropos-candidates',
;; `icicle-unsorted-file-name-apropos-candidates',
;; `icicle-unsorted-file-name-prefix-candidates',
;; `icicle-unsorted-prefix-candidates', `icicle-upcase',
;; `icicle-value-satisfies-type-p', `icicle-var-inherits-type-p',
;; `icicle-var-is-of-type-p', `icicle-var-matches-type-p',
;; `icicle-var-val-satisfies-type-p',
;; `old-choose-completion-string', `old-completing-read',
;; `old-completing-read-multiple', `old-completion-setup-function',
;; `old-dired-smart-shell-command', `old-display-completion-list',
;; `old-face-valid-attribute-values',
;; `old-minibuffer-default-add-completions',
;; `old-read-char-by-name', `old-read-face-name',
;; `old-read-from-minibuffer', `old-read-number',
;; `old-read-string', `old-shell-command',
;; `old-shell-command-on-region', `select-frame-set-input-focus'.
;;
;; Internal variables defined here:
;;
;; `icicle-crm-local-completion-map',
;; `icicle-crm-local-must-match-map', `icicle-dirs-done',
;; `icicle-files', `old-crm-local-completion-map',
;; `old-crm-local-must-match-map'.
;;
;;
;; ***** NOTE: This vanilla Emacs function is defined here for
;; Emacs 20, where it does not exist.
;;
;; `replace-regexp-in-string' (Emacs 20).
;;
;;
;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
;;
;; `completing-read' - (See doc string.)
;; `display-completion-list' - (See doc string.)
;; `face-valid-attribute-values' - (See doc string.)
;; `read-file-name' Emacs 20, 21 only - (See doc string.)
;; `read-from-minibuffer' - (See doc string.)
;; `read-string' - (See doc string.)
;;
;;
;; ***** NOTE: The following functions defined in `simple.el' have
;; been REDEFINED HERE:
;;
;; `choose-completion-string' -
;; Don't exit minibuffer after `lisp-complete-symbol' completion.
;; `completion-setup-function' - 1. Put faces on inserted string(s).
;; 2. Help on help.
;; `repeat-complex-command' - Use `completing-read' to read command.
;;
;;
;; ***** NOTE: The following function defined in `filesets.el' has
;; been REDEFINED HERE:
;;
;; `filesets-get-filelist' - Fix. Bug #976 reported to Emacs devel.
;;
;; For descriptions of changes to this file, see `icicles-chg.el'.
;;(@> "Index")
;;
;; If you have library `linkd.el' and Emacs 22 or later, load
;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
;; navigate around the sections of this doc. Linkd mode will
;; highlight this Index, as well as the cross-references and section
;; headings throughout this file. You can get `linkd.el' here:
;; http://dto.freeshell.org/notebook/Linkd.html.
;;
;; (@> "Redefined standard functions")
;; (@> "Icicles functions - completion display (not cycling)")
;; (@> "Icicles functions - TAB completion cycling")
;; (@> "Icicles functions - S-TAB completion cycling")
;; (@> "Icicles functions - common helper functions")
;; (@> "Icicles functions - sort functions")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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:
(eval-when-compile (require 'cl)) ;; case, lexical-let, loop
;; plus, for Emacs < 21: dolist, push, pop
(require 'hexrgb nil t) ;; (no error if not found): hexrgb-color-name-to-hex
(require 'wid-edit+ nil t) ;; (no error if not found):
;; redefined color widget (for icicle-var-is-of-type-p)
(eval-when-compile
(or (condition-case nil
(load-library "icicles-mac") ; Use load-library to ensure latest .elc.
(error nil))
(require 'icicles-mac))) ; Require, so can load separately if not on `load-path'.
;; icicle-with-selected-window
(require 'icicles-opt) ; (This is required anyway by `icicles-var.el'.)
;; icicle-Completions-display-min-input-chars, icicle-expand-input-to-common-match-flag,
;; icicle-hide-common-match-in-Completions-flag, icicle-hide-non-matching-lines-flag,
;; icicle-highlight-historical-candidates-flag, icicle-highlight-input-initial-whitespace-flag,
;; icicle-ignore-space-prefix-flag, icicle-incremental-completion-delay,
;; icicle-incremental-completion-flag, icicle-incremental-completion-threshold,
;; icicle-default-value, icicle-list-join-string, icicle-mark-position-in-candidate,
;; icicle-point-position-in-candidate, icicle-regexp-quote-flag, icicle-require-match-flag,
;; icicle-show-Completions-help-flag, icicle-sort-comparer, icicle-special-candidate-regexp,
;; icicle-transform-function, icicle-use-~-for-home-dir-flag
(require 'icicles-var)
;; icicle-candidate-nb, icicle-candidate-action-fn, icicle-candidate-properties-alist,
;; icicle-cmd-calling-for-completion, icicle-common-match-string, icicle-complete-input-overlay,
;; icicle-completing-p, icicle-completion-candidates, icicle-current-completion-mode,
;; icicle-current-input, icicle-current-raw-input, icicle-default-directory, icicle-edit-update-p,
;; icicle-extra-candidates, icicle-ignored-extensions-regexp, icicle-incremental-completion-p,
;; icicle-initial-value, icicle-last-completion-candidate, icicle-last-input,
;; icicle-must-match-regexp, icicle-must-not-match-regexp, icicle-must-pass-predicate,
;; icicle-must-pass-after-match-predicate, icicle-nb-of-other-cycle-candidates, icicle-re-no-dot,
;; icicle-reverse-sort-p, icicle-saved-completion-candidates
;; This requirement is real, but leads to recursion.
;; You should, in any case, just load everything by loading `icicles.el'.
;; (require 'icicles-mode) ;; icicle-mode
;; Byte-compiling this file, you will likely get some error or warning
;; messages due to differences between different versions of Emacs.
;;; Defvars to quiet the byte-compiler:
(when (< emacs-major-version 22)
(defvar completion-common-substring)
(defvar completion-root-regexp)
(defvar minibuffer-completing-symbol)
(defvar minibuffer-prompt-properties)
(defvar partial-completion-mode)
(defvar read-file-name-completion-ignore-case)
(defvar minibuffer-local-filename-completion-map)
(defvar minibuffer-local-must-match-filename-map)
(defvar minibuffer-local-filename-must-match-map)
(defvar read-file-name-predicate)
(defvar tooltip-mode))
(when (< emacs-major-version 23)
(defvar completion-styles) ; In `minibuffer.el'
(defvar icicle-Completions-text-scale-decrease)) ; In `icicles-opt.el' (for Emacs 23)
(defvar completion-root-regexp) ; In `simple.el' (for Emacs 22 and 23.1)
(defvar doremi-boost-down-keys) ; In `doremi.el'
(defvar doremi-boost-up-keys) ; In `doremi.el'
(defvar doremi-down-keys) ; In `doremi.el'
(defvar doremi-up-keys) ; In `doremi.el'
(defvar eyedrop-picked-background) ; In `eyedrop.el' and `palette.el'
(defvar eyedrop-picked-foreground) ; In `eyedrop.el' and `palette.el'
(defvar filesets-data) ; In `filesets.el'
(defvar font-width-table) ; In C code.
(defvar font-weight-table) ; In C code.
(defvar font-slant-table) ; In C code.
(defvar icicle-read-char-history) ; In `icicles-var.el' for Emacs 23+.
(defvar list-colors-sort) ; In `facemenu.el'
(defvar 1on1-*Completions*-frame-flag) ; In `oneonone.el'
(defvar shell-completion-execonly) ; In `shell.el'
(defvar recentf-list) ; In `recentf.el'
(defvar recentf-menu-filter-commands)
(defvar recentf-menu-filter)
(defvar recentf-max-menu-items)
(defvar recentf-menu-open-all-flag)
(defvar recentf-menu-filter-commands)
(defvar recentf-menu-items-for-commands)
(defvar ucs-names) ; In `mule-cmds.el'.
;; The name changed during development of Emacs 23. They aliased it for 23.1, but removed it for 23.2.
;; Use the new name and alias the old, but don't declare old obsolete (let Emacs 23 do that.)
(when (and (boundp 'minibuffer-local-must-match-filename-map) (fboundp 'defvaralias)) ; Emacs 22
(defvar minibuffer-local-filename-must-match-map minibuffer-local-must-match-filename-map
"Local keymap for minibuffer input with completion for filenames with exact match.")
(defvaralias 'minibuffer-local-must-match-filename-map 'minibuffer-local-filename-must-match-map))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(@* "Redefined standard functions")
;;; Redefined standard functions -------------------------------------
;; REPLACE ORIGINAL `choose-completion-string' in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Don't exit minibuffer if this is just a `lisp-complete-symbol' completion.
;; Go to point-max before insert choice. Respect `icicle-dir-candidate-can-exit-p'.
;;
;; Free variable `completion-reference-buffer' is defined in `simple.el'.
;;
(unless (fboundp 'old-choose-completion-string)
(defalias 'old-choose-completion-string (symbol-function 'choose-completion-string)))
(cond ((> emacs-major-version 21) ; Emacs 22+
(defun icicle-choose-completion-string (choice &optional buffer base-size)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-SIZE, if non-nil, says how many characters of BUFFER's text
to keep. If it is nil, we call `choose-completion-delete-max-match'
to decide what to delete.
If BUFFER is the minibuffer, then exit the minibuffer, unless one of
the following is true:
- it is reading a file name, CHOICE is a directory, and
`icicle-dir-candidate-can-exit-p' is nil
- `completion-no-auto-exit' is non-nil
- this is just a `lisp-complete-symbol' completion."
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's currently active.
(if (and mini-p (or (not (active-minibuffer-window))
(not (equal buffer (window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
;; Set buffer so buffer-local `choose-completion-string-functions' works.
(set-buffer buffer)
(unless (run-hook-with-args-until-success 'choose-completion-string-functions
choice buffer mini-p base-size)
;;; $$$$$$ Removed this because it led to an error in Emacs 24, since base-size is nil there.
;;; Anyway, Icicles doesn't really need or use base-size or `choose-completion-delete-max-match'.
;;; ;; Insert the completion into the buffer where completion was requested.
;;; (if base-size
;;; (delete-region (+ base-size (if mini-p (minibuffer-prompt-end) (point-min)))
;;; (if mini-p (point-max) (point)))
;;; (choose-completion-delete-max-match choice))
;; Forget about base-size altogether. Replace the whole input always.
(delete-region (+ (or base-size 0) (if mini-p (minibuffer-prompt-end) (point-min)))
(if mini-p (point-max) (point)))
(when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
(insert choice)
(remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice,
;; unless this was a `lisp-complete-symbol' completion.
(and (not completion-no-auto-exit)
(equal buffer (window-buffer (minibuffer-window)))
(or minibuffer-completion-table
(and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
(not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
;; or not reading a file name, or chosen file is not a directory.
(if (or icicle-dir-candidate-can-exit-p
(not (eq minibuffer-completion-table 'read-file-name-internal))
(not (file-directory-p (field-string (point-max)))))
(exit-minibuffer)
(let ((mini (active-minibuffer-window)))
(select-window mini)
(when minibuffer-auto-raise (raise-frame (window-frame mini)))))))))))
((> emacs-major-version 20) ; Emacs 21
(defun icicle-choose-completion-string (choice &optional buffer base-size)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-SIZE, if non-nil, says how many characters of BUFFER's text
to keep. If it is nil, we call `choose-completion-delete-max-match'
to decide what to delete.
If BUFFER is the minibuffer, then exit the minibuffer, unless one of
the following is true:
- it is reading a file name, CHOICE is a directory, and
`icicle-dir-candidate-can-exit-p' is nil
- `completion-no-auto-exit' is non-nil
- this is just a `lisp-complete-symbol' completion."
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name buffer)))))
;; If BUFFER is a minibuffer, barf unless it's currently active.
(if (and mini-p (or (not (active-minibuffer-window))
(not (equal buffer (window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(if base-size
(delete-region (+ base-size (if mini-p (icicle-minibuffer-prompt-end) (point-min)))
(if mini-p (point-max) (point)))
(choose-completion-delete-max-match choice))
(when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
(insert choice)
(remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice,
;; unless this was a `lisp-complete-symbol' completion.
(and (not completion-no-auto-exit)
(equal buffer (window-buffer (minibuffer-window)))
(or minibuffer-completion-table
(and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
(not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
;; or not reading a file name, or chosen file is not a directory.
(if (or icicle-dir-candidate-can-exit-p
(not (eq minibuffer-completion-table 'read-file-name-internal))
(not (file-directory-p (field-string (point-max)))))
(exit-minibuffer)
(let ((mini (active-minibuffer-window)))
(select-window mini)
(when minibuffer-auto-raise (raise-frame (window-frame mini))))))))))
(t ; Emacs 20
(defun icicle-choose-completion-string (choice &optional buffer base-size)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-SIZE, if non-nil, says how many characters of BUFFER's text
to keep. If it is nil, we call `choose-completion-delete-max-match'
to decide what to delete.
If BUFFER is the minibuffer, then exit the minibuffer, unless one of
the following is true:
- it is reading a file name, CHOICE is a directory, and
`icicle-dir-candidate-can-exit-p' is nil
- `completion-no-auto-exit' is non-nil
- this is just a `lisp-complete-symbol' completion."
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name buffer)))))
;; If BUFFER is a minibuffer, barf unless it's currently active.
(when (and mini-p (or (not (active-minibuffer-window))
(not (equal buffer (window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion"))
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(if base-size
(delete-region (+ base-size (point-min)) (if mini-p (point-max) (point)))
(choose-completion-delete-max-match choice))
(when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
(insert choice)
(remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice,
;; unless this was a `lisp-complete-symbol' completion.
(and (not completion-no-auto-exit)
(equal buffer (window-buffer (minibuffer-window)))
(or minibuffer-completion-table
(and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
(not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
;; or not reading a file name, or chosen file is not a directory.
(if (or icicle-dir-candidate-can-exit-p
(not (eq minibuffer-completion-table 'read-file-name-internal))
(not (file-directory-p (buffer-string))))
(exit-minibuffer)
(select-window (active-minibuffer-window))))))))
;; REPLACE ORIGINAL `completion-setup-function' in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Don't print the help lines here. Do that in `icicle-display-completion-list' instead.
;; That's so we can fit the `*Completions*' window to the buffer, including the help lines.
;;
(unless (fboundp 'old-completion-setup-function)
(defalias 'old-completion-setup-function (symbol-function 'completion-setup-function)))
(when (< emacs-major-version 22)
(defun icicle-completion-setup-function ()
"Set up for completion. This goes in `completion-setup-hook'
so it is called after completion-list buffer text is written."
(save-excursion
(let* ((mainbuf (current-buffer))
(mbuf-contents (icicle-input-from-minibuffer))
;; $$$$$ Should we `expand-file-name' mbuf-contents first?
(dir-of-input (and minibuffer-completing-file-name
(icicle-file-name-directory mbuf-contents))))
;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
(when (and dir-of-input
(or (and (symbolp this-command) (get this-command 'icicle-completing-command))
(not icicle-comp-base-is-default-dir-p)))
(with-current-buffer mainbuf (setq default-directory dir-of-input)))
(with-current-buffer standard-output
(completion-list-mode)
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(setq completion-base-size
(cond ((and (eq minibuffer-completion-table 'read-file-name-internal)
icicle-comp-base-is-default-dir-p
(length default-directory)))
((eq minibuffer-completion-table 'read-file-name-internal)
;; For file name completion, use the number of chars before
;; the start of the file name component at point.
(with-current-buffer mainbuf
(save-excursion (skip-chars-backward "^/")
(- (point) (icicle-minibuffer-prompt-end)))))
((save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name mainbuf)))
;; Otherwise, in minibuffer, the whole input is being completed.
0))))))))
(when (or (= emacs-major-version 22) ; Emacs 22 or 23.1
(and (= emacs-major-version 23) (= emacs-minor-version 1)))
(defun icicle-completion-setup-function ()
"Set up for completion. This goes in `completion-setup-hook'
so it is called after completion-list buffer text is written."
(save-excursion
(let* ((mainbuf (current-buffer))
(mbuf-contents (minibuffer-completion-contents)) ; Get contents only up to point.
;; $$$$$ Should we `expand-file-name' mbuf-contents first? Vanilla Emacs does that.
(dir-of-input (and minibuffer-completing-file-name
(icicle-file-name-directory mbuf-contents)))
common-string-length)
;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
(when (and dir-of-input
(or (and (symbolp this-command) (get this-command 'icicle-completing-command))
(not icicle-comp-base-is-default-dir-p)))
(with-current-buffer mainbuf (setq default-directory dir-of-input)))
(with-current-buffer standard-output
(completion-list-mode)
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(setq completion-base-size
(cond ((and minibuffer-completing-file-name icicle-comp-base-is-default-dir-p
(length default-directory)))
((and (symbolp minibuffer-completion-table)
(get minibuffer-completion-table 'completion-base-size-function))
;; To compute base size, a function can use the global value of
;; `completion-common-substring' or `minibuffer-completion-contents'.
(with-current-buffer mainbuf
(funcall (get minibuffer-completion-table 'completion-base-size-function))))
(minibuffer-completing-file-name
;; For file name completion, use the number of chars before
;; the start of the file name component at point.
(with-current-buffer mainbuf
(save-excursion (skip-chars-backward completion-root-regexp)
(- (point) (minibuffer-prompt-end)))))
((and (boundp 'minibuffer-completing-symbol) minibuffer-completing-symbol) nil)
;; Otherwise, in minibuffer, the base size is 0.
((minibufferp mainbuf) 0)))
(setq common-string-length
(cond (completion-common-substring (length completion-common-substring))
(completion-base-size (- (length mbuf-contents) completion-base-size))))
;; Put faces on first uncommon characters and common parts.
(when (and (integerp common-string-length) (>= common-string-length 0))
(let ((element-start (point-min))
(maxp (point-max))
element-common-end)
(while (and (setq element-start (next-single-property-change element-start 'mouse-face))
(< (setq element-common-end (+ element-start common-string-length))
maxp))
(when (get-char-property element-start 'mouse-face)
(if (and (> common-string-length 0)
(get-char-property (1- element-common-end) 'mouse-face))
(put-text-property element-start element-common-end
'font-lock-face 'completions-common-part))
(if (get-char-property element-common-end 'mouse-face)
(put-text-property element-common-end (1+ element-common-end)
'font-lock-face 'completions-first-difference)))))))))))
(when (or (> emacs-major-version 23) ; Emacs 23.2+
(and (= emacs-major-version 23) (>= emacs-minor-version 2)))
(defun icicle-completion-setup-function ()
"Set up for completion. This goes in `completion-setup-hook'
so it is called after completion-list buffer text is written."
;; I could probably get rid of even more of the vanilla vestiges here...
(save-excursion
(let* ((mainbuf (current-buffer))
(mbuf-contents (minibuffer-completion-contents)) ; Get contents only up to point.
;; $$$$$ Should we `expand-file-name' mbuf-contents first? Vanilla Emacs does that.
(dir-of-input (and minibuffer-completing-file-name
(icicle-file-name-directory mbuf-contents))))
;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
(when (and dir-of-input
(or (and (symbolp this-command) (get this-command 'icicle-completing-command))
(not icicle-comp-base-is-default-dir-p)))
(with-current-buffer mainbuf (setq default-directory dir-of-input)))
(with-current-buffer standard-output
(completion-list-mode)
(set (make-local-variable 'completion-reference-buffer) mainbuf))))))
(defun icicle-insert-Completions-help-string ()
"Add or remove help in `*Completions*'.
This is controlled by `icicle-show-Completions-help-flag'. If that
option is nil, remove help; else, add it."
(if icicle-show-Completions-help-flag
(let ((instruction2 (or (and icicle-mode (substitute-command-keys
(concat "(\\<minibuffer-local-completion-map>"
"\\[icicle-minibuffer-help]: help) ")))
""))
instruction1)
(cond ((< emacs-major-version 22)
(setq instruction1 (if window-system ; We have a mouse.
(substitute-command-keys "Click \\<completion-list-mode-map>\
\\[mouse-choose-completion] on a completion to select it. ")
(substitute-command-keys ; No mouse.
"In this buffer, type \\<completion-list-mode-map>\
\\[choose-completion] to select the completion near point. "))))
((>= emacs-major-version 22)
(setq instruction1 (if (display-mouse-p) ; We have a mouse.
(substitute-command-keys
"Click \\<completion-list-mode-map>\
\\[mouse-choose-completion] or type \\[choose-completion] on a completion to select it. ")
(substitute-command-keys ; No mouse.
"In this buffer, type \\<completion-list-mode-map>\
\\[choose-completion] to select the completion near point. ")))))
(goto-char (point-min))
(put-text-property 0 (length instruction1) 'face 'icicle-Completions-instruction-1
instruction1)
(put-text-property 0 (length instruction2) 'face 'icicle-Completions-instruction-2
instruction2)
(insert instruction1 instruction2 "\n"))
;; Not showing help. Remove standard Emacs help string.
(goto-char (point-min))
(re-search-forward "Possible completions are:\n")
(delete-region (point-min) (point))))
(defun icicle-read-from-minibuf-nil-default (prompt &optional initial-contents keymap read hist
default-value inherit-input-method)
"Like `read-from-minibuffer', but return nil for empty input.
Args are as for `read-from-minibuffer'.
If nothing is input, then nil is returned."
(let ((input (read-from-minibuffer prompt initial-contents keymap nil hist default-value
inherit-input-method)))
(if (string= "" input) nil (if read (car (read-from-string input)) input))))
(defun icicle-completing-read-history (prompt &optional hist pred init-input def inherit-i-m)
"Lax `completing-read' against entries in history HIST.
Arguments are as for `completing-read'. HIST is a symbol that is a
history variable. It defaults to `minibuffer-history'. Completion is
lax: a match is not required."
(setq hist (or hist 'minibuffer-history))
(let ((hist-val (icicle-remove-duplicates (symbol-value hist))))
(when (and (consp hist-val) (not (stringp (car hist-val)))) ; Convert, e.g. `comand-history'.
(setq hist-val (mapcar #'prin1-to-string hist-val)))
(completing-read prompt (mapcar #'list hist-val) pred nil init-input hist def inherit-i-m)))
;; Based on the Emacs 22 C code that defined `completing-read'.
(defun icicle-lisp-vanilla-completing-read (prompt collection &optional predicate require-match
initial-input hist def inherit-input-method)
"Lisp version of vanilla Emacs `completing-read'."
(let ((pos 0) val histvar histpos position init)
(setq init initial-input
minibuffer-completion-table collection
minibuffer-completion-predicate predicate
minibuffer-completion-confirm (if (eq require-match t) nil require-match))
(setq position nil)
(when init
(when (consp init) (setq position (cdr init)
init (car init)))
(unless (stringp init)
(error "icicle-lisp-vanilla-completing-read, INIT must be a string: %S" init))
(if (not position)
(setq pos (1+ (length init))) ; Default is to put cursor at end of INITIAL-INPUT.
(unless (integerp position)
(error "icicle-lisp-vanilla-completing-read, POSITION must be an integer: %S" position))
(setq pos (1+ position)))) ; Convert zero-based to one-based.
(if (symbolp hist)
(setq histvar hist
histpos nil)
(setq histvar (car-safe hist)
histpos (cdr-safe hist)))
(unless histvar (setq histvar 'minibuffer-history))
(unless histpos (setq histpos 0))
;; $$$$$$
;; (setq val (read-from-minibuffer
;; prompt
;; (cons init pos) ; initial-contents
;; (if (not require-match) ; key map
;; (if (or (not minibuffer-completing-file-name)
;; (eq minibuffer-completing-file-name 'lambda)
;; (not (boundp 'minibuffer-local-filename-completion-map)))
;; minibuffer-local-completion-map
;; minibuffer-local-filename-completion-map)
;; (if (or (not minibuffer-completing-file-name)
;; (eq minibuffer-completing-file-name 'lambda)
;; (not (boundp 'minibuffer-local-filename-must-match-map)))
;; minibuffer-local-must-match-map
;; minibuffer-local-filename-must-match-map))
;; nil histvar def inherit-input-method))
(setq val (read-from-minibuffer
prompt
(cons init pos) ; initial-contents
(if (not require-match) ; keymap
(if (or (not minibuffer-completing-file-name)
(eq minibuffer-completing-file-name 'lambda)
(not (boundp 'minibuffer-local-filename-completion-map)))
minibuffer-local-completion-map
(if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
(make-composed-keymap
minibuffer-local-filename-completion-map
minibuffer-local-completion-map)
minibuffer-local-filename-completion-map))
(if (or (not minibuffer-completing-file-name)
(eq minibuffer-completing-file-name 'lambda)
(and (not (fboundp 'make-composed-keymap)) ; Emacs 24, starting July 2011.
(not (boundp 'minibuffer-local-filename-must-match-map))))
minibuffer-local-must-match-map
(if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
(make-composed-keymap
minibuffer-local-filename-completion-map
minibuffer-local-must-match-map)
minibuffer-local-filename-must-match-map)))
nil histvar def inherit-input-method))
;; Use `icicle-filtered-default-value', not DEF, because `read-from-minibuffer' filters it.
(when (consp icicle-filtered-default-value) ; Emacs 23 lets DEF be a list of strings - use first.
(setq icicle-filtered-default-value (car icicle-filtered-default-value)))
(when (and (stringp val) (string= val "") icicle-filtered-default-value)
(setq val icicle-filtered-default-value))
val))
;; REPLACE ORIGINAL `completing-read' (built-in function),
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Allows for completion candidates that are lists of strings.
;; Allows for reading and returning completion candidates that are strings with properties.
;; Adds completion status indicator to minibuffer and mode-line lighter.
;; Removes `*Completions*' window.
;;
;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
;; value. If we didn't need to be Emacs 20-compatible, then we could employ
;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
;;
(unless (fboundp 'old-completing-read)
(defalias 'old-completing-read (symbol-function 'completing-read)))
(defun icicle-completing-read (prompt collection &optional predicate require-match
initial-input hist-m@%=!$+&^*z def inherit-input-method)
"Read string in minibuffer, with completion and cycling of completions.
Prefix completion via \\<minibuffer-local-completion-map>\
`\\[icicle-prefix-word-complete]' (word) and `\\[icicle-prefix-complete]' (full).
Apropos (regexp) completion via `\\[icicle-apropos-complete]'.
Prefix cycling of candidate completions via `\\[icicle-previous-prefix-candidate]' and \
`\\[icicle-next-prefix-candidate]'.
Apropos cycling of candidate completions via `\\[icicle-previous-apropos-candidate]' and \
`\\[icicle-next-apropos-candidate]'.
Cycling of past minibuffer inputs via `\\[previous-history-element]' and \
`\\[next-history-element]'.
Searching through input history via `\\[previous-matching-history-element]' \
and `\\[next-matching-history-element]'.
Case is ignored if `completion-ignore-case' is non-nil.
Position of the cursor (point) and the mark during completion cycling
is determined by `icicle-point-position-in-candidate' and
`icicle-mark-position-in-candidate', respectively.
Highlighting of the matched part of completion candidates during
cycling is determined by `icicle-match-highlight-minibuffer',
`icicle-match-highlight-Completions', and
`icicle-common-match-highlight-Completions'.
Use `\\[icicle-minibuffer-help]' during completion for more information on completion and key
bindings in Icicle mode.
PROMPT is a string to prompt with. It normally ends in a colon and a
space. If PROMPT has non-nil text property `icicle-fancy-candidates'
on its first character, then completion candidates can be fancy - they
can have properties. However, if all of the candidates would be
acceptable to vanilla Emacs, then PROMPT need not use property
`icicle-fancy-candidates', even for candidates that have text
properties. Property `icicle-fancy-candidates' is needed only for
candidates that require encoding and decoding to store and retrieve
properties. See the Icicles doc, section `Programming with Fancy
Candidates'.
COLLECTION is an obarray or an alist whose elements' cars are strings.
It can also be a function that performs the completion itself.
In Emacs 22 or later, it can also be a hash table or list of strings.
In Icicle mode, the car of an alist entry can also be a list of
strings. In this case, the completion candidate is a
multi-completion. The strings are joined pairwise with
`icicle-list-join-string' to form the completion candidate seen by the
user. You can use variable `icicle-candidate-properties-alist' to
control the appearance of multi-completions in buffer `*Completions*'.
You can use variables `icicle-list-use-nth-parts' and
`icicle-list-nth-parts-join-string' to control the minibuffer behavior
of multi-completions. See the Icicles documentation for more
information.
PREDICATE limits completion to a subset of COLLECTION.
See `try-completion' and `all-completions' for more details on
completion, COLLECTION, and PREDICATE.
REQUIRE-MATCH can take any of these values:
* nil means the user can exit using any input.
* t means the user can exit only if the input is (or completes to) an
element of COLLECTION or is null.
* In Emacs 23 or later:
- `confirm' means the user can exit with any input, but if the input
is not an element of COLLECTION then confirmation is needed.
- `confirm-after-completion' is similar, except that with
non-matching input exit is allowed only just after completing.
* Anything else behaves like t, except that hitting `\\[exit-minibuffer]' does not
exit if it performs non-null completion.
Regardless of the value of REQUIRE-MATCH, if the user input is empty,
then `completing-read' returns DEF or, if DEF is nil, an empty string.
If option `icicle-require-match-flag' is non-nil, it overrides the
value of REQUIRE-MATCH.
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
with point positioned at the end. If it is (STRING . POSITION), the
initial input is STRING, but point is placed at zero-indexed position
POSITION in STRING. (This is different from `read-from-minibuffer'
and related functions, which use one-indexing for POSITION.)
INITIAL-INPUT is considered deprecated by vanilla Emacs, but not by
Icicles. If INITIAL-INPUT is nil and DEF is non-nil, the user can use
`next-history-element' to yank DEF into the minibuffer.
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). If a
cons cell, HISTVAR is the history list variable to use, and HISTPOS is
the initial position (the position in the list used by the minibuffer
history commands). For consistency, you should also specify that
element of the history as the value of INITIAL-INPUT. Positions are
counted starting from 1 at the beginning of the list. The variable
`history-length' controls the maximum length of a history list.
DEF, if non-nil, is the default value or (Emacs 23+ only) the list of
default values. Option `icicle-default-value' controls the treatment
of the default value (or the first default value, if DEF is a list):
whether it is shown in the prompt, substituted for an empty
INITIAL-INPUT, and so on.
If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits the
current input method and the setting of `enable-multibyte-characters'.
Both completion candidates and DEF are filtered using these Icicles
variables:
`icicle-must-match-regexp'
`icicle-must-not-match-regexp'
`icicle-must-pass-predicate'
Completion ignores case when `completion-ignore-case' is non-nil."
(unless (stringp icicle-initial-value) (setq icicle-initial-value "")) ; Convert nil to "".
(unless initial-input (setq initial-input icicle-initial-value))
(if (consp initial-input)
(setq icicle-initial-value (car initial-input))
(setq initial-input (format "%s" initial-input) ; Convert symbol to string
icicle-initial-value initial-input))
(setq icicle-nb-of-other-cycle-candidates 0)
;; Use DEF for INITIAL-INPUT also, if `icicle-default-value' says so.
(when (and def icicle-default-value (not (eq icicle-default-value t))
(stringp initial-input) (string= "" initial-input))
;; Filter DEF using `icicle-filter-wo-input'. Done in `read-from-minibuffer' anyway, but we
;; must also do it here, to reuse the correct default value for the init value.
(if (atom def)
(setq initial-input (or (icicle-filter-wo-input def) "")) ; Ensure that it is non-nil.
(let ((found nil)
(def1 def))
(while (and (not found) def1)
(setq found (icicle-filter-wo-input (car def1))
def1 (cdr def1)))
(setq initial-input (or found ""))))
(when (memq icicle-default-value '(insert-start preselect-start))
(setq initial-input (cons initial-input 0))))
;; Override REQUIRE-MATCH as needed.
(setq require-match (case icicle-require-match-flag
((nil) require-match)
(no-match-required nil)
(partial-match-ok t)
(full-match-required 'full-match-required))
icicle-require-match-p require-match)
(icicle-highlight-lighter)
(let* ((minibuffer-history-variable minibuffer-history-variable)
;; $$$$$$$$$$ `minibuffer-completion-table' binding needed? `setq' in `*-lisp-vanilla-*'.
(minibuffer-allow-text-properties t) ; This is nil for completion in vanilla Emacs.
(minibuffer-completion-table collection)
(icicle-fancy-cands-internal-p (or icicle-whole-candidate-as-text-prop-p
icicle-fancy-candidates-p
(get-text-property
0 'icicle-fancy-candidates prompt)))
result)
;; Transform a cons collection to what is expected for `minibuffer-completion-table'.
(when icicle-fancy-cands-internal-p
(let ((c+p (icicle-mctize-all collection predicate)))
(setq collection (car c+p) ; After banalizing for vanilla Emacs.
predicate (cadr c+p))))
;; $$$$$$$$$$$$$ (setq minibuffer-completion-table collection)
(cond ((not icicle-mode)
(setq result (icicle-lisp-vanilla-completing-read
prompt collection predicate require-match initial-input
hist-m@%=!$+&^*z def inherit-input-method)))
(t
(let ((minibuffer-prompt-properties
(and (boundp 'minibuffer-prompt-properties) ; Emacs 21+ only
(icicle-remove-property 'face minibuffer-prompt-properties)))
(minibuffer-completing-file-name
;; Can't be file-name completion unless it's a function.
(and (functionp collection) minibuffer-completing-file-name)))
(when (< emacs-major-version 21)
(setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
(setq result (catch 'icicle-read-top
(icicle-lisp-vanilla-completing-read
prompt collection predicate require-match initial-input
hist-m@%=!$+&^*z def inherit-input-method)))
(icicle-unpropertize-completion result))))
;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
;; does not disappear.
(when require-match (icicle-remove-Completions-window))
result))
(defun icicle-mctize-all (coll pred)
"Transform collection COLL and predicate PRED for vanilla completion.
COLL is an Icicles collection argument acceptable to
`icicle-completing-read' but not necessarily to vanilla
`completing-read': COLL can contain multi-completions.
PRED is a predicate.
Returns a new two-element list of the new collection and predicate:
\(MCT NEWPRED), where MCT is COLL transformed and NEWPRED is PRED
transformed. MCT is a collection suitable for vanilla
`completing-read'.
COLL is transformed to MCT by applying `icicle-mctized-full-candidate'
to each of its elements.
If PRED is non-nil, then NEWPRED is a predicate that applies PRED to
the cdr of an MCT entry. If PRED is nil, so is NEWPRED."
(when (consp coll)
;; Copy alist collection COLL, so we don't change the original alist in any way.
;; Change each entry in COLL using `icicle-mctized-full-candidate'.
(setq coll (mapcar #'icicle-mctized-full-candidate coll))
;; Convert non-nil PRED so that, for a cons entry with a string car, PRED uses the cdr
;; (which is the original entry) instead.
(and pred (lexical-let ((new-pred pred))
(setq pred (lambda (x)
(funcall new-pred (if (and (consp x) (stringp (car x))) (cdr x) x)))))))
(list coll pred))
(defun icicle-mctized-full-candidate (cand)
"Return MCT candidate that corresponds to full candidate CAND.
See the source code for details."
;; If neither `icicle-fancy-cands-internal-p' nor `icicle-whole-candidate-as-text-prop-p' is
;; non-nil, then just return CAND.
;; Otherwise:
;; If CAND is a string A, we change it to (A) and then treat that (as follows).
;; If CAND is (A . B), where A is a string, then we change it to (S A . B), where S is a copy
;; of A. This way, the cdr of each MCT candidate is the original alist candidate, (A . B).
;; If CAND is (M . B), where M is a multi-completion (X Y Z...), then we change it to
;; (M' A . B), where M' is the display string for the multi-completion M.
;; Otherwise, we make no change to CAND.
;; If `icicle-whole-candidate-as-text-prop-p' is non-nil and the MCT candidate is a cons (X A . B)
;; with a string car X, then we put the cdr, (A . B), as a text property on the car X, so
;; we can get back the original (A . B) from the car.
(if (not (or icicle-fancy-cands-internal-p icicle-whole-candidate-as-text-prop-p))
cand
(let ((new-cand
(cond ((and (consp cand) ; Multi-completion: (("aa" "bb") . cc) ->
(consp (car cand)) ; ("aa^G\nbb\n\n" ("aa" "bb") . cc)
(stringp (caar cand)))
;; $$$$$$
;; (when (string-match "\n" icicle-list-join-string)
;; (setq icicle-completions-format-internal 'horizontal)) ; Override
;; $$$$$$ (cons (concat (mapconcat #'identity (car cand) icicle-list-join-string)
;; icicle-list-end-string) ; $$$$$$
(cons (mapconcat #'identity (car cand) icicle-list-join-string) cand))
((and (consp cand) (stringp (car cand))) ; ("aa" . cc) -> ("aa" "aa" . cc)
(cons (copy-sequence (car cand)) cand))
((stringp cand) ; "aa" -> ("aa" "aa")
(list (copy-sequence cand) cand))
(t ; Anything else: (aa), aa -> no change
cand))))
;; Put original alist candidates on display candidates (strings), as a text property.
(when (and icicle-whole-candidate-as-text-prop-p (consp new-cand) (stringp (car new-cand)))
(icicle-put-whole-cand-prop new-cand))
new-cand)))
(defun icicle-put-whole-cand-prop (cand)
"Put cdr of CAND on its car, as text property `icicle-whole-candidate'.
This has no side effects.
Returns a new propertized string corresponding to (car CAND)."
(let ((text-cand (copy-sequence (car cand))))
(put-text-property 0 (length text-cand) 'icicle-whole-candidate (cdr cand) text-cand)
(setcar cand text-cand)
text-cand))
(defun icicle-mctized-display-candidate (cand)
"Return MCT candidate that corresponds to display candidate CAND."
(let ((full-cand (or (funcall icicle-get-alist-candidate-function cand) (list cand))))
(cons cand full-cand)))
(defun icicle-replace-mct-cand-in-mct (old new)
"Replace OLD candidate with NEW in `minibuffer-completion-table'.
Both OLD and NEW have been mctized. That is, they are ready for
`minibuffer-completion-table'."
(let ((newlist minibuffer-completion-table))
(catch 'icicle-replace-cand-in-mct
(while newlist
(when (equal (car newlist) old)
(setcar newlist new)
(throw 'icicle-replace-cand-in-mct nil))
(setq newlist (cdr newlist))))
minibuffer-completion-table))
(defun icicle-read-file-name (prompt &optional dir default-filename
require-match initial-input predicate)
"Read file name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
DIR should be an absolute directory name. It defaults to the value of
`default-directory'.
Default the name to DEFAULT-FILENAME if user exits the minibuffer with
the same non-empty string that was inserted by this function.
(If DEFAULT-FILENAME is omitted, the visited file name is used,
but if INITIAL-INPUT is specified, that combined with DIR is used.)
If the user exits with an empty minibuffer, this function returns
an empty string. (This can only happen if the user erased the
pre-inserted contents or if `insert-default-directory' is nil.)
Fourth arg REQUIRE-MATCH non-nil means require existing file's name.
Non-nil and non-t means also require confirmation after completion.
Fifth arg INITIAL-INPUT specifies text to start with.
If optional sixth arg PREDICATE is non-nil, possible completions and
the resulting file name must satisfy `(funcall predicate NAME)'.
This argument is only available starting with Emacs 22.
Both completion candidates and DEFAULT-FILENAME are filtered using
these Icicles variables:
`icicle-must-match-regexp'
`icicle-must-not-match-regexp'
`icicle-must-pass-predicate'
Directory names are highlighted in `*Completions*' using face
`icicle-special-candidate'.
If option `icicle-require-match-flag' is non-nil, it overrides the
value of REQUIRE-MATCH.
If option `icicle-add-proxy-candidates-flag' is non-nil, then the
following proxy file-name candidates are included. (This inclusion
can be toggled at any time from the minibuffer, using `C-M-_'.)
* `*mouse-2 file name*' - Click `mouse-2' on a file name to choose it.
* `*point file name*' - Use the file name at point (cursor).
* Single-quoted file-name variables - Use the variable's value.
Candidates `*mouse-2 file name*' and `*point file name*' are available
only if library `ffap.el' can be loaded. A file-name variable has
custom type `file' or (file :must-match t).
If this command was invoked with the mouse, use a file dialog box if
`use-dialog-box' is non-nil, and the window system or X toolkit in use
provides a file dialog box.
See also `read-file-name-completion-ignore-case' (Emacs version > 21)
and `read-file-name-function'."
(unwind-protect
(let* ((mouse-file "*mouse-2 file name*")
(icicle-special-candidate-regexp (or icicle-special-candidate-regexp ".+/$"))
(minibuffer-completing-file-name t)
(read-file-name-predicate (and (boundp 'read-file-name-predicate)
read-file-name-predicate))
(ffap-available-p (or (require 'ffap- nil t) (require 'ffap nil t)))
;; The next four prevent slowing down `ffap-guesser'.
(ffap-alist nil) (ffap-machine-p-known 'accept)
(ffap-url-regexp nil) (ffap-shell-prompt-regexp nil)
(fap
(if (and (eq major-mode 'dired-mode) (fboundp 'dired-get-file-for-visit))
(condition-case nil
(abbreviate-file-name (dired-get-file-for-visit))
(error nil))
(and ffap-available-p (ffap-guesser))))
(icicle-proxy-candidates
(append
(and icicle-add-proxy-candidates-flag
(append (and fap (list "*point file name*"))
(and ffap-available-p (list mouse-file))
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand)
(condition-case nil
(icicle-var-is-of-type-p cand
'(file (file :must-match t)))
(error nil)))
(push (concat "'" (symbol-name cand) "'") ipc))))
ipc)))
icicle-proxy-candidates))
result)
;; ;; $$$$$$ Does Emacs 23+ need explicit directory? If so, add these three lines
;; (unless dir (setq dir default-directory))
;; (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
;; (setq dir (abbreviate-file-name dir)) ; Use `~' for home directory.
(setq result (icicle-read-file-name-1 prompt dir default-filename
require-match initial-input predicate))
(when ffap-available-p
(cond ((save-match-data (string-match "*point file name\\*$" result))
(setq result fap))
((save-match-data (string-match "*mouse-2 file name\\*$" result))
(setq result
(progn (let ((e (read-event "Click `mouse-2' on file name")))
(read-event) ; Get rid of mouse up event.
(save-excursion
(mouse-set-point e)
(if (and (eq major-mode 'dired-mode)
(fboundp 'dired-get-file-for-visit)) ; In `dired+.el'.
(condition-case nil ; E.g. error: not on file line (ignore)
(abbreviate-file-name (dired-get-file-for-visit))
(error "No such file"))
(or (ffap-guesser) (error "No such file"))))))))))
(icicle-unpropertize-completion result)
(let* ((temp (member (file-name-nondirectory result) icicle-proxy-candidates))
(symb (and temp (intern (substring (car temp) 1 (1- (length (car temp))))))))
(when (and symb (boundp symb)) (setq result (symbol-value symb))))
result)
(setq icicle-proxy-candidates ())))
(defun icicle-read-file-name-1 (prompt &optional dir default-filename
require-match initial-input predicate)
"Helper function for `icicle-read-file-name'."
(setq icicle-nb-of-other-cycle-candidates 0
icicle-initial-value (or initial-input (if (stringp icicle-initial-value)
icicle-initial-value
"")))
(icicle-fix-default-directory) ; Make sure there are no backslashes in it.
(unless (string= "" icicle-initial-value) (setq initial-input icicle-initial-value))
;; Use DEFAULT-FILENAME for INITIAL-INPUT also, if `icicle-default-value' says so.
;; But if so, remove the directory part first.
;; Note that if DEFAULT-FILENAME is null, then we let INITIAL-INPUT remain null too.
(when (and default-filename icicle-default-value (not (eq icicle-default-value t))
;; We don't use the same test as for `completing-read':
;; (stringp initial-input) (string= "" initial-input))
(string= "" icicle-initial-value))
;; Filter DEFAULT-FILENAME using `icicle-filter-wo-input'. Done in `read-from-minibuffer'
;; anyway, but we must also do it here, to reuse the correct default value for the init value.
(if (atom default-filename)
(setq initial-input (icicle-filter-wo-input (file-name-nondirectory default-filename)))
(let ((found nil)
(def1 default-filename))
(while (and (not found) def1)
(setq found (icicle-filter-wo-input (file-name-nondirectory (car def1)))
def1 (cdr def1)))
(setq initial-input (or found "")))))
;; Override REQUIRE-MATCH as needed.
(setq require-match (case icicle-require-match-flag
((nil) require-match)
(no-match-required nil)
(partial-match-ok t)
(full-match-required 'full-match-required))
icicle-require-match-p require-match)
(icicle-highlight-lighter)
(let ((read-file-name-function nil)
(minibuffer-history-variable minibuffer-history-variable)
result)
(let ((minibuffer-prompt-properties
(and (boundp 'minibuffer-prompt-properties) ; Emacs 21+ only
(icicle-remove-property 'face minibuffer-prompt-properties))))
(when (< emacs-major-version 21)
(setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
(condition-case nil ; If Emacs 22+, use predicate arg.
(setq result (catch 'icicle-read-top
(funcall (or icicle-old-read-file-name-fn 'read-file-name) prompt dir
default-filename require-match initial-input predicate)))
(wrong-number-of-arguments
(setq result (catch 'icicle-read-top
(funcall (or icicle-old-read-file-name-fn 'read-file-name) prompt dir
default-filename require-match initial-input))))))
;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
;; does not disappear.
(when require-match (icicle-remove-Completions-window))
result))
(defun icicle-fix-default-directory ()
"Convert backslashes in `default-directory' to slashes."
;; This is a hack. If you do `C-x 4 f' from a standalone minibuffer
;; frame, `default-directory' on MS Windows has this form:
;; `C:\some-dir/'. There is a backslash character in the string. This
;; is not a problem for standard Emacs, but it is a problem for Icicles,
;; because we interpret backslashes using regexp syntax - they are not
;; file separators for Icicles. So, we call `substitute-in-file-name' to
;; change all backslashes in `default-directory' to slashes. This
;; shouldn't hurt, because `default-directory' is an absolute directory
;; name - it doesn't contain environment variables. For example, we
;; convert `C:\some-dir/' to `c:/some-directory/'."
(setq default-directory (icicle-abbreviate-or-expand-file-name
(substitute-in-file-name default-directory))))
(defun icicle-remove-property (prop plist)
"Remove property PROP from property-list PLIST, non-destructively.
Returns the modified copy of PLIST."
(let ((cpy plist)
(result ()))
(while cpy
(unless (eq prop (car cpy)) (setq result `(,(cadr cpy) ,(car cpy) ,@result)))
(setq cpy (cddr cpy)))
(nreverse result)))
;; REPLACE ORIGINAL `read-from-minibuffer' (built-in function),
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Respect `icicle-default-value'.
;;
;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
;; value. If we didn't need to be Emacs 20-compatible, then we could employ
;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
;;
(unless (fboundp 'old-read-from-minibuffer)
(defalias 'old-read-from-minibuffer (symbol-function 'read-from-minibuffer)))
(defun icicle-read-from-minibuffer (prompt &optional initial-contents keymap read
hist-m@%=!$+&^*z default-value inherit-input-method)
"Read a string from the minibuffer, prompting with string PROMPT.
The optional second arg INITIAL-CONTENTS is an alternative to
DEFAULT-VALUE. Vanilla Emacs considers it to be obsolete, but
Icicles does not. 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 `(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. DEFAULT-VALUE can be a string or a list of strings.
These become the minibuffer's future history, available using `M-n'.
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 is available starting with Emacs 22.
If the variable `minibuffer-allow-text-properties' is non-nil,
then the string which is returned includes whatever text properties
were present in the minibuffer. Otherwise the value has no text properties.
Option `icicle-default-value' controls how the default value,
DEFAULT-VALUE, is treated.
The remainder of this documentation string describes the
INITIAL-CONTENTS argument in more detail. 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."
(unless initial-contents (setq initial-contents ""))
;; Filter DEFAULT-VALUE using `icicle-filter-wo-input'.
(when default-value
(setq default-value
(if (atom default-value)
(icicle-filter-wo-input default-value)
(delq nil (mapcar #'icicle-filter-wo-input default-value))))) ; Emacs 23 accepts a list.
;; Save new default value for caller (e.g. `icicle-lisp-vanilla-completing-read'.
(setq icicle-filtered-default-value default-value)
;; If a list of strings, use the first one for prompt etc.
(let ((def-value (if (consp default-value) (car default-value) default-value)))
;; Maybe use DEFAULT-VALUE for INITIAL-CONTENTS also.
(when (and icicle-default-value (not (eq icicle-default-value t))
def-value (stringp initial-contents) (string= "" initial-contents))
(setq initial-contents (if (integerp def-value) ; Character
(char-to-string def-value)
def-value)))
;;; $$$$$$ (when (and def-value (eq icicle-default-value t)) ; Add DEFAULT-VALUE to PROMPT.
;;; (when (icicle-file-name-input-p) (setq def-value (file-name-nondirectory def-value)))
;;; (setq prompt (if (string-match "\\(.*\\)\\(: *\\)$" prompt)
;;; (concat (substring prompt (match-beginning 1) (match-end 1)) " (" def-value
;;; ")" (substring prompt (match-beginning 2) (match-end 2)))
;;; (concat prompt def-value))))
)
(old-read-from-minibuffer
prompt initial-contents keymap read hist-m@%=!$+&^*z default-value inherit-input-method))
;; REPLACE ORIGINAL `minibuffer-default-add-completions' defined in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Respect Icicles global filters, so you don't see, as defaults, candidates that were filtered out.
;;
(when (fboundp 'minibuffer-default-add-completions) ; Emacs 23+.
(unless (fboundp 'old-minibuffer-default-add-completions)
(defalias 'old-minibuffer-default-add-completions
(symbol-function 'minibuffer-default-add-completions)))
;; Use this as `minibuffer-default-add-function'.
(defun icicle-minibuffer-default-add-completions ()
"Like `old-minibuffer-default-add-completions', but respect global filters."
(let ((def minibuffer-default)
(all (icicle-all-completions "" minibuffer-completion-table
minibuffer-completion-predicate 'HIDE-SPACES)))
(setq all (icicle-remove-if-not (lambda (cand)
(let ((case-fold-search completion-ignore-case))
(icicle-filter-wo-input cand)))
all))
(if (listp def) (append def all) (cons def (delete def all))))))
;; REPLACE ORIGINAL `read-number' defined in `subr.el',
;; saving it for restoration when you toggle `icicle-mode'.
;; 1. Let user enter a numeric variable name, for its value. Allow completion.
;; 2. Allow for error reading input.
;; 3. Call `ding' if not a number, and don't redisplay for `sit-for'.
;;
(when (fboundp 'read-number) ; Emacs 22+
(unless (fboundp 'old-read-number)
(defalias 'old-read-number (symbol-function 'read-number)))
(defun icicle-read-number (prompt &optional default)
"Read a number in the minibuffer, prompting with PROMPT (a string).
DEFAULT is returned if the user hits `RET' without typing anything.
If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
also enter the name of a numeric variable - its value is returned.
Completion is available for this. A numeric variable is a variable
whose value or whose custom type is compatible with type `integer',
`number', or `float'."
(unwind-protect
(let ((num nil)
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand)
(condition-case nil
(icicle-var-is-of-type-p cand (if (>= emacs-major-version 22)
'(number integer float)
'(number integer)))
(error nil)))
(push (symbol-name cand) ipc))))
ipc)))
;; Emacs 23 allows DEFAULT to be a list of strings - use the first one for prompt etc.
(default1 (if (consp default) (car default) default)))
(when default
(save-match-data
(setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
(replace-match (format " (default %s)" default1) t t prompt 1)
(replace-regexp-in-string
"[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
(when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
(while (progn
(let ((str (completing-read prompt nil nil nil nil nil
(if (consp default)
(mapcar #'number-to-string default)
(and default1 (number-to-string default1)))))
temp)
(setq num (cond ((zerop (length str)) default1)
((setq temp (member str icicle-proxy-candidates))
(symbol-value (intern (car temp))))
((stringp str) (condition-case nil (read str) (error nil))))))
(unless (numberp num)
(icicle-ding) (message "Not a number. Try again.") (sit-for 0.5 nil t)
t)))
num)
(setq icicle-proxy-candidates ()))))
;; Can't replace standard `read-char-exclusive' with this, because, starting with Emacs 22, it has
;; an optional SECONDS arg that cannot be simulated using `completing-read'.
(defun icicle-read-char-exclusive (prompt &optional inherit-input-method)
"Read a character in the minibuffer, prompting with PROMPT (a string).
It is returned as a number.
Optional arg INHERIT-INPUT-METHOD is as for `completing-read'.
If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
also enter the name of a character variable - its value is returned.
Completion is available for this. A character variable is a variable
whose value is compatible with type `character'."
(unwind-protect
(let* ((char nil)
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(let ((ipc ()))
(mapatoms (lambda (cand)
(when (and (user-variable-p cand)
(condition-case nil
(icicle-var-is-of-type-p cand '(character))
(error nil)))
(push (symbol-name cand) ipc))))
ipc)))
str temp)
(when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
(setq str (completing-read prompt nil nil nil nil nil nil inherit-input-method)
char (cond ((zerop (length str)) (error "No character read"))
((setq temp (member str icicle-proxy-candidates))
(symbol-value (intern (car temp))))
((stringp str) (condition-case nil
(progn (when (> (length str) 1)
(message "First char is used: `%c'"
(elt str 0)) (sit-for 2))
(elt str 0))
(error nil)))))
char)
(setq icicle-proxy-candidates ())))
;; Not used in Icicles code, but used by other libraries.
(defun icicle-read-string-completing (prompt &optional default pred hist)
"Read a string in the minibuffer, prompting with PROMPT (a string).
If the user hits `RET' without typing anything, return DEFAULT, or \"\"
if DEFAULT is nil.
PRED is a predicate that filters the variables available for completion.
HIST is the history list to use, as for `completing-read'.
If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
also enter the name of a string variable - its value is returned.
Completion is available for this. A string variable is a variable
whose value or whose custom type is compatible with type `string'."
(unwind-protect
(let ((strg nil)
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(let ((ipc ()))
(mapatoms (lambda (cand)
(when (and (user-variable-p cand)
(condition-case nil
(icicle-var-is-of-type-p cand '(string color regexp))
(error nil)))
(push (symbol-name cand) ipc))))
ipc)))
;; Emacs 23 allows DEFAULT to be a list of strings - use the first one for prompt etc.
(default1 (if (consp default) (car default) default)))
(when default
(save-match-data
(setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
(replace-match (format " (default %s)" default1) t t prompt 1)
(replace-regexp-in-string
"[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
(when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
(let ((strg-read (completing-read prompt nil pred nil
(and (consp hist)
(nth (cdr hist) (symbol-value (car hist))))
hist default))
temp)
(setq strg (cond ((zerop (length strg-read)) (or default1 ""))
((setq temp (member strg-read icicle-proxy-candidates))
(setq temp (symbol-value (intern (car temp))))
(cond ((and (symbolp hist) (consp (symbol-value hist)))
(setcar (symbol-value hist) temp))
((and (consp hist) (symbolp (car hist))
(consp (symbol-value (car hist))))
(setcar (symbol-value (car hist)) temp)))
temp)
(t strg-read))))
strg)
(setq icicle-proxy-candidates ())))
;; Same as `help-var-is-of-type-p'.
(defun icicle-var-is-of-type-p (variable types &optional mode)
"Return non-nil if VARIABLE satisfies one of the custom types in TYPES.
TYPES is a list of `defcustom' type sexps or a list of regexp strings.
TYPES are matched, in order, against VARIABLE's type definition or
VARIABLE's current value, until one is satisfied or all are tried.
If TYPES is a list of regexps, then each is regexp-matched against
VARIABLE's custom type.
Otherwise, TYPES is a list of type sexps, each of which is a
definition acceptable for `defcustom' :type or the first symbol of
such a definition (e.g. `choice'). In this case, two kinds of type
comparison are possible:
1. VARIABLE's custom type, or its first symbol, is matched using
`equal' against each type in TYPES.
2. VARIABLE's current value is checked against each type in TYPES to
see if it satisfies one of them. In this case, VARIABLE's own type
is not used; VARIABLE might not even be typed - it could be a
variable not defined using `defcustom'.
For any of the comparisons against VARIABLE's type, either that type
can be checked directly or its supertypes (inherited types) can also
be checked.
These different type-checking possibilities depend on the value of
argument MODE, as follows, and they determine the meaning of the
returned value:
`direct': VARIABLE's type matches a member of list TYPES
`inherit': VARIABLE's type matches or is a subtype of a TYPES member
`value': VARIABLE is bound, and its value satisfies a type in TYPES
`inherit-or-value': `inherit' or `value', tested in that order
`direct-or-value': `direct' or `value', tested in that order
anything else (default): `inherit'
VARIABLE's current value cannot satisfy a regexp type: it is
impossible to know which concrete types a value must match."
(case mode
((nil inherit) (icicle-var-inherits-type-p variable types))
(inherit-or-value (or (icicle-var-inherits-type-p variable types)
(icicle-var-val-satisfies-type-p variable types)))
(value (icicle-var-val-satisfies-type-p variable types))
(direct (icicle-var-matches-type-p variable types))
(direct-or-value (or (member (get variable 'custom-type) types)
(icicle-var-val-satisfies-type-p variable types)))
(otherwise (icicle-var-inherits-type-p variable types))))
(defun icicle-var-matches-type-p (variable types)
"VARIABLE's type matches a member of TYPES."
(catch 'icicle-type-matches
(let ((var-type (get variable 'custom-type)))
(dolist (type types)
(when (if (stringp type)
(save-match-data (string-match type (format "%s" (format "%S" var-type))))
(equal var-type type))
(throw 'icicle-type-matches t))))
nil))
(defun icicle-var-inherits-type-p (variable types)
"VARIABLE's type matches or is a subtype of a member of list TYPES."
(catch 'icicle-type-inherits
(let ((var-type (get variable 'custom-type)))
(dolist (type types)
(while var-type
(when (or (and (stringp type)
(save-match-data (string-match type (format "%s" (format "%S" var-type)))))
(equal type var-type))
(throw 'icicle-type-inherits t))
(when (consp var-type) (setq var-type (car var-type)))
(when (or (and (stringp type)
(save-match-data (string-match type (format "%s" (format "%S" var-type)))))
(equal type var-type))
(throw 'icicle-type-inherits t))
(setq var-type (car (get var-type 'widget-type))))
(setq var-type (get variable 'custom-type))))
nil))
(defun icicle-var-val-satisfies-type-p (variable types)
"VARIABLE is bound, and its value satisfies a type in the list TYPES."
(and (boundp variable)
(let ((val (symbol-value variable)))
(and (widget-convert (get variable 'custom-type))
(icicle-value-satisfies-type-p val types)))))
(defun icicle-value-satisfies-type-p (value types)
"Return non-nil if VALUE satisfies a type in the list TYPES."
(catch 'icicle-type-value-satisfies
(dolist (type types)
(unless (stringp type) ; Skip, for regexp type.
(setq type (widget-convert type))
;; Satisfies if either :match or :validate.
(when (condition-case nil
(progn (when (and (widget-get type :match) (widget-apply type :match value))
(throw 'icicle-type-value-satisfies t))
(when (and (widget-get type :validate)
(progn (widget-put type :value value)
(not (widget-apply type :validate))))
(throw 'icicle-type-value-satisfies t)))
(error nil))
(throw 'icicle-type-value-satisfies t))))
nil))
(defun icicle-custom-type (variable)
"Returns the `defcustom' type of VARIABLE.
Returns nil if VARIABLE is not a user option.
Note: If the library that defines VARIABLE has not yet been loaded,
then `icicle-custom-type' loads it. Be sure you want to do that
before you call this function."
(and (custom-variable-p variable)
(or (get variable 'custom-type)
(progn (custom-load-symbol variable) (get variable 'custom-type)))))
(when (fboundp 'read-char-by-name) ; Emacs 23+
(defun icicle-read-char-maybe-completing (&optional prompt names inherit-input-method seconds)
"Read a char with PROMPT, possibly completing against character NAMES.
If the character read is `C-q' then read another character.
Otherwise, if the character read is a completing key (e.g. `TAB'),
then complete.
Elements of alist NAMES have the form of `ucs-names' elements:
(CHAR-NAME . CHAR-CODE)
NAMES defaults to the subset of `ucs-names' that corresponds to the
characters that have been read previously.
The other arguments are as in `read-char-by-name'."
(unless names (setq names (or (icicle-char-cands-from-charlist) (icicle-ucs-names))))
(let ((chr (read-char prompt inherit-input-method seconds)))
(if (eq chr ?\C-q)
(setq chr (read-char prompt inherit-input-method seconds)) ; ^Q - read next
(when (member (vector chr) (append icicle-prefix-complete-keys icicle-apropos-complete-keys))
(add-to-list 'unread-command-events chr)
(setq chr (icicle-read-char-by-name prompt names))))
chr))
(defun icicle-char-cands-from-charlist (&optional chars)
"Characters in list CHARS that are listed in `icicle-ucs-names'.
CHARS defaults to the value of `icicle-read-char-history'."
(unless chars (setq chars icicle-read-char-history))
(let ((cands ())
name.char)
(dolist (char chars)
(when (setq name.char (rassq char (icicle-ucs-names)))
(push name.char cands)))
cands)))
;; REPLACE ORIGINAL `read-char-by-name' in `mule-cmds.el' (Emacs 23+).
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; 1. Use `icicle-ucs-names', not `ucs-names'.
;; 2. Exclude character names "" and "VARIATION SELECTOR*".
;; 3. Display the character itself, after its name, in `*Completions*'.
;; 4. Added optional arg NAMES.
;; 5. Add char read to `icicle-read-char-history'.
;; 5. See doc string for the rest.
;;
(when (fboundp 'read-char-by-name) ; Emacs 23+
(unless (fboundp 'old-read-char-by-name)
(defalias 'old-read-char-by-name (symbol-function 'read-char-by-name)))
(defun icicle-read-char-by-name (prompt &optional names)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
Unicode property `name' or `old-name'. Return the char as a number.
You can use Icicles completion against the Unicode name.
A completion candidate is a Unicode name. In Icicle mode, the Unicode
character is also displayed next to the name, even though it is not
part of the completion candidate.
If you use a dedicated `*Completions*' frame, then the font used in
`*Completions*' is the same as the frame from which you invoked
completion.
If you use library `doremi-frm.el' then you can increase the font size
for `*Completions*' dynamically using `C-x -'.
As an alternative to completing the Unicode name, you can input a
number for the Unicode code point: a hexidecimal number or a number in
hash notation: #o21430 for octal, #x2318 for hex, or #10r8984 for
decimal.
Non-nil optional arg NAMES is an alist of names to use in place of the
value returned by `icicle-ucs-names'. It must have the same form as
such a return value: (CHAR-NAME . CHAR-CODE)."
(unless names (setq names (icicle-ucs-names)))
(dolist (name.char names)
;; $$$$$$ (when (and (not (string= "" (car name.char)))
;; ;; $$$$$$ Maybe make this optional?
;; (not (string-match "\\`VARIATION SELECTOR" (car name.char))))
(unless (string= "" (car name.char))
;; Display char itself after the name, in `*Completions*'.
(let* ((disp-string (concat (car name.char) "\t"
(propertize (char-to-string (cdr name.char))
'face 'icicle-extra-candidate)))
(symb (intern (car name.char))))
(put symb 'icicle-display-string disp-string)
(put-text-property 0 1 'icicle-orig-cand symb disp-string))))
(let* ((new-prompt (copy-sequence prompt))
(IGNORE-1 (put-text-property 0 1 'icicle-fancy-candidates t new-prompt))
(completion-ignore-case t)
(input (completing-read
new-prompt
`(lambda (string pred action)
(if (eq action 'metadata)
'(metadata (category . unicode-name))
(complete-with-action action ',names string pred)))))
chr)
(let ((orig-cand (get-text-property 0 'icicle-orig-cand input)))
(when orig-cand (setq input (symbol-name orig-cand))))
(setq chr (cond ((string-match-p "^[0-9a-fA-F]+$" input) (string-to-number input 16))
((string-match-p "^#" input) (read input))
(t (cdr (assoc-string input names t)))))
(add-to-list 'icicle-read-char-history chr)
chr))
;; This would not be needed if there were not Emacs bug #9653.
(defun icicle-ucs-names ()
"Same as `ucs-names', except remove entries with an empty name: \"\"."
(setq ucs-names (assq-delete-all "" (ucs-names))))) ; Free var here: `ucs-names'.
;; REPLACE ORIGINAL `read-string' (built-in function),
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Respect `icicle-default-value' (via use of `read-from-minibuffer').
;;
;; We use HIST-m@%=!$+&^*z instead of HISTORY, to avoid name capture by `minibuffer-history-variable's
;; value. If we didn't need to be Emacs 20-compatible, then we could employ
;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
;;
(unless (fboundp 'old-read-string)
(defalias 'old-read-string (symbol-function 'read-string)))
(defun icicle-read-string (prompt &optional initial-input hist-m@%=!$+&^*z
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.
Vanilla Emacs considers it to be obsolete, but Icicles does not. It
behaves like argument INITIAL-CONTENTS in `read-from-minibuffer'.
See the documentation string of `read-from-minibuffer' for details.
The third arg HISTORY, if non-nil, specifies a history list
and optionally the initial position in the list.
See `read-from-minibuffer' for details of HISTORY argument.
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
the empty string.
Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
the current input method and the setting of enable-multibyte-characters."
(let ((value (read-from-minibuffer prompt initial-input nil nil hist-m@%=!$+&^*z
default-value inherit-input-method)))
(when (and default-value (equal value ""))
(setq value (if (consp default-value) (car default-value) default-value)))
value))
;; REPLACE ORIGINAL `read-face-name' in `faces.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Show face names in `*Completions*' with the faces they name.
;;
(unless (fboundp 'old-read-face-name)
(defalias 'old-read-face-name (symbol-function 'read-face-name)))
(cond ((< emacs-major-version 21)
(defun icicle-read-face-name (prompt) ; Emacs 20
"Read a face name with completion and return its face symbol.
PROMPT is the prompt.
If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
also enter the name of a face-name variable - its value is returned.
A face-name variable is a variable with custom-type `face'.
If library `eyedropper.el' is used, then you can also choose proxy
candidate `*point face name*' to use the face at point."
(require 'eyedropper nil t)
(let ((icicle-list-nth-parts-join-string ": ")
(icicle-list-join-string ": ")
;; $$$$$$ (icicle-list-end-string "")
(icicle-list-use-nth-parts '(1))
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
(push `,(concat "'" (symbol-name cand) "'") ipc))))
ipc))))
face)
(setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
(put-text-property 0 1 'icicle-fancy-candidates t prompt)
(while (= (length face) 0)
(setq face (icicle-transform-multi-completion
(completing-read prompt (mapcar #'icicle-make-face-candidate (face-list))
nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
(if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)))))
(let ((proxy (car (member face icicle-proxy-candidates))))
(cond ((save-match-data (string-match "*point face name\\*$" face))
(eyedrop-face-at-point))
(proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
(t (intern face)))))))
((= emacs-major-version 21) ; Emacs 21
(defun icicle-read-face-name (prompt)
"Read a face name with completion and return its face symbol.
PROMPT is the prompt.
If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
also enter the name of a face-name variable - its value is returned.
A face-name variable is a variable with custom-type `face'.
If library `eyedropper.el' is used, then you can also choose proxy
candidate `*point face name*' to use the face at point."
(require 'eyedropper nil t)
(let ((icicle-list-nth-parts-join-string ": ")
(icicle-list-join-string ": ")
;; $$$$$$ (icicle-list-end-string "")
(icicle-list-use-nth-parts '(1))
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
(push `,(concat "'" (symbol-name cand) "'") ipc))))
ipc))))
(face-list (face-list))
(def (thing-at-point 'symbol))
face)
(cond ((assoc def face-list) (setq prompt (concat prompt " (default " def "): ")))
(t (setq def nil
prompt (concat prompt ": "))))
(setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
(put-text-property 0 1 'icicle-fancy-candidates t prompt)
(while (equal "" (setq face (icicle-transform-multi-completion
(completing-read
prompt (mapcar #'icicle-make-face-candidate face-list) nil
(not (stringp icicle-WYSIWYG-Completions-flag)) nil
(if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)
def)))))
(let ((proxy (car (member face icicle-proxy-candidates))))
(cond ((save-match-data (string-match "*point face name\\*$" face))
(eyedrop-face-at-point))
(proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
(t (intern face)))))))
((< emacs-major-version 24) ; Emacs 22-23
(defun icicle-read-face-name (prompt &optional string-describing-default multiple)
"Read a face name with completion and return its face symbol
By default, use the face(s) on the character after point. If that
character has the property `read-face-name', that overrides the `face'
property.
PROMPT should be a string that describes what the caller will do with the face;
it should not end in a space.
STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
the user just types RET; you can omit it.
If MULTIPLE is non-nil, return a list of faces (possibly only one).
Otherwise, return a single face.
If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
also enter the name of a face-name variable - its value is returned.
A face-name variable is a variable with custom-type `face'.
If library `palette.el' or `eyedropper.el' is used, then you can also
choose proxy candidate `*point face name*' to use the face at point."
(or (require 'palette nil t) (require 'eyedropper nil t))
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)))
(aliasfaces ())
(nonaliasfaces ())
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
(push `,(concat "'" (symbol-name cand) "'") ipc))))
ipc)))
faces)
;; Undo Emacs 22 brain-dead treatment of PROMPT arg.
(when (save-match-data (string-match ": $" prompt))
(setq prompt (substring prompt 0 -2)))
;; Try to get a face name from the buffer.
(when (memq (intern-soft (thing-at-point 'symbol)) (face-list))
(setq faces (list (intern-soft (thing-at-point 'symbol)))))
;; Add the named faces that the `face' property uses.
(if (and (consp faceprop)
;; Don't treat an attribute spec as a list of faces.
(not (keywordp (car faceprop)))
(not (memq (car faceprop) '(foreground-color background-color))))
(dolist (f faceprop) (when (symbolp f) (push f faces)))
(when (and faceprop (symbolp faceprop)) (push faceprop faces)))
(delete-dups faces)
(cond (multiple
;; We leave this branch as it is. Icicles does nothing special with
;; `completing-read-multiple'.
(require 'crm)
(mapatoms (lambda (s) (when (custom-facep s) ; Build up the completion tables.
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
(let* ((input (completing-read-multiple ; Read the input.
(if (or faces string-describing-default)
(format "%s (default %s): "
prompt (if faces
(mapconcat 'symbol-name faces ",")
string-describing-default))
(format "%s: " prompt))
;; This lambda expression is the expansion of Emacs 22 macro
;; (complete-in-turn nonaliasfaces aliasfaces). We expand it so
;; this can be compiled also in Emacs < 22 to work for Emacs 22.
(lambda (string predicate mode)
(cond ((eq mode t)
(or (all-completions string nonaliasfaces predicate)
(all-completions string aliasfaces predicate)))
((eq mode nil)
(or (try-completion string nonaliasfaces predicate)
(try-completion string aliasfaces predicate)))
(t
(or (test-completion string nonaliasfaces predicate)
(test-completion string aliasfaces predicate)))))
nil t nil (if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)
(and faces (mapconcat 'symbol-name faces ","))))
(output (cond ((or (equal input "") (equal input '(""))) ; Canonicalize.
faces)
((stringp input)
(mapcar 'intern (split-string input ", *" t)))
((listp input)
(mapcar 'intern input))
(input))))
output)) ; Return the list of faces
(t
(when (consp faces) (setq faces (list (car faces))))
(let ((icicle-list-nth-parts-join-string ": ")
(icicle-list-join-string ": ")
;; $$$$$$ (icicle-list-end-string "")
(icicle-list-use-nth-parts '(1))
(face-list (face-list))
(def (if faces
(mapconcat 'symbol-name faces ",")
string-describing-default))
face)
(setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
(put-text-property 0 1 'icicle-fancy-candidates t prompt)
(while (equal "" (setq face (icicle-transform-multi-completion
(completing-read
(if def
(format "%s (default %s): " prompt def)
(format "%s: " prompt))
(mapcar #'icicle-make-face-candidate face-list)
nil (not (stringp icicle-WYSIWYG-Completions-flag))
nil (if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)
def)))))
(let ((proxy (car (member face icicle-proxy-candidates))))
(if proxy
(symbol-value (intern (substring proxy 1 (1- (length proxy)))))
(intern face)))))))))
(t
(defun icicle-read-face-name (prompt &optional default multiple)
"Read a face name with completion and return its face symbol.
By default, use the face(s) on the character after point. If that
character has the property `read-face-name', that overrides the `face'
property.
PROMPT should be a string that describes what the caller will do with the face;
it should not end in a space.
Optional arg DEFAULT provides the value to display in the minibuffer
prompt. If not a string then it is also what is returned if the user
just hits `RET' (empty input). If a string then `nil' is returned.
If MULTIPLE is non-nil, return a list of faces (possibly only one).
Otherwise, return a single face.
If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
also enter the name of a face-name variable - its value is returned.
A face-name variable is a variable with custom-type `face'.
If library `palette.el' or `eyedropper.el' is used, then you can also
choose proxy candidate `*point face name*' to use the face at point."
(or (require 'palette nil t) (require 'eyedropper nil t))
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)))
(aliasfaces ())
(nonaliasfaces ())
(icicle-proxy-candidates
(and icicle-add-proxy-candidates-flag
(let ((ipc ()))
(mapatoms
(lambda (cand)
(when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
(push `,(concat "'" (symbol-name cand) "'") ipc))))
ipc)))
faces)
;; Undo vanilla Emacs brain-dead treatment of PROMPT arg.
(when (save-match-data (string-match ": $" prompt))
(setq prompt (substring prompt 0 -2)))
;; Try to get a face name from the buffer.
(when (memq (intern-soft (thing-at-point 'symbol)) (face-list))
(setq faces (list (intern-soft (thing-at-point 'symbol)))))
;; Add the named faces that the `face' property uses.
(if (and (consp faceprop)
;; Don't treat an attribute spec as a list of faces.
(not (keywordp (car faceprop)))
(not (memq (car faceprop) '(foreground-color background-color))))
(dolist (f faceprop) (when (symbolp f) (push f faces)))
(when (and faceprop (symbolp faceprop)) (push faceprop faces)))
(delete-dups faces)
(cond (multiple
;; We leave this branch as it is. Icicles does nothing special with
;; `completing-read-multiple'.
(require 'crm)
(mapatoms (lambda (s) (when (custom-facep s) ; Build up the completion tables.
(if (get s 'face-alias)
(push (symbol-name s) aliasfaces)
(push (symbol-name s) nonaliasfaces)))))
(let* ((input (completing-read-multiple ; Read the input.
(if (or faces default)
(format "%s (default `%s'): "
prompt (if faces
(mapconcat 'symbol-name faces ",")
default))
(format "%s: " prompt))
(completion-table-in-turn nonaliasfaces aliasfaces)
nil t nil (if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)
(and faces (mapconcat 'symbol-name faces ","))))
(output (cond ((or (equal input "") (equal input '(""))) ; Canonicalize.
(or faces (and (not (stringp default)) default)))
((stringp input)
(mapcar 'intern (split-string input ", *" t)))
((listp input)
(mapcar 'intern input))
(input))))
output)) ; Return the list of faces
(t
(when (consp faces) (setq faces (list (car faces))))
(let ((icicle-list-nth-parts-join-string ": ")
(icicle-list-join-string ": ")
;; $$$$$$ (icicle-list-end-string "")
(icicle-list-use-nth-parts '(1))
(face-list (face-list))
(def (if faces
(mapconcat 'symbol-name faces ",")
(and (not (stringp default)) default)))
face)
(setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
(put-text-property 0 1 'icicle-fancy-candidates t prompt)
(while (equal "" (setq face (icicle-transform-multi-completion
(completing-read
(if def
(format "%s (default `%s'): " prompt def)
(format "%s: " prompt))
(mapcar #'icicle-make-face-candidate face-list)
nil (not (stringp icicle-WYSIWYG-Completions-flag))
nil (if (boundp 'face-name-history)
'face-name-history
'icicle-face-name-history)
def)))))
(let ((proxy (car (member face icicle-proxy-candidates))))
(if proxy
(symbol-value (intern (substring proxy 1 (1- (length proxy)))))
(intern face))))))
))))
(defun icicle-make-face-candidate (face)
"Return a completion candidate for FACE.
The value of option `icicle-WYSIWYG-Completions-flag' determines the
kind of candidate to use.
If nil, then the face name is used (a string).
If a string, then a multi-completion candidate is used, with the face
name followed by a sample swatch using FACE on the string's text.
If t, then the candidate is the face name itself, propertized with
FACE."
(if (stringp icicle-WYSIWYG-Completions-flag)
(let ((swatch (copy-sequence icicle-WYSIWYG-Completions-flag)))
(put-text-property 0 (length icicle-WYSIWYG-Completions-flag) 'face face swatch)
(list (list (symbol-name face) swatch)))
(let ((face-name (copy-sequence (symbol-name face))))
(when icicle-WYSIWYG-Completions-flag
(put-text-property 0 (length face-name) 'face face face-name))
(list face-name))))
;; REPLACE ORIGINAL `face-valid-attribute-values' in `faces.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Show color names in `*Completions*' with the (background) colors they name.
;; This is really so that commands such as `modify-face' take advantage of colored candidates.
;; We don't bother to try the same thing for Emacs 20, but the fix (directly to `modify-face') is
;; similar and trivial.
;;
(when (fboundp 'face-valid-attribute-values) ; Emacs 21+.
(unless (fboundp 'old-face-valid-attribute-values)
(defalias 'old-face-valid-attribute-values (symbol-function 'face-valid-attribute-values)))
(if (fboundp 'window-system) ; Emacs 23+
;; Emacs 23+ `font-family-list' is strings, not conses of strings like older `x-font-family-list'.
(defun icicle-face-valid-attribute-values (attribute &optional frame)
"Return valid values for face attribute ATTRIBUTE.
The optional argument FRAME is used to determine available fonts
and colors. If it is nil or not specified, the selected frame is
used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
an integer value."
(let ((valid
(case attribute
(:family (if (window-system frame)
(mapcar (lambda (x) (cons x x)) ; Just strings, so don't take car.
(font-family-list))
;; Only one font on TTYs.
(list (cons "default" "default"))))
(:foundry
(list nil))
(:width
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-width-table))
(:weight
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-weight-table))
(:slant
(mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
font-slant-table))
(:inverse-video
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
((:underline :overline :strike-through :box)
(if (window-system frame)
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
(mapcar #'(lambda (c) (cons c c))
(mapcar #'icicle-color-name-w-bg (defined-colors frame))))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((:foreground :background)
(mapcar #'(lambda (c) (cons c c))
(mapcar #'icicle-color-name-w-bg (defined-colors frame))))
((:height) 'integerp)
(:stipple (and (memq (window-system frame) '(x ns)) ; No stipple on w32
(mapcar #'list (apply #'nconc (mapcar (lambda (dir)
(and (file-readable-p dir)
(file-directory-p dir)
(directory-files dir)))
x-bitmap-file-path)))))
(:inherit (cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list))))
(t
(error "Internal error")))))
(if (and (listp valid) (not (memq attribute '(:inherit))))
(nconc (list (cons "unspecified" 'unspecified)) valid)
valid)))
(defun icicle-face-valid-attribute-values (attribute &optional frame) ; Emacs 21-22.
"Return valid values for face attribute ATTRIBUTE.
The optional argument FRAME is used to determine available fonts
and colors. If it is nil or not specified, the selected frame is
used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
an integer value."
(let ((valid
(case attribute
(:family (if window-system
(mapcar #'(lambda (x) (cons (car x) (car x)))
(if (fboundp 'font-family-list)
(font-family-list)
(x-font-family-list)))
;; Only one font on TTYs.
(list (cons "default" "default"))))
((:width :weight :slant :inverse-video)
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute)))
((:underline :overline :strike-through :box)
(if window-system
(nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))
(mapcar #'(lambda (c) (cons c c))
(mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
(mapcar #'(lambda (x) (cons (symbol-name x) x))
(internal-lisp-face-attribute-values attribute))))
((:foreground :background)
(mapcar #'(lambda (c) (cons c c))
(mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
((:height) 'integerp)
(:stipple (and (memq window-system '(x w32 mac))
(mapcar #'list (apply #'nconc (mapcar (lambda (dir)
(and (file-readable-p dir)
(file-directory-p dir)
(directory-files dir)))
x-bitmap-file-path)))))
(:inherit (cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list))))
(t
(error "Internal error")))))
(if (and (listp valid) (not (memq attribute '(:inherit))))
(nconc (list (cons "unspecified" 'unspecified)) valid)
valid))))
(defun icicle-color-name-w-bg (color-name)
"Return copy of string COLOR-NAME with its background of that color.
If `hexrgb.el' is not loaded, then just return COLOR-NAME."
(if (featurep 'hexrgb)
(let ((propertized-name (copy-sequence color-name)))
(put-text-property 0 (length propertized-name)
'face (cons 'background-color (hexrgb-color-name-to-hex color-name))
propertized-name)
propertized-name)
color-name)))
;; REPLACE ORIGINAL `completing-read-multiple' stuff in `crm.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Essentially, we just inhibit Icicles features for Icicle mode.
;;
(eval-after-load "crm"
'(progn
(when (fboundp 'crm-init-keymaps) (crm-init-keymaps)) ; Emacs 22, but not 23.
;; Save vanilla CRM stuff as `old-' stuff.
(unless (fboundp 'old-completing-read-multiple)
(defalias 'old-completing-read-multiple (symbol-function 'completing-read-multiple)))
(defvar old-crm-local-completion-map crm-local-completion-map "Original CRM completion map.")
(defvar old-crm-local-must-match-map crm-local-must-match-map "Original CRM must-match map.")
;; Define CRM stuff to use in Icicle mode. Basically, just inhibit Icicles features.
(defun icicle-completing-read-multiple (prompt collection &optional predicate require-match
initial-input hist def inherit-input-method)
"Read multiple strings in the minibuffer, with completion.
By using this functionality, a user may specify multiple strings at a
single prompt, optionally using completion.
Multiple strings are specified by separating each of the strings with
a prespecified separator character. For example, if the separator
character is a comma, the strings 'alice', 'bob', and 'eve' would be
specified as 'alice,bob,eve'.
The default value for the separator character is the value of
`crm-default-separator' (comma). The separator character may be
changed by modifying the value of `crm-separator'.
Contiguous strings of non-separator-characters are referred to as
'elements'. In the aforementioned example, the elements are: 'alice',
'bob', and 'eve'.
Completion is available on a per-element basis. For example, if the
contents of the minibuffer are 'alice,bob,eve' and point is between
'l' and 'i', pressing TAB operates on the element 'alice'.
The return value of this function is a list of the read strings.
See the documentation for `completing-read' for details on the
arguments: PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH,
INITIAL-INPUT, HIST, DEF, and INHERIT-INPUT-METHOD."
(let ((icicle-highlight-input-completion-failure nil))
(old-completing-read-multiple prompt collection predicate require-match
initial-input hist def inherit-input-method)))
;; Helper function - workaround because of a lack of multiple inheritance for keymaps.
(defun icicle-define-crm-completion-map (map)
"Make basic bindings for keymap MAP, a crm completion map."
(set-keymap-parent map minibuffer-local-completion-map)
(define-key map [remap minibuffer-complete] ; Emacs 22, 23.
(if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete))
(when (fboundp 'crm-complete-word)
(define-key map [remap minibuffer-complete-word] #'crm-complete-word))
(when (and (boundp 'icicle-word-completion-keys) (fboundp 'crm-complete-word))
(dolist (key icicle-word-completion-keys) (define-key map key #'crm-complete-word)))
(define-key map [remap minibuffer-completion-help] ; Emacs 22, 23.
(if (fboundp 'crm-completion-help) #'crm-completion-help #'crm-minibuffer-completion-help))
(define-key map "?" #'crm-completion-help) ; Put back `?' as help (self-insert for Icicles).
(when (boundp 'icicle-prefix-complete-keys) ; Don't use Icicles completion.
(dolist (key icicle-prefix-complete-keys)
(define-key map key ; Emacs 22, 23.
(if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete)))))
(defvar icicle-crm-local-completion-map
(let ((map (make-sparse-keymap)))
(icicle-define-crm-completion-map map)
map)
"Local keymap for minibuffer multiple input with completion.
Analog of `minibuffer-local-completion-map'.")
(defvar icicle-crm-local-must-match-map
(let ((map (make-sparse-keymap)))
(icicle-define-crm-completion-map map)
(define-key map [remap minibuffer-complete-and-exit]
(if (fboundp 'crm-complete-and-exit)
#'crm-complete-and-exit
#'crm-minibuffer-complete-and-exit))
map)
"Local keymap for minibuffer multiple input with exact match completion.
Analog of `minibuffer-local-must-match-map' for crm.")
;; Now, toggle Icicle mode, to take into account loading `crm.el' and redefining its stuff.
(eval-after-load "icicles-mode" '(icicle-toggle-icicle-mode-twice))))
;; REPLACE ORIGINAL `read-shell-command' defined in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;; Uses Icicles completion.
;;
(defun icicle-read-shell-command (prompt &optional initial-contents hist default-value
inherit-input-method)
"Read a shell command.
Use file-name completion, unless INITIAL-CONTENTS is non-nil.
For completion, pass args to `icicle-read-shell-command-completing'."
(if initial-contents
(if (fboundp 'old-read-shell-command) ; Emacs 23+.
(old-read-shell-command prompt initial-contents hist default-value inherit-input-method)
(error "icicle-read-shell-command: YOU SHOULD NOT SEE THIS; use`M-x icicle-send-bug-report'"))
(if (fboundp 'minibuffer-with-setup-hook)
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-shell-commands))
(icicle-read-shell-command-completing prompt initial-contents (or hist 'shell-command-history)
default-value inherit-input-method))
(icicle-read-shell-command-completing prompt initial-contents (or hist 'shell-command-history)
default-value inherit-input-method))))
;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;; Uses Icicles completion.
;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
;;
(unless (fboundp 'read-shell-command) ; Emacs 23
(defun icicle-dired-smart-shell-command (command &optional output-buffer error-buffer)
"Like `icicle-shell-command', but in the current Virtual Dired directory.
Uses Icicles completion - see `icicle-read-shell-command-completing'."
(interactive
(list (icicle-read-shell-command "Shell command: " nil nil
(cond (buffer-file-name (file-relative-name buffer-file-name))
((eq major-mode 'dired-mode) (dired-get-filename t t))))
current-prefix-arg
shell-command-default-error-buffer))
(let ((default-directory (if (fboundp 'dired-default-directory) ; Emacs 21+.
(dired-default-directory)
(default-directory))))
(icicle-shell-command command output-buffer error-buffer))))
;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;; Uses Icicles completion.
;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
;;
(unless (fboundp 'read-shell-command) ; Emacs 23.
(unless (fboundp 'old-shell-command)
(defalias 'old-shell-command (symbol-function 'shell-command)))
(defun icicle-shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
Uses Icicles completion - see `icicle-read-shell-command-completing'.
With prefix argument, insert the COMMAND's output at point.
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
Otherwise, COMMAND is executed synchronously. The output appears in
the buffer `*Shell Command Output*'. If the output is short enough to
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown
there, but it is nonetheless available in buffer `*Shell Command
Output*' even though that buffer is not automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument] \
before this command.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
The optional second argument OUTPUT-BUFFER, if non-nil,
says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in current buffer. (This cannot be done asynchronously.)
In either case, the output is inserted after point (leaving mark after it).
If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
the output can be displayed in the echo area or in its buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
Otherwise,the buffer containing the output is displayed.
If there is output and an error, and you did not specify \"insert it
in the current buffer\", a message about the error goes at the end
of the output.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive
(list (icicle-read-shell-command "Shell command: " nil nil
(and buffer-file-name (file-relative-name buffer-file-name)))
current-prefix-arg
shell-command-default-error-buffer))
(old-shell-command command output-buffer error-buffer)))
;; REPLACE ORIGINAL `shell-command-on-region' defined in `simple.el',
;; saving it for restoration when you toggle `icicle-mode'.
;; Uses Icicles completion.
;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
;;
(unless (fboundp 'read-shell-command) ; Emacs 23.
(unless (fboundp 'old-shell-command-on-region)
(defalias 'old-shell-command-on-region (symbol-function 'shell-command-on-region)))
(defun icicle-shell-command-on-region (start end command &optional output-buffer replace
error-buffer display-error-buffer)
"Execute string COMMAND in inferior shell with region as input.
Uses Icicles completion - see `icicle-read-shell-command-completing'.
Normally, display any output in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it. Return the exit code of
COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
before this command. By default, the input (from the current buffer)
is encoded in the same coding system that will be used to save the file,
`buffer-file-coding-system'. If the output is going to replace the region,
then it is decoded from that same coding system.
The noninteractive arguments are START, END, COMMAND,
OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
Noninteractive callers can specify coding systems by binding
`coding-system-for-read' and `coding-system-for-write'.
If the command generates output, the output may be displayed
in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there. Otherwise
it is displayed in the buffer `*Shell Command Output*'. The output
is available in that buffer in both cases.
If there is output and an error, a message about the error
appears at the end of the output.
If there is no output, or if output is inserted in the current buffer,
then `*Shell Command Output*' is deleted.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
If OUTPUT-BUFFER is not a buffer and not nil,
insert output in the current buffer.
In either case, the output is inserted after point (leaving mark after it).
If REPLACE, the optional fifth argument, is non-nil, that means insert
the output in place of text from START to END, putting point and mark
around it.
If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
or buffer name to which to direct the command's standard error output.
If it is nil, error output is mingled with regular output.
If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
were any errors. (This is always t, interactively.) This argument is
not available before Emacs 22.
In an interactive call, the variable `shell-command-default-error-buffer'
specifies the value of ERROR-BUFFER."
(interactive (let (string)
(unless (mark) (error "The mark is not set now, so there is no region"))
;; Do this before calling region-beginning and region-end, in case subprocess
;; output relocates them while we are in the minibuffer.
(setq string (icicle-read-shell-command "Shell command on region: "))
;; call-interactively recognizes region-beginning and region-end specially,
;; leaving them in the history.
(list (region-beginning) (region-end) string current-prefix-arg current-prefix-arg
shell-command-default-error-buffer (= emacs-major-version 22))))
(if (= emacs-major-version 22) ; `icicle-shell-command-on-region' not defined for Emacs 23+.
(old-shell-command-on-region start end command output-buffer replace error-buffer
display-error-buffer)
(old-shell-command-on-region start end command output-buffer replace error-buffer))))
(defvar icicle-files () "A files list")
;; REPLACE ORIGINAL `dired-read-shell-command' defined in `dired-aux.el'
;; and redefined in `dired-x.el', saving it for restoration when you toggle `icicle-mode'.
;;
;; Uses Icicles completion.
;; Uses `icicle-minibuffer-default-add-dired-shell-commands', not
;; `minibuffer-default-add-dired-shell-commands'.
;; Binds `icicle-files' for use as free var elsewhere.
;;
(defun icicle-dired-read-shell-command (prompt arg files)
"Read a shell command for FILES using file-name completion.
Uses Icicles completion - see `icicle-read-shell-command-completing'.
ARG is passed to `dired-mark-prompt' as its first arg, for the prompt.
FILES are the files for which the shell command should be appropriate."
(let ((icicle-files files))
(if (fboundp 'minibuffer-with-setup-hook)
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'icicle-minibuffer-default-add-dired-shell-commands))
(dired-mark-pop-up nil 'shell files 'icicle-dired-guess-shell-command
(format prompt (dired-mark-prompt arg files)) files))
(dired-mark-pop-up nil 'shell files 'icicle-dired-guess-shell-command
(format prompt (dired-mark-prompt arg files)) files))))
(defun icicle-dired-guess-shell-command (prompt files)
"Read a shell command for FILES using file-name completion.
Call `icicle-read-shell-command-completing', passing PROMPT and FILES."
(icicle-read-shell-command-completing prompt nil nil nil nil files))
;; Similar to `minibuffer-default-add-dired-shell-commands', but if Dired-X is available
;; we include also the commands from `dired-guess-default'.
;;
;; Free var here: `icicle-files' is bound in `icicle-dired-read-shell-command'.
;;;###autoload
(defun icicle-minibuffer-default-add-dired-shell-commands ()
"Return a list of all commands associated with current dired files.
The commands are from `minibuffer-default-add-dired-shell-commands',
and if `dired-x.el' is used, `dired-guess-default'."
(interactive)
(let ((dired-guess-cmds (and (boundp 'icicle-files) (fboundp 'dired-guess-default)
(dired-guess-default icicle-files)))
(mailcap-cmds (and (boundp 'icicle-files) (require 'mailcap nil t)
(mailcap-file-default-commands icicle-files))))
(when (stringp dired-guess-cmds) (setq dired-guess-cmds (list dired-guess-cmds)))
(if (listp minibuffer-default)
(append minibuffer-default dired-guess-cmds mailcap-cmds)
(cons minibuffer-default (append dired-guess-cmds mailcap-cmds)))))
(defun icicle-read-shell-command-completing (prompt &optional initial-contents hist default-value
inherit-input-method files)
"Read a shell command using file-name completion.
FILES name some files for which the command might be appropriate.
The other arguments are the same as those for `read-from-minibuffer',
except that READ and KEYMAP are missing, and HIST defaults to
`shell-command-history'.
Completion is lax, so you can use any shell command you want, not
just a completion candidate, and you can edit the completed input to
add options and arguments etc.
In addition to file-name candidates, the following are combined to
produce extra completion candidates (which are indicated using face
`icicle-extra-candidates' in buffer `*Completions*'):
* If you use Dired X, then the rules defined by user option
`dired-guess-shell-alist-user' and variable
`dired-guess-shell-alist-default' provide candidates appropriate for
the marked files in Dired.
* Starting with Emacs 23, MIME-type associations provide candidates
appropriate for the marked files.
* If option `icicle-guess-commands-in-path' is non-nil, then
executable files (or all files, if `shell-completion-execonly' is
nil) in your search path provide candidates.
In addition, if `icicle-extra-candidates' is non-nil, its elements are
also included as extra candidates.
Help is available for individual candidates, using `C-M-RET',
`C-M-mouse-2', and so on. For an extra candidate (that is, for a
shell command guessed to be appropriate), help is provided by the
`apropos' shell command (if available). For a file name, help shows
the file's properties."
(let* ((dired-guess-files (and files (fboundp 'dired-guess-default)
(dired-guess-default files)))
(icicle-sort-comparer 'icicle-extra-candidates-first-p)
(completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
(insert-default-directory nil)
(icicle-extra-candidates-dir-insert-p nil)
(icicle-point-position-in-candidate 'input-end)
(icicle-candidate-help-fn (lambda (cand)
(if (member cand icicle-extra-candidates)
(shell-command
(concat "apropos " (shell-quote-argument
cand))
"*Help*")
(icicle-describe-file cand))))
(icicle-extra-candidates icicle-extra-candidates)
(icicle-must-match-regexp icicle-file-match-regexp)
(icicle-must-not-match-regexp icicle-file-no-match-regexp)
(icicle-must-pass-after-match-predicate icicle-file-predicate)
(icicle-transform-function 'icicle-remove-dups-if-extras)
;; (icicle-sort-comparer (or icicle-file-sort icicle-sort-comparer))
(icicle-require-match-flag icicle-file-require-match-flag)
(icicle-default-value ; Let user get default via `M-n', but don't insert it.
(and (memq icicle-default-value '(t nil)) icicle-default-value)))
(when (and dired-guess-files (atom dired-guess-files))
(setq dired-guess-files (list dired-guess-files)))
;; Add dired-guess guesses and mailcap guesses to `icicle-extra-candidates'.
(setq icicle-extra-candidates (append dired-guess-files
(and files (require 'mailcap nil t) ; Emacs 23.
(fboundp 'mailcap-file-default-commands)
(mailcap-file-default-commands files))
icicle-extra-candidates))
(when icicle-guess-commands-in-path ; Add commands available from user's search path.
(setq icicle-extra-candidates (append icicle-extra-candidates
(or icicle-shell-command-candidates-cache
(icicle-recompute-shell-command-candidates)))))
(when icicle-extra-candidates
(setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
(put-text-property 0 1 'icicle-fancy-candidates t prompt))
(let ((cmd (icicle-read-file-name prompt nil default-value nil initial-contents)))
(when icicle-quote-shell-file-name-flag (setq cmd (icicle-quote-file-name-part-of-cmd cmd)))
cmd)))
(defun icicle-quote-file-name-part-of-cmd (strg)
"Double-quote the file name that starts string STRG, for the shell.
This assumes a UNIX-style shell, for which the following characters
normally need to be escaped in file names: [ \t\n;<>&|()'\"#$].
This is appropriate, for example, if you use Cygwin with MS Windows.
STRG is assumed to be a shell command, possibly including arguments
and possibly ending with `&' to indicate asynchronous execution.
The beginning of STRG is assumed to be a file name, possibly including
the characters [ \t\n;<>&|()'\"#$]. This function double-quotes the
file name only, not the rest of STRG.
Example: If STRG is `c:/Program Files/My Dir/mycmd.exe arg1 arg2 &',
and file c:/Program Files/My Dir/mycmd.exe exists, then this returns
`\"c:/Program Files/My Dir/mycmd.exe\" arg1 arg2 &'."
(save-match-data
(if (not (string-match "[ \t\n;<>&|()'\"#$]" strg))
strg
(let ((indx 0)
(compl "")
(filename "")
(quoted-strg strg)
prefix)
(while (and indx ; Find longest prefix that matches a file name.
(setq indx (1+ (length compl)))
(<= indx (length strg))
(setq prefix (substring strg 0 indx))
(setq compl (try-completion prefix 'read-file-name-internal
(if (> emacs-major-version 22)
minibuffer-completion-predicate
default-directory))))
(when (and (<= (length compl) (length strg)) (string-match compl strg 0)
(file-exists-p compl))
(setq filename compl)))
(if (or (string= "" filename) (not (file-exists-p filename)))
strg
(setq quoted-strg (concat "\"" filename "\""))
(setq quoted-strg (concat quoted-strg (substring strg (length filename)))))))))
;; REPLACE ORIGINAL `recentf-make-menu-items' defined in `recentf.el',
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; Adds Icicles submenu to `Open Recent' menu.
;;
(defun icicle-recentf-make-menu-items (&optional menu)
"Make menu items from the recent list.
This is a menu filter function which ignores the MENU argument."
(setq recentf-menu-filter-commands ())
(let* ((recentf-menu-shortcuts 0)
(file-items (icicle-condition-case-no-debug err
(mapcar 'recentf-make-menu-item
(recentf-apply-menu-filter recentf-menu-filter
(recentf-menu-elements
recentf-max-menu-items)))
(error (message "recentf update menu failed: %s" (error-message-string err))))))
(append (or file-items '(["No files" t :help "No recent file to open" :active nil]))
(if recentf-menu-open-all-flag
'(["All..." recentf-open-files :help "Open recent files through a dialog" :active t])
(and (< recentf-max-menu-items (length recentf-list)) ; `recentf-list' is free here.
'(["More..." recentf-open-more-files
:help "Open files not in the menu through a dialog" :active t])))
(and recentf-menu-filter-commands '("---")) recentf-menu-filter-commands
(and recentf-menu-items-for-commands '("---")) recentf-menu-items-for-commands
(and icicle-mode
'(("Icicles"
["+ Open Recent File..." icicle-recent-file]
["+ Open Recent File (Other Window)..." icicle-recent-file-other-window]
["+ Remove from Recent Files List..." icicle-remove-file-from-recentf-list]))))))
;;(@* "Icicles functions - completion display (not cycling)")
;;; Icicles functions - completion display (not cycling) -------------
(defun icicle-display-candidates-in-Completions (&optional reverse-p no-display-p)
"Refresh the current set of completion candidates in `*Completions*'.
REVERSE-P non-nil means display the candidates in reverse order.
NO-DISPLAY-P non-nil means do not display the candidates; just
recompute them. If the value is `no-msg', then do not show a
minibuffer message indicating that candidates were updated."
;;$$ ;; Pred is special if `minibuffer-completion-table' is a function.
;; (when (and (not (functionp minibuffer-completion-table))
;; (functionp minibuffer-completion-predicate))
;; (setq icicle-completion-candidates
;; (icicle-remove-if-not
;; (lambda (cand)
;; (funcall minibuffer-completion-predicate
;; (if (arrayp minibuffer-completion-table) (intern cand) (list cand))))
;; icicle-completion-candidates)))
;; $$$ (case icicle-incremental-completion-flag
;; ((t always) (setq icicle-incremental-completion-p 'always))
;; ((nil) (setq icicle-incremental-completion-p nil)))
;; $$$$$ (unless (input-pending-p) ; Do nothing if user hit a key.
;; Upgrade `icicle-incremental-completion-p' if we are redisplaying, so that completions will
;; be updated by `icicle-call-then-update-Completions' when you edit.
(setq icicle-incremental-completion-p icicle-incremental-completion-flag)
(when (and (eq t icicle-incremental-completion-p) (get-buffer-window "*Completions*" 0))
(setq icicle-incremental-completion-p 'always))
(let ((nb-cands (length icicle-completion-candidates)))
;; $$$$$$ Could use this binding to prevent frame fitting, to allow room for images.
;; But that is not really the solution. Really should fit the frame or window in such a way
;; that it takes image sizes into account. Might need to wait for a fix to Emacs bug #7822.
;; (autofit-frames-flag (not icicle-image-files-in-Completions)))
(cond ((eq no-display-p 'no-msg)) ; No-op.
(no-display-p
(icicle-msg-maybe-in-minibuffer
"Candidates updated (%s matching): %s" icicle-current-completion-mode
(icicle-propertize (format "%d" nb-cands) 'face 'icicle-msg-emphasis)))
((null icicle-completion-candidates)
(save-selected-window (icicle-remove-Completions-window))
(icicle-msg-maybe-in-minibuffer
(if (eq 'apropos icicle-current-completion-mode)
(let ((typ (car (rassq icicle-apropos-complete-match-fn
icicle-S-TAB-completion-methods-alist))))
(concat "No " typ (and typ " ") "completions"))
(case (icicle-current-TAB-method)
(fuzzy "No fuzzy completions")
(swank "No swank (fuzzy symbol) completions")
(vanilla "No vanilla completions")
(t "No prefix completions")))))
(t
(when (> nb-cands icicle-incremental-completion-threshold)
(message "Displaying completion candidates..."))
;; Display `*Completions*' now, so we can get its window's width.
;; We don't wait for `with-output-to-temp-buffer' to display it, because displaying it
;; might lead to splitting the display window, which would change its width.
;; We need to know the width in order to calculate the proper candidate formatting.
(when (consp icicle-completion-candidates)
(let ((fit-frame-inhibit-fitting-flag t)
(comp-buf (get-buffer-create "*Completions*")))
(unless (get-buffer-window comp-buf 'visible)
(save-selected-window (display-buffer comp-buf t 0)
(deactivate-mark))))) ; Remove any leftover mouse selection.
(with-output-to-temp-buffer "*Completions*"
;; Each candidate in `icicle-completion-candidates' is a string, regardless of the
;; original type of candidate used (e.g. symbol, string, alist candidate,...). Here,
;; provided `icicle-fancy-cands-internal-p' is non-nil, we transform these candidates,
;; replacing each by a string that takes into account symbol properties
;; `icicle-display-string' and `icicle-special-candidate'.
;;
;; Because `icicle-completion-candidates' is affected, changes to the candidate strings
;; (e.g. propertizing) are also reflected in the completion return value chosen by the
;; user. It is not only the display in `*Completions*' that is affected.
;;
;; The symbol whose properties are used is the one in the current obarray that is named
;; by the string candidate to be transformed. If there is no such symbol, then no
;; transformation occurs. Unless `minibuffer-completion-table' is an obarray, the
;; global obarray is used to get the symbol.
;;
;; 1. If the symbol has an `icicle-display-string' property, then that property value
;; must be a string (possibly propertized). We replace the candidate by that string.
;;
;; 2. If the symbol has an `icicle-special-candidate' property, then we transfer the
;; property to the candidate string as a set of text properties. (If the value is
;; not a plist, and `icicle-special-candidate-regexp' is nil, then just apply face
;; `icicle-special-candidate'.) The effect is similar to using
;; `icicle-special-candidate-regexp', but the completion return value is also
;; affected.
(when icicle-fancy-cands-internal-p
(setq icicle-completion-candidates
(mapcar (lambda (cand)
(let* ((symb (intern-soft
cand (and (arrayp minibuffer-completion-table)
minibuffer-completion-table)))
(display-strg (and symb
(stringp (get symb 'icicle-display-string))
(get symb 'icicle-display-string)))
(new-cand (or display-strg cand))
(spec-prop (and symb (get symb 'icicle-special-candidate))))
;; Apply `icicle-special-candidate' property's value.
;; If the value is a plist, then apply the properties as text props.
;; Else (the value is t), apply face `icicle-special-candidate'.
(when spec-prop
(setq new-cand (copy-sequence new-cand))
(if (consp spec-prop)
(add-text-properties 0 (length new-cand) spec-prop new-cand)
(unless icicle-special-candidate-regexp
(add-text-properties 0 (length new-cand)
'(face icicle-special-candidate)
new-cand))))
new-cand))
icicle-completion-candidates)))
;; The `icicle-condition-case-no-debug' should not be needed, but it prevents an
;; "End of buffer" message from `display-completion-list' on Emacs 22.
(icicle-condition-case-no-debug nil
(display-completion-list
(if reverse-p (reverse icicle-completion-candidates) icicle-completion-candidates))
(error nil)))
(save-excursion
(save-window-excursion
(with-current-buffer (get-buffer "*Completions*")
(let* ((buffer-read-only nil)
(eob (point-max))
(filep (or (icicle-file-name-input-p) icicle-abs-file-candidates))
(dir (and filep icicle-last-input
(icicle-file-name-directory icicle-last-input)))
(histvar (and (symbolp minibuffer-history-variable)
(boundp minibuffer-history-variable)
minibuffer-history-variable))
(hist (and histvar
(if filep
(let ((default-directory dir))
(mapcar #'expand-file-name
(symbol-value histvar)))
(symbol-value histvar))))
(case-fold-search
;; Don't bother with buffer completion, `read-buffer-completion-ignore-case'.
(if (and filep (boundp 'read-file-name-completion-ignore-case))
read-file-name-completion-ignore-case
completion-ignore-case)))
(goto-char (icicle-start-of-candidates-in-Completions))
(while (not (eobp))
(let* ((beg (point))
(end (next-single-property-change beg 'mouse-face nil eob))
(next (next-single-property-change end 'mouse-face nil eob))
(faces ()))
;; Highlight candidate specially if it is a proxy candidate.
(let ((candidate (icicle-current-completion-in-Completions)))
;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
(when (member candidate icicle-proxy-candidates)
(setq faces (cons 'icicle-proxy-candidate faces))
(if (not icicle-proxy-candidate-regexp)
(add-text-properties beg end (cons 'face (list faces)))
(save-match-data
(when (string-match icicle-proxy-candidate-regexp candidate)
(add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
(cons 'face (list faces))))))))
;; Highlight candidate specially if it is an extra candidate.
(let ((candidate (icicle-current-completion-in-Completions)))
;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
(save-match-data
(when (member candidate icicle-extra-candidates)
(setq faces (cons 'icicle-extra-candidate faces))
(add-text-properties beg end (cons 'face (list faces))))))
;; Highlight candidate specially if it is a special candidate.
(let ((candidate (icicle-current-completion-in-Completions)))
;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
(save-match-data
(when (and icicle-special-candidate-regexp
(string-match icicle-special-candidate-regexp candidate))
(setq faces (cons 'icicle-special-candidate faces))
(if (not icicle-special-candidate-regexp)
(add-text-properties beg end (cons 'face (list faces)))
(add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
(cons 'face (list faces)))))))
;; Highlight candidate (`*-historical-candidate') if it was used previously.
(when icicle-highlight-historical-candidates-flag
(let ((candidate (icicle-current-completion-in-Completions)))
(when (and (consp hist)
(not (member candidate icicle-hist-cands-no-highlight)))
(let ((default-directory dir))
(when (member (if filep (expand-file-name candidate) candidate) hist)
(add-text-properties
beg end
`(face ,(setq faces (cons 'icicle-historical-candidate faces)))))))))
;; Highlight, inside the candidate, the expanded common match.
(when (and (or icicle-expand-input-to-common-match-flag
(eq icicle-current-completion-mode 'prefix))
icicle-current-input (not (string= "" icicle-current-input)))
(save-excursion
(save-restriction
(narrow-to-region beg end) ; Restrict to the completion candidate.
(when (re-search-forward (regexp-quote (icicle-minibuf-input-sans-dir
icicle-current-input))
nil t)
(setq faces (cons 'icicle-common-match-highlight-Completions faces))
(put-text-property (match-beginning 0) (point) 'face faces)))))
;; Hide match for `icicle-current-input' (expanded common match, if available),
;; if `icicle-hide-common-match-in-Completions-flag' is non-nil.
(save-excursion
(save-restriction
(narrow-to-region beg end) ; Restrict to the completion candidate.
(when (and icicle-hide-common-match-in-Completions-flag
icicle-common-match-string)
(when (re-search-forward (regexp-quote icicle-common-match-string) nil t)
(if (> emacs-major-version 20)
(put-text-property (match-beginning 0) (point) 'display "...")
(put-text-property (match-beginning 0) (point) 'invisible t))))))
;; Highlight, inside the candidate, what the input expression matches.
(unless (and icicle-current-raw-input (string= "" icicle-current-raw-input)
icicle-apropos-complete-match-fn)
(save-excursion
(save-restriction
(narrow-to-region beg end) ; Restrict to the completion candidate.
(let ((fn (if (and (eq 'prefix icicle-current-completion-mode)
(not (memq (icicle-current-TAB-method)
'(fuzzy swank))))
;; $$$$$$ What is best for `vanilla' (Emacs 23) completion?
'search-forward
(case icicle-apropos-complete-match-fn
(icicle-scatter-match
(lambda (input bound noerr)
(re-search-forward (icicle-scatter input) bound noerr)))
(icicle-levenshtein-match
(if (= icicle-levenshtein-distance 1)
(lambda (input bound noerr)
(re-search-forward
(icicle-levenshtein-one-regexp input)
bound noerr))
're-search-forward))
(otherwise 're-search-forward)))))
(save-excursion
(when (and (funcall fn (icicle-minibuf-input-sans-dir
icicle-current-raw-input)
nil t)
(not (eq (match-beginning 0) (point))))
(setq faces (cons 'icicle-match-highlight-Completions faces))
(put-text-property (match-beginning 0) (point) 'face faces)))
;; If `icicle-hide-non-matching-lines-flag' then hide all lines
;; of candidate that do not match current input.
(let ((candidate (icicle-current-completion-in-Completions))
(input (icicle-minibuf-input-sans-dir
icicle-current-raw-input))
(cbeg beg))
(when (and icicle-hide-non-matching-lines-flag
(string-match "\n" candidate)
(not (string= "\n" candidate)))
(goto-char cbeg)
(while (not (eobp))
(unless (funcall fn input (line-end-position) t)
(if (> emacs-major-version 20)
(put-text-property
(line-beginning-position)
(min (1+ (line-end-position)) (point-max))
'display "...\n")
(put-text-property
(line-beginning-position)
(min (1+ (line-end-position)) (point-max))
'invisible t)))
(forward-line 1))))))))
;; Highlight candidate if it has been saved.
(when (and icicle-highlight-saved-candidates-flag
icicle-saved-completion-candidates)
(let ((candidate (icicle-current-completion-in-Completions)))
(when (member candidate icicle-saved-completion-candidates)
(let ((ov (make-overlay beg end)))
(push ov icicle-saved-candidate-overlays)
(overlay-put ov 'face 'icicle-saved-candidate)
(overlay-put ov 'priority '10)))))
;; Treat `icicle-candidate-properties-alist'.
;; A `face' prop will unfortunately wipe out any `face' prop we just applied.
(when icicle-candidate-properties-alist
(save-excursion
(save-restriction
(narrow-to-region beg end) ; Restrict to the completion candidate.
(let* ((candidate (buffer-substring (point-min) (point-max)))
(orig-pt (point))
(start 0)
(end 0)
(partnum 1)
(join (concat "\\(" icicle-list-join-string "\\|$\\)"))
(len-cand (length candidate))
(len-join (length icicle-list-join-string))
(first t))
(save-match-data
(while (and (or first (not (= end (match-beginning 0)))
(< (+ end len-join) len-cand))
(string-match join candidate
(if (and (not first)
(= end (match-beginning 0))
(< end len-cand))
(+ end len-join)
end))
(< end len-cand))
(setq first nil
end (or (match-beginning 0) len-cand))
(let* ((entry
(assq partnum icicle-candidate-properties-alist))
(properties (cadr entry))
(propertize-join-string (car (cddr entry))))
(when properties
(add-text-properties
(+ start orig-pt) (+ end orig-pt) properties))
(when propertize-join-string
(add-text-properties
(+ end orig-pt)
(+ end orig-pt len-join)
properties)))
(setq partnum (1+ partnum)
start (match-end 0))))))))
;; Show thumbnail for an image file.
(when (and filep (fboundp 'image-file-name-regexp)
icicle-image-files-in-Completions
(if (fboundp 'display-graphic-p) (display-graphic-p) window-system))
(let ((image-file (icicle-transform-multi-completion
(icicle-current-completion-in-Completions))))
(when (and (require 'image-dired nil t)
(if (fboundp 'string-match-p)
(string-match-p (image-file-name-regexp) image-file)
(save-match-data
(string-match (image-file-name-regexp) image-file))))
(let ((thumb-img (append (image-dired-get-thumbnail-image image-file)
'(:margin 2)))
(img-ov (overlays-in (point) (1+ (point)))))
(if img-ov
(delete-overlay (car img-ov))
(put-image thumb-img beg)
(setq img-ov (loop for ov in (overlays-in (point) (1+ (point)))
when (overlay-get ov 'put-image) collect ov into ovs
finally return (car ovs)))
(overlay-put img-ov 'image-file image-file)
(overlay-put img-ov 'thumb-img thumb-img)
(overlay-put img-ov 'image-size (image-size thumb-img))))
;; Replace file name with a space.
(when (eq 'image-only icicle-image-files-in-Completions)
(let ((name-ov (overlays-in end end)))
(if name-ov
(delete-overlay (car name-ov))
(setq name-ov (make-overlay beg end))
(overlay-put name-ov 'display " ")))))))
(goto-char next)))
;; Remove all newlines for images-only display.
(when (eq icicle-image-files-in-Completions 'image-only)
(save-excursion (goto-char (icicle-start-of-candidates-in-Completions))
(while (and (re-search-forward "$") (not (eobp)))
(delete-char 1)))))
(set-buffer-modified-p nil)
(setq buffer-read-only t))))
(with-current-buffer (get-buffer "*Completions*")
(set (make-local-variable 'mode-line-frame-identification)
(format " %d %s "
nb-cands
(if (and icicle-max-candidates
(< icicle-max-candidates icicle-nb-candidates-before-truncation))
(format "shown / %d" icicle-nb-candidates-before-truncation)
"candidates")))
(put-text-property 0 (length mode-line-frame-identification)
'face 'icicle-mode-line-help
mode-line-frame-identification)
(goto-char (icicle-start-of-candidates-in-Completions))
(set-window-point (get-buffer-window "*Completions*" 0) (point))
(icicle-fit-completions-window))
;; Use the same font family as the starting buffer. This is particularly for picking up
;; the proper font for Unicode chars in `*Completions*'. Emacs 23+ only.
;; But skip this if using `oneonone.el', since `1on1-display-*Completions*-frame' does it.
(when (and (not (fboundp '1on1-display-*Completions*-frame))
(get-buffer-window "*Completions*" 'visible)
icicle-pre-minibuffer-buffer
(> emacs-major-version 22))
(save-window-excursion
(select-window (get-buffer-window "*Completions*" 'visible))
(when (one-window-p t);; $$$$$ Also this? (window-dedicated-p (selected-window))
(let* ((orig-win (get-buffer-window icicle-pre-minibuffer-buffer 'visible))
(orig-font-fam (and (window-live-p orig-win)
(save-window-excursion
(select-window orig-win)
(face-attribute 'default :family)))))
(when orig-font-fam
(set-face-attribute 'default (selected-frame) :family orig-font-fam))))))
(message nil))))) ; Clear out any "Looking for..."
;; REPLACE ORIGINAL `display-completion-list' (built-in function),
;; saving it for restoration when you toggle `icicle-mode'.
;;
;; 1. Does not remove text properties from candidates when it displays them in `*Completions*'.
;; 2. Adjusts number of columns and their widths to window size.
;; 3. The optional second arg is ignored. In vanilla Emacs < 23, this is a string
;; representing a common prefix, and faces `completions-first-difference' and
;; `completions-common-part' are used on candidates.
;;
(unless (fboundp 'old-display-completion-list)
(defalias 'old-display-completion-list (symbol-function 'display-completion-list)))
(defun icicle-display-completion-list (completions &optional ignored)
"Display the list of completions, COMPLETIONS, using `standard-output'.
Each element may be just a symbol or string or may be a list of two
strings to be printed as if concatenated.
If it is a list of two strings, the first is the actual completion
alternative, the second serves as annotation.
`standard-output' must be a buffer.
The actual completion alternatives, as inserted, are given the
`mouse-face' property of `highlight'.
At the end, this runs the normal hook `completion-setup-hook'.
It can find the completion buffer in `standard-output'.
The optional second arg is ignored."
(if (not (bufferp standard-output))
(let ((standard-output (current-buffer))) (icicle-display-completion-list completions))
(let ((mainbuf (current-buffer))) ; $$$$$$ For Emacs 23 crap that puts base-size in last cdr.
(with-current-buffer standard-output
(goto-char (point-max))
(when icicle-show-Completions-help-flag (icicle-insert-Completions-help-string))
(let ((cand-intro-string (if completions
"Possible completions are:\n"
"There are no possible completions of what you have typed.")))
(put-text-property 0 (length cand-intro-string) 'face 'icicle-Completions-instruction-1
cand-intro-string)
(insert cand-intro-string))
;; $$$$$$$$ Emacs 23 nonsense. Revisit this when Stefan finally removes that crud.
;; This is done in Emacs 23 `display-completion-list'.
(when (and completions (fboundp 'completion-all-sorted-completions)) ; Emacs 23
(let ((last (last completions)))
;; Set base-size from the tail of the list.
(set (make-local-variable 'completion-base-size)
(or (cdr last) (and (minibufferp mainbuf) 0)))
(setcdr last nil))) ; Make completions a properly nil-terminated list.
(icicle-insert-candidates completions)))
;; In vanilla Emacs < 23, the hook is run with `completion-common-substring' bound to
;; what is here called IGNORED.
(run-hooks 'completion-setup-hook)
nil))
(defun icicle-insert-candidates (candidates)
"Insert completion candidates from list CANDIDATES into the current buffer."
(when (consp candidates)
(let* ((multilinep #'(lambda (cand)
(if (consp cand)
(or (string-match "\n" (car cand))
(string-match "\n" (cdr cand)))
(string-match "\n" cand))))
(any-multiline-p (loop for cand in candidates
if (funcall multilinep cand) return t
finally return nil))
(max-cand-len (apply #'max (mapcar (lambda (cand)
(if (consp cand)
(+ (length (car cand)) (length (cadr cand)))
(length cand)))
candidates)))
(comp-win (get-buffer-window (current-buffer) 0))
(wwidth
(let ((spcl-frame-params (special-display-p (buffer-name))))
(cond ((and spcl-frame-params ; Special-buffer. Use its default frame width.
(or (and (consp spcl-frame-params)
(cdr (assq 'width (cadr spcl-frame-params))))
(cdr (assq 'width special-display-frame-alist))
(cdr (assq 'width default-frame-alist)))))
(comp-win (1- (window-width comp-win))) ; Width picked by `display-buffer'.
(t 40)))) ; Failsafe.
(nb-cands (length candidates))
(columns (if any-multiline-p
1
(or icicle-Completions-max-columns
(max 1 (min (/ (* 100 wwidth)
(* icicle-candidate-width-factor max-cand-len))
nb-cands)))))
(colwidth (if (eq 1 columns) (min max-cand-len wwidth) (/ wwidth columns)))
(column-nb 0)
(rows (ceiling nb-cands columns))
(row 0)
startpos endpos string)
(when (eq 1 columns) (setq wwidth colwidth))
(dolist (cand candidates)
(setq endpos (point))
(cond ((eq icicle-completions-format 'vertical) ; Vertical layout.
(when (>= row rows)
(forward-line (- rows))
(setq column-nb (+ column-nb colwidth)
row 0))
(when (> column-nb 0)
(end-of-line)
(let ((cand-end (point)))
(indent-to column-nb icicle-inter-candidates-min-spaces)
(put-text-property cand-end (point) 'mouse-face nil) ; Turn off `mouse-face', `face'
(put-text-property cand-end (point) 'face nil))))
(t ; Horizontal layout (`horizontal' or nil).
(unless (bolp)
(put-text-property (point) (point) 'mouse-face nil) ; Turn off `mouse-face'
(indent-to (* (max 1 column-nb) colwidth) icicle-inter-candidates-min-spaces)
(when (< wwidth (+ (max colwidth (if (consp cand)
(+ (length (car cand)) (length (cadr cand)))
(length cand)))
(current-column)))
(save-excursion ; This is like `fixup-whitespace', but only forward.
(delete-region (point) (progn (skip-chars-forward " \t") (point)))
(unless (or (looking-at "^\\|\\s)")
(save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'")))
(insert ?\ )))
(insert "\n")
(setq column-nb columns))) ; End of the row. Simulate being in farthest column.
(when (< endpos (point)) (set-text-properties endpos (point) nil))))
;; Convert candidate (but not annotation) to unibyte or to multibyte, if needed.
(setq string (if (consp cand) (car cand) cand))
(cond ((and (null enable-multibyte-characters) (multibyte-string-p string))
(setq string (string-make-unibyte string)))
((and enable-multibyte-characters (not (multibyte-string-p string)))
(setq string (string-make-multibyte string))))
;; Insert candidate (and annotation).
(put-text-property (point) (progn (insert string) (point)) 'mouse-face 'highlight)
(unless (atom cand) (set-text-properties (point) (progn (insert (cadr cand)) (point)) nil))
(if (not (eq icicle-completions-format 'vertical))
(setq column-nb (mod (1+ column-nb) columns))
(if (> column-nb 0) (forward-line) (insert "\n")) ; Vertical layout.
(setq row (1+ row)))
(when any-multiline-p (insert (if (eq 'vertical icicle-completions-format) "\n" "\n\n")))))))
;; ARG is not used in any calls yet/currently.
(defun icicle-fit-completions-window (&optional arg)
"Fit the height of the window that is showing completions to its contents.
Optional ARG determines what the effect is, as follows:
`fit-only' - fit window to contents, but do not scale text size
`scale-only' - scale text size but do not fit window to contents
anything else - scale text size and fit window to contents
Window fitting is available only for Emacs 24+, because
`fit-window-to-buffer' is broken for Emacs 21-23 (it can remove
windows).
Text size scaling uses `icicle-Completions-text-scale-decrease' and is
available only for Emacs 23+. (No scaling in any case if using
`oneonone.el' with a `*Completions*' frame.)."
(unless (or (eq arg 'scale-only)
(= emacs-major-version 23) ; `fit-window-to-buffer' is broken before 24: removes windows.
(= emacs-major-version 22))
(when (and (eq major-mode 'completion-list-mode) (fboundp 'fit-window-to-buffer))
(let ((win (get-buffer-window "*Completions*" 0)))
(unless (< (window-width win) (frame-width)) ; Don't shrink if split horizontally.
(fit-window-to-buffer
win
(or (and (symbolp icicle-last-top-level-command)
(get icicle-last-top-level-command 'icicle-Completions-window-max-height))
icicle-Completions-window-max-height))))))
(unless (eq arg 'fit-only)
(when (and (boundp 'icicle-Completions-text-scale-decrease) ; Emacs 23+
(eq major-mode 'completion-list-mode)
(or (not (boundp '1on1-*Completions*-frame-flag)) (not 1on1-*Completions*-frame-flag)))
(text-scale-decrease icicle-Completions-text-scale-decrease))))
(defun icicle-highlight-initial-whitespace (input)
"Highlight any initial whitespace in your input.
Only if `icicle-highlight-input-initial-whitespace-flag' is non-nil.
INPUT is the current user input, that is, the completion root.
This must be called in the minibuffer."
(when (and icicle-highlight-input-initial-whitespace-flag (not (string= "" input)))
(let ((case-fold-search
;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
(if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
(boundp 'read-file-name-completion-ignore-case))
read-file-name-completion-ignore-case
completion-ignore-case)))
(save-excursion
(goto-char (icicle-minibuffer-prompt-end))
(when (and (icicle-file-name-input-p) insert-default-directory)
(search-forward (icicle-file-name-directory-w-default input) nil t)) ; Skip directory.
(save-excursion
(save-restriction
(narrow-to-region (point) (point-max)) ; Search within completion candidate.
(while (and (not (eobp)) (looking-at "\\(\\s-\\|\n\\)+"))
(put-text-property (point) (1+ (point)) 'face 'icicle-whitespace-highlight)
(forward-char 1))
;; Remove any previous whitespace highlighting that is no longer part of prefix.
(while (not (eobp))
(when (eq (get-text-property (point) 'face) 'icicle-whitespace-highlight)
(put-text-property (point) (1+ (point)) 'face nil))
(forward-char 1))))))))
(defun icicle-minibuffer-prompt-end ()
"Buffer position of end of minibuffer prompt, or `point-min'.
Version of `minibuffer-prompt-end' that works for Emacs 20 and later."
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) (point-min)))
;;(@* "Icicles functions - TAB completion cycling")
;;; Icicles functions - TAB completion cycling --------------------
(defun icicle-prefix-candidates (input)
"List of prefix or fuzzy completions for the current partial INPUT.
INPUT is a string. Each candidate is a string."
(setq icicle-candidate-nb nil)
(if (or (and (eq 'fuzzy (icicle-current-TAB-method)) (featurep 'fuzzy-match))
(and (eq 'swank (icicle-current-TAB-method)) (featurep 'el-swank-fuzzy)))
(condition-case nil
(icicle-transform-candidates (append icicle-extra-candidates icicle-proxy-candidates
(icicle-fuzzy-candidates input)))
(quit (top-level))) ; Let `C-g' stop it.
(let ((cands (icicle-unsorted-prefix-candidates input)))
(cond (icicle-abs-file-candidates (icicle-strip-ignored-files-and-sort cands))
(icicle-sort-comparer (icicle-maybe-sort-maybe-truncate cands))
(t cands)))))
(defun icicle-fuzzy-candidates (input)
"Return fuzzy matches for INPUT. Handles also swank fuzzy symbol match."
(condition-case nil
(let ((candidates ()))
;; $$$$ Should treat other `minibuffer-completion-table' types also.
(cond ((and (vectorp minibuffer-completion-table)
(not (eq (icicle-current-TAB-method) 'swank)))
(mapatoms (lambda (symb) (when (or (null minibuffer-completion-predicate)
(funcall minibuffer-completion-predicate symb))
(push (symbol-name symb) candidates)))
minibuffer-completion-table)
(setq candidates (FM-all-fuzzy-matches input candidates)))
((vectorp minibuffer-completion-table)
(setq candidates (mapcar #'car
(car (el-swank-fuzzy-completions
input icicle-swank-timeout
(or minibuffer-completion-predicate 'fboundp)
icicle-swank-prefix-length)))))
((and (consp minibuffer-completion-table) (consp (car minibuffer-completion-table)))
(dolist (cand minibuffer-completion-table)
(when (or (null minibuffer-completion-predicate)
(funcall minibuffer-completion-predicate cand))
(push (car cand) candidates)))
(setq candidates (FM-all-fuzzy-matches input candidates))))
(let ((icicle-extra-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand))) icicle-extra-candidates))
(icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand))) icicle-proxy-candidates))
(filtered-candidates
(icicle-transform-candidates
(append icicle-extra-candidates icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(let ((case-fold-search completion-ignore-case))
(and (icicle-filter-wo-input cand)
(or (not icicle-must-pass-after-match-predicate)
(funcall icicle-must-pass-after-match-predicate cand)))))
candidates)))))
(when (consp filtered-candidates)
(setq icicle-common-match-string (icicle-expanded-common-match input filtered-candidates)))
(unless filtered-candidates (setq icicle-common-match-string nil))
filtered-candidates))
(quit (top-level)))) ; Let `C-g' stop it.
(defun icicle-unsorted-prefix-candidates (input)
"Unsorted list of prefix completions for the current partial INPUT.
this also sets `icicle-common-match-string' to the expanded common
prefix over all candidates."
(condition-case nil
(let* ((candidates
(if (icicle-not-basic-prefix-completion-p)
(icicle-completion-all-completions input minibuffer-completion-table
minibuffer-completion-predicate
;; $$$$$$ (- (point) (field-beginning)))
(length input)
(and (fboundp 'completion--field-metadata) ;Emacs24
(completion--field-metadata
(field-beginning))))
(icicle-all-completions input minibuffer-completion-table
minibuffer-completion-predicate
icicle-ignore-space-prefix-flag)))
(icicle-extra-candidates
(icicle-remove-if-not
(lambda (cand)
(save-match-data
(string-match (concat "^" (regexp-quote input)) cand))) icicle-extra-candidates))
(icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(save-match-data
(string-match (concat "^" (regexp-quote input)) cand))) icicle-proxy-candidates))
(filtered-candidates
(icicle-transform-candidates
(append icicle-extra-candidates icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(let ((case-fold-search completion-ignore-case))
(and (icicle-filter-wo-input cand)
(or (not icicle-must-pass-after-match-predicate)
(funcall icicle-must-pass-after-match-predicate cand)))))
candidates)))))
(when (consp filtered-candidates)
(let ((common-prefix
(if (icicle-not-basic-prefix-completion-p)
(icicle-completion-try-completion input minibuffer-completion-table
minibuffer-completion-predicate
;; $$$$$$ (- (point) (field-beginning)))
(length input)
(and (fboundp 'completion--field-metadata)
(completion--field-metadata ; Emacs 24
(field-beginning))))
(try-completion input minibuffer-completion-table
minibuffer-completion-predicate))))
(setq icicle-common-match-string (if (eq t common-prefix) input common-prefix))))
(unless filtered-candidates (setq icicle-common-match-string nil))
filtered-candidates)
(quit (top-level)))) ; Let `C-g' stop it.
(defun icicle-file-name-prefix-candidates (input)
"List of prefix completions for partial file name INPUT.
INPUT is a string.
Candidates can be directories. Each candidate is a string."
(setq icicle-candidate-nb nil)
;; $$$$$$ (let ((default-directory (icicle-file-name-directory-w-default input)))
;; $$$$$$ (icicle-unsorted-file-name-prefix-candidates
;; $$$$$$ (or (icicle-file-name-nondirectory input) ""))))
(icicle-strip-ignored-files-and-sort (icicle-unsorted-file-name-prefix-candidates input)))
(defun icicle-unsorted-file-name-prefix-candidates (input)
"Unsorted list of prefix completions for the current file-name INPUT.
This also sets `icicle-common-match-string' to the expanded common
prefix over all candidates."
(condition-case nil
(let* ((pred (if (< emacs-major-version 23) default-directory minibuffer-completion-predicate))
(candidates
(if (icicle-not-basic-prefix-completion-p)
(icicle-completion-all-completions input minibuffer-completion-table pred
(length input)
(and (fboundp 'completion--field-metadata) ;Emacs24
(completion--field-metadata
(field-beginning))))
(icicle-all-completions input minibuffer-completion-table pred
icicle-ignore-space-prefix-flag)))
(icicle-extra-candidates
(icicle-remove-if-not
(lambda (cand)
(save-match-data
(string-match (concat "^" (regexp-quote input)) cand))) icicle-extra-candidates))
(icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(save-match-data
(string-match (concat "^" (regexp-quote input)) cand))) icicle-proxy-candidates))
(filtered-candidates
(icicle-transform-candidates
(append icicle-extra-candidates icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(let ((case-fold-search
(if (boundp 'read-file-name-completion-ignore-case)
read-file-name-completion-ignore-case
completion-ignore-case)))
(if (member cand '("../" "./"))
(member input '(".." ".")) ; Prevent "" from matching "../"
(and
;;; $$$$$$ REMOVED - This was no good for PCM - e.g. input `ic-o' and candidates `icicles-opt.el[c]'.
;;; We don't do it for non-file-name completion, anyway, and it doesn't seem needed.
;;; (save-match-data
;;; (string-match (concat "^" (regexp-quote input)) cand))
(icicle-filter-wo-input cand)
(or (not icicle-must-pass-after-match-predicate)
(funcall icicle-must-pass-after-match-predicate cand))))))
candidates)))))
(when (consp filtered-candidates)
(let ((common-prefix
(if (icicle-not-basic-prefix-completion-p)
(icicle-completion-try-completion input minibuffer-completion-table
minibuffer-completion-predicate
(length input)
(and (fboundp 'completion--field-metadata)
(completion--field-metadata ; Emacs 24
(field-beginning))))
(try-completion input minibuffer-completion-table default-directory))))
;; If common prefix matches an empty directory, use that dir as the sole completion.
(when (and (stringp common-prefix)
(save-match-data (string-match "/\\.$" common-prefix))) ; Matches /., /..
(setq common-prefix (substring common-prefix 0 (- (length common-prefix) 2))))
(setq icicle-common-match-string (if (eq t common-prefix) input common-prefix))))
(unless filtered-candidates (setq icicle-common-match-string nil))
filtered-candidates)
(quit (top-level)))) ; Let `C-g' stop it.
;;(@* "Icicles functions - S-TAB completion cycling")
;;; Icicles functions - S-TAB completion cycling -------------------
(defun icicle-apropos-candidates (input)
"List of candidate apropos completions for the current partial INPUT.
INPUT is a string. Each candidate is a string."
(setq icicle-candidate-nb nil)
(let ((cands (icicle-unsorted-apropos-candidates input)))
(cond (icicle-abs-file-candidates (icicle-strip-ignored-files-and-sort cands))
(icicle-sort-comparer (icicle-maybe-sort-maybe-truncate cands))
(t cands))))
(defun icicle-unsorted-apropos-candidates (input)
"Unsorted list of apropos completions for the current partial INPUT.
When `icicle-expand-input-to-common-match-flag' is non-nil, this also
sets `icicle-common-match-string' to the expanded common match of
input over all candidates."
(condition-case nil
(progn
(when icicle-regexp-quote-flag (setq input (regexp-quote input)))
(let* ((candidates
(if (and (functionp minibuffer-completion-table)
(not icicle-apropos-complete-match-fn))
;; Let the function do it all.
(icicle-all-completions input minibuffer-completion-table
minibuffer-completion-predicate
icicle-ignore-space-prefix-flag)
(icicle-all-completions "" minibuffer-completion-table
minibuffer-completion-predicate
icicle-ignore-space-prefix-flag)))
(icicle-extra-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand))) icicle-extra-candidates))
(icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand))) icicle-proxy-candidates))
(filtered-candidates
(icicle-transform-candidates
(append icicle-extra-candidates icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(let ((case-fold-search completion-ignore-case))
(and (icicle-filter-wo-input cand)
(or (not icicle-apropos-complete-match-fn)
;; Assume no match if error - e.g. due to `string-match' with
;; binary data in Emacs 20. Do this everywhere we call
;; `icicle-apropos-complete-match-fn'.
(condition-case nil
(funcall icicle-apropos-complete-match-fn input cand)
(error nil)))
(or (not icicle-must-pass-after-match-predicate)
(funcall icicle-must-pass-after-match-predicate cand)))))
candidates)))))
(when (and icicle-expand-input-to-common-match-flag (consp filtered-candidates))
(setq icicle-common-match-string (icicle-expanded-common-match input filtered-candidates)))
(unless filtered-candidates (setq icicle-common-match-string nil))
filtered-candidates)) ; Return candidates.
(quit (top-level)))) ; Let `C-g' stop it.
(defun icicle-file-name-apropos-candidates (input)
"List of apropos completions for partial file-name INPUT.
INPUT is a string.
Candidates can be directories. Each candidate is a string."
(setq icicle-candidate-nb nil)
(let ((default-directory (icicle-file-name-directory-w-default input)))
(icicle-strip-ignored-files-and-sort
(icicle-unsorted-file-name-apropos-candidates (or (icicle-file-name-nondirectory input) "")))))
(defun icicle-unsorted-file-name-apropos-candidates (input)
"Unsorted list of apropos completions for the partial file-name INPUT.
When `icicle-expand-input-to-common-match-flag' is non-nil, this also
sets `icicle-common-match-string' to the expanded common match of
input over all candidates."
(condition-case nil
(progn
(when icicle-regexp-quote-flag (setq input (regexp-quote input)))
(let* ((pred (if (< emacs-major-version 23) default-directory minibuffer-completion-predicate))
(candidates
;; $$$$$ Should we remove string test for Emacs 23?
(if (and (not (stringp minibuffer-completion-predicate))
(not icicle-apropos-complete-match-fn)
(functionp minibuffer-completion-table))
;; Let the function do it all.
(icicle-all-completions input minibuffer-completion-table pred
icicle-ignore-space-prefix-flag)
(icicle-all-completions "" minibuffer-completion-table pred
icicle-ignore-space-prefix-flag)))
(icicle-extra-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand)))
icicle-extra-candidates))
(icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand) (save-match-data (string-match input cand)))
icicle-proxy-candidates))
(filtered-candidates
(icicle-transform-candidates
(append icicle-extra-candidates icicle-proxy-candidates
(icicle-remove-if-not
(lambda (cand)
(let ((case-fold-search
(if (boundp 'read-file-name-completion-ignore-case)
read-file-name-completion-ignore-case
completion-ignore-case)))
(if (member cand '("../" "./"))
(member input '(".." ".")) ; Prevent "" from matching "../"
(and (icicle-filter-wo-input cand)
(or (not icicle-apropos-complete-match-fn)
;; Assume no match if error - e.g. due to `string-match'
;; with binary data in Emacs 20. Do this everywhere we
;; call `icicle-apropos-complete-match-fn'.
(condition-case nil
(funcall icicle-apropos-complete-match-fn input cand)
(error nil)))
(or (not icicle-must-pass-after-match-predicate)
(funcall icicle-must-pass-after-match-predicate cand))))))
candidates)))))
(when icicle-expand-input-to-common-match-flag
(setq icicle-common-match-string (if (consp filtered-candidates)
(icicle-expanded-common-match
input filtered-candidates)
nil)))
(unless filtered-candidates (setq icicle-common-match-string nil))
filtered-candidates)) ; Return candidates.
(quit (top-level)))) ; Let `C-g' stop it.
(defun icicle-expanded-common-match (input candidates)
"Return the expanded common match for INPUT among all CANDIDATES.
This assumes that INPUT matches each string in list CANDIDATES.
Return nil if there is no common match.
The expanded common match is typically, but not always, the longest
common match. See the documentation, section `Expanded-Common-Match
Completion', for details."
;; Since `icicle-expanded-common-match-1' checks only the first match for a single candidate,
;; we call it twice, once using the first candidate and once using the second.
;; Typically, one of these tries will give us the longest common match.
(catch 'ecm-error
(let ((first-try (icicle-expanded-common-match-1 input candidates))
(second-try nil))
(when (and first-try (cadr candidates))
(setq second-try (icicle-expanded-common-match-1
input (cons (cadr candidates) (cons (car candidates) (cddr candidates))))))
(if (> (length second-try) (length first-try)) second-try first-try))))
(defun icicle-expanded-common-match-1 (input candidates)
"Helper function for `icicle-expanded-common-match."
;; This does not always give a longest common match, because it looks only at the first match
;; of INPUT with the first candidate. What it returns is the longest match that is common to
;; all CANDIDATES and also contains the first match in the first candidate.
(let ((case-fold-search
;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
(if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
(boundp 'read-file-name-completion-ignore-case))
read-file-name-completion-ignore-case
completion-ignore-case))
(first (car candidates)))
(and icicle-apropos-complete-match-fn ; Return nil if no match function.
(save-match-data
;; Assume no common match in case of error - e.g. due to `string-match' with binary data
;; in Emacs 20. Do this throughout, whenever we call `icicle-apropos-complete-match-fn'.
(unless (condition-case nil
(funcall icicle-apropos-complete-match-fn input first)
(error (throw 'ecm-error nil)))
(error (throw 'ecm-error nil))) ; If input doesn't match candidate, return nil.
(let* ((len-first (length first))
(beg 0)
(end len-first)
(orig-match-beg (match-beginning 0))
(orig-match-end (match-end 0))
(ecm first) ; "ecm" for "expanded common match".
(rest (cdr candidates))
beg-ecm beg-next)
(if (= orig-match-beg end)
(setq ecm "") ; INPUT was, for instance, "$" or "\\>$; return "".
;; Compare with the rest of the candidates, reducing as needed.
(while (and rest ecm)
(condition-case nil
(funcall icicle-apropos-complete-match-fn input (car rest))
(error (throw 'ecm-error nil))) ; If input doesn't match candidate, return nil.
(setq beg-next (match-beginning 0))
;; Remove any prefix that doesn't match some other candidate.
(while (and (< beg orig-match-beg)
(not (condition-case nil
(funcall icicle-apropos-complete-match-fn
(regexp-quote (substring ecm 0 (- orig-match-end beg)))
(car rest))
(error (throw 'ecm-error nil))))
(progn (setq beg-ecm (match-beginning 0)) (>= beg-ecm beg-next)))