ido-ubiquitous.el 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854
  1. ;; -*- lexical-binding: t -*-
  2. ;;; ido-ubiquitous.el --- Use ido (nearly) everywhere.
  3. ;; Author: Ryan C. Thompson
  4. ;; URL: https://github.com/DarwinAwardWinner/ido-ubiquitous
  5. ;; Version: 2.9
  6. ;; Created: 2011-09-01
  7. ;; Keywords: convenience
  8. ;; EmacsWiki: InteractivelyDoThings
  9. ;; Package-Requires: ((emacs "24.1"))
  10. ;; This file is NOT part of GNU Emacs.
  11. ;;; Commentary:
  12. ;; If you use the excellent `ido-mode' for efficient completion of
  13. ;; file names and buffers, you might wonder if you can get ido-style
  14. ;; completion everywhere else too. Well, that's what this package
  15. ;; does! ido-ubiquitous is here to enable ido-style completion for
  16. ;; (almost) every function that uses the standard completion function
  17. ;; `completing-read'.
  18. ;;; License:
  19. ;; This program is free software; you can redistribute it and/or modify
  20. ;; it under the terms of the GNU General Public License as published by
  21. ;; the Free Software Foundation; either version 3, or (at your option)
  22. ;; any later version.
  23. ;;
  24. ;; This program is distributed in the hope that it will be useful,
  25. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  26. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  27. ;; GNU General Public License for more details.
  28. ;;
  29. ;; You should have received a copy of the GNU General Public License
  30. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  31. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  32. ;; Boston, MA 02110-1301, USA.
  33. ;;; Code:
  34. (defconst ido-ubiquitous-version "2.9"
  35. "Currently running version of ido-ubiquitous.
  36. Note that when you update ido-ubiquitous, this variable may not
  37. be updated until you restart Emacs.")
  38. (eval-when-compile
  39. (when (or (not (boundp 'completing-read-function))
  40. (< emacs-major-version 24))
  41. (error "Could not find required variable `completing-read-function'. Are you using Emacs version 24 or higher? If you have Emacs 23 or lower, please downgrade to ido-ubiquitous version 1.7.")))
  42. (require 'ido)
  43. (require 'advice)
  44. (require 'cl)
  45. ;; Only exists in emacs 24.4 and up; we use a workaround for earlier
  46. ;; versions.
  47. (require 'nadvice nil 'noerror)
  48. ;; Declare this ahead of time to quiet the compiler
  49. (defvar ido-ubiquitous-fallback-completing-read-function)
  50. ;;; Internal utility functions
  51. (defun ido-ubiquitous--as-string (sym-or-str)
  52. "Return name of symbol, return string as is."
  53. (if (symbolp sym-or-str)
  54. (symbol-name sym-or-str)
  55. sym-or-str))
  56. (defun ido-ubiquitous--as-symbol (sym-or-str)
  57. "Return name of symbol, return string as is."
  58. (if (symbolp sym-or-str)
  59. sym-or-str
  60. (intern sym-or-str)))
  61. ;;; Custom widget definitions
  62. ;; We need to define some custom widget types for use in the override
  63. ;; variables.
  64. (define-widget 'lazy-notag 'lazy
  65. "Like lazy widget, but does not display its tag, only its value."
  66. :format "%v")
  67. ;; Define matcher functions and widgets for match specifications
  68. (defvar ido-ubiquitous-match-spec-widget-types nil
  69. "List of widget names for match specs.")
  70. (defvar ido-ubiquitous-spec-matchers nil
  71. "Alist of functions for matching function specs against function names.")
  72. (loop for (widget-name widget-tag key field-type matcher) in
  73. '((exact-match "Exact match" exact string string=)
  74. (prefix-match "Prefix match" prefix string string-prefix-p)
  75. (regexp-match "Regexp match" regexp regexp string-match-p))
  76. do (define-widget (ido-ubiquitous--as-symbol widget-name) 'lazy-notag widget-tag
  77. :menu-tag widget-tag
  78. :type `(list :tag ,widget-tag :format "%v"
  79. (const :format ""
  80. :tag ,widget-tag
  81. ,key)
  82. (,field-type :tag ,widget-tag)))
  83. do (add-to-list 'ido-ubiquitous-match-spec-widget-types
  84. widget-name 'append)
  85. do (add-to-list 'ido-ubiquitous-spec-matchers
  86. (cons key matcher) 'append))
  87. (define-widget 'ido-ubiquitous-match-spec 'lazy-notag
  88. "Choice of exact, prefix, or regexp match."
  89. :type `(choice :tag "Match type"
  90. ,@ido-ubiquitous-match-spec-widget-types))
  91. (define-widget 'ido-ubiquitous-command-override-spec 'lazy-notag
  92. "Choice of override action plus match specification."
  93. :type '(cons :tag "Override rule"
  94. (choice :tag "For matching commands"
  95. (const :menu-tag "Disable"
  96. :tag "Disable ido-ubiquitous"
  97. disable)
  98. (const :menu-tag "Enable"
  99. :tag "Enable ido-ubiquitous in normal default mode"
  100. enable)
  101. (const :menu-tag "Enable old-style default"
  102. :tag "Enable ido-ubiquitous in old-style default mode"
  103. enable-old))
  104. ido-ubiquitous-match-spec))
  105. (define-widget 'ido-ubiquitous-function-override-spec 'lazy-notag
  106. "Choice of override action and function name. (Exact match only.)"
  107. :type '(list :tag "Override rule"
  108. (choice :tag "Do the following"
  109. (const :menu-tag "Disable"
  110. :tag "Disable ido-ubiquitous"
  111. disable)
  112. (const :menu-tag "Enable"
  113. :tag "Enable ido-ubiquitous in normal default mode"
  114. enable)
  115. (const :menu-tag "Enable old-style default"
  116. :tag "Enable ido-ubiquitous in old-style default mode"
  117. enable-old))
  118. (const :format "" exact)
  119. (string :tag "For function")))
  120. ;;; Custom Declarations
  121. (defgroup ido-ubiquitous nil
  122. "Use ido for (almost) all completion."
  123. :group 'ido)
  124. ;;;###autoload
  125. (define-obsolete-variable-alias 'ido-ubiquitous
  126. 'ido-ubiquitous-mode "0.8")
  127. ;;;###autoload
  128. (define-obsolete-function-alias 'ido-ubiquitous
  129. 'ido-ubiquitous-mode "0.8")
  130. ;;;###autoload
  131. (define-minor-mode ido-ubiquitous-mode
  132. "Use `ido-completing-read' instead of `completing-read' almost everywhere.
  133. This mode has no effect unles `ido-mode' is also enabled.
  134. If this mode causes problems for a function, you can customize
  135. when ido completion is or is not used by customizing
  136. `ido-ubiquitous-command-overrides' or
  137. `ido-ubiquitous-function-overrides'."
  138. nil
  139. :global t
  140. :group 'ido-ubiquitous
  141. ;; Handle warning about ido disabled
  142. (when ido-ubiquitous-mode
  143. (ido-ubiquitous-warn-about-ido-disabled))
  144. ;; Ensure emacs 23 code disabled (in case user upgraded in this session)
  145. (ignore-errors
  146. (ad-disable-advice 'completing-read 'around 'ido-ubiquitous-legacy)
  147. (ad-activate 'completing-read))
  148. ;; Actually enable/disable the mode
  149. (setq completing-read-function
  150. (if ido-ubiquitous-mode
  151. 'completing-read-ido
  152. (or ido-ubiquitous-fallback-completing-read-function
  153. 'completing-read-default))))
  154. (defcustom ido-ubiquitous-max-items 5000
  155. "Max collection size to use ido-ubiquitous on.
  156. If `ido-ubiquitous-mode' is active and `completing-read' is
  157. called on a COLLECTION with greater than this number of items in
  158. it, the fallback completion method will be used instead. To
  159. disable fallback based on collection size, set this to nil."
  160. :type '(choice (const :tag "No limit" nil)
  161. (integer
  162. :tag "Limit" :value 5000
  163. :validate
  164. (lambda (widget)
  165. (let ((v (widget-value widget)))
  166. (if (and (integerp v)
  167. (> v 0))
  168. nil
  169. (widget-put widget :error "This field should contain a positive integer")
  170. widget)))))
  171. :group 'ido-ubiquitous)
  172. (defcustom ido-ubiquitous-fallback-completing-read-function
  173. ;; Initialize to the current value of `completing-read-function',
  174. ;; unless that is already set to the ido completer, in which case
  175. ;; use `completing-read-default'.
  176. (if (eq completing-read-function 'completing-read-ido)
  177. 'completing-read-default
  178. completing-read-function)
  179. "Alternate completing-read function to use when ido is not wanted.
  180. This will be used for functions that are incompatibile with ido
  181. or if ido cannot handle the completion arguments.
  182. If you turn off ido-ubiquitous mode, `completing-read-function'
  183. will be set back to this."
  184. :type '(choice (const :tag "Standard emacs completion"
  185. completing-read-default)
  186. (function :tag "Other function"))
  187. :group 'ido-ubiquitous)
  188. (define-obsolete-variable-alias
  189. 'ido-ubiquitous-enable-compatibility-globally
  190. 'ido-ubiquitous-enable-old-style-default
  191. "2.0")
  192. (defcustom ido-ubiquitous-enable-old-style-default t
  193. "Allow ido to emulate a quirk of `completing-read'.
  194. From the `completing-read' docstring:
  195. > If the input is null, `completing-read' returns DEF, or the
  196. > first element of the list of default values, or an empty string
  197. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  198. If this variable is non-nil, then ido-ubiquitous will attempt to
  199. emulate this behavior. Specifically, if RET is pressed
  200. immediately upon entering completion, an empty string will be
  201. returned instead of the first element in the list. This behavior
  202. is only enabled when ido is being used as a substitute for
  203. `completing-read', and not when it is used directly.
  204. This odd behavior is required for compatibility with an old-style
  205. usage pattern whereby the default was requested by returning an
  206. empty string. In this mode, the caller receives the empty string
  207. and handles the default case manually, while `completing-read'
  208. never has any knowledge of the default. This is a problem for
  209. ido, which always returns the first element in the list when the
  210. input is empty. Without knowledge of the default, it cannot
  211. ensure that the default is first on the list, so returning the
  212. first item is not the correct behavior. Instead, it must return
  213. an empty string like `completing-read'.
  214. You can termporarily invert this behavior by prefixing \"RET\"
  215. with \"C-u\".
  216. If you want to enable old-style default selection selectively for
  217. specific commands or functions, set appropriate overrides in
  218. `ido-ubiquitous-command-overrides' or
  219. `ido-ubiquitous-function-overrides'."
  220. :type 'boolean
  221. :group 'ido-ubiquitous)
  222. (defconst ido-ubiquitous-default-command-overrides
  223. '(;; If you want ido for M-x, install smex
  224. (disable exact "execute-extended-command")
  225. ;; https://github.com/technomancy/ido-ubiquitous/issues/13#issuecomment-8033522
  226. (enable prefix "wl-")
  227. ;; https://github.com/technomancy/ido-ubiquitous/issues/7
  228. (enable-old prefix "Info-")
  229. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  230. (enable exact "webjump")
  231. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/28
  232. (enable regexp "\\`\\(find\\|load\\|locate\\)-library\\'")
  233. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/37
  234. ;; Org and Magit already support ido natively
  235. (disable prefix "org-")
  236. (disable prefix "magit-"))
  237. "Default value of `ido-ubiquitous-command-overrides'.
  238. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  239. (defconst ido-ubiquitous-default-function-overrides
  240. '((disable exact "read-file-name")
  241. (disable exact "read-file-name-internal")
  242. (disable exact "read-buffer")
  243. (disable exact "gnus-emacs-completing-read")
  244. (disable exact "gnus-iswitchb-completing-read")
  245. (disable exact "grep-read-files")
  246. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/36
  247. (enable exact "bookmark-completing-read")
  248. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  249. (enable-old exact "webjump-read-choice")
  250. (enable-old exact "webjump-read-url-choice")
  251. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/9
  252. (disable exact "isearchp-read-unicode-char")
  253. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/37
  254. (disable exact "org-completing-read")
  255. (disable exact "org-completing-read-no-i")
  256. (disable exact "org-iswitchb-completing-read")
  257. (disable exact "org-icompleting-read")
  258. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/38
  259. (enable exact "read-char-by-name")
  260. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/39
  261. (disable exact "Info-read-node-name"))
  262. "Default value of `ido-ubiquitous-function-overrides'.
  263. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  264. (defcustom ido-ubiquitous-command-overrides ido-ubiquitous-default-command-overrides
  265. "List of command override specifications for ido-ubiquitous
  266. Each override specification describes how ido-ubiquitous should
  267. behave one or many commands. A specification has the
  268. form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'. BEHAVIOR is one of the
  269. following:
  270. * `disable': ido-ubiquitous should not be used at all for the
  271. specified commands;
  272. * `enable': ido-ubiquitous may be used with the specified
  273. commands, without emulating the old-style default selection
  274. of `completing-read';
  275. * `enable-old': ido-ubiquitous may be used with the specified
  276. commands, and should emulate the old-style default selection
  277. of `completing-read'.
  278. MATCH-TYPE affects how MATCH-TEXT is interpreted, as follows:
  279. * `exact': the specification only affects the one command
  280. whose name is MATCH-TEXT;
  281. * `prefix': the specification affects any command whose name
  282. starts with MATCH-TEXT (This is useful for specifying a
  283. certain behavior for an entire package);
  284. * `regexp': the specification affects any command whose name
  285. matches MATCH-TEXT (with MATCH-TEXT being interpreted as a
  286. regular expression)
  287. MATCH-TEXT should be a string.
  288. Since this variable's has a somewhat complex structure, it is
  289. recommended that you set this variable through Customize.
  290. Note that this variable only affects *commands*, which are
  291. functions marked as interactive. See
  292. `ido-ubiquitous-function-overrides' for how to modify the
  293. behavior of ido-ubiquitous for arbitrary functions.
  294. If you need to add a new specification to this list, please also
  295. file a bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues"
  296. :type '(repeat ido-ubiquitous-command-override-spec)
  297. :group 'ido-ubiquitous)
  298. (defmacro ido-ubiquitous-with-override (override &rest body)
  299. "Eval BODY with specicified OVERRIDE in place.
  300. The OVERRIDE argument is evaluated normally, so if it is a
  301. literal symbol, it must be quoted.
  302. See `ido-ubiquitous-command-overrides' for valid override types."
  303. ;; Eval override
  304. `(let ((ido-ubiquitous-next-override ,override))
  305. ,@body))
  306. (put 'ido-ubiquitous-with-override 'lisp-indent-function
  307. (get 'prog1 'lisp-indent-function))
  308. (defun ido-ubiquitous-apply-function-override (func override)
  309. "Set the override property on FUNC to OVERRIDE and set up advice to apply the override."
  310. (setq func (ido-ubiquitous--as-symbol func)
  311. override (ido-ubiquitous--as-symbol override))
  312. (put func 'ido-ubiquitous-override override)
  313. (when override
  314. (let ((docstring
  315. (format "Override ido-ubiquitous behavior in %s if its `ido-ubiquitous-override' property is non-nil." func)))
  316. (eval
  317. `(defadvice ,func (around ido-ubiquitous-override activate)
  318. ,docstring
  319. (ido-ubiquitous-with-override
  320. (get ',func 'ido-ubiquitous-override)
  321. ad-do-it))))))
  322. (defun ido-ubiquitous-set-function-overrides (sym newval)
  323. "Custom setter function for `ido-ubiquitous-function-overrides'.
  324. In addition to setting the variable, this also sets up advice on
  325. each function to apply the appropriate override."
  326. ;; Unset all previous overrides
  327. (when (boundp sym)
  328. (let ((oldval (eval sym)))
  329. (loop for (_action _match-type func) in oldval
  330. do (ido-ubiquitous-apply-function-override func nil))))
  331. ;; Ensure that function names are strings, not symbols
  332. (setq newval
  333. (loop for (action match-type func) in newval
  334. collect (list action match-type
  335. (ido-ubiquitous--as-string func))))
  336. (set-default sym newval)
  337. ;; set new overrides
  338. (loop for (action _match-type func) in (eval sym)
  339. do (ido-ubiquitous-apply-function-override func action)))
  340. (defcustom ido-ubiquitous-function-overrides ido-ubiquitous-default-function-overrides
  341. "List of function override specifications for ido-ubiquitous
  342. Function override specifications have a similar structure to
  343. command override specifications (see
  344. `ido-ubiquitous-command-overrides'). A function override
  345. specification has the form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'.
  346. However, `MATCH-TYPE' may ONLY be `exact'; No other match type is
  347. supported.
  348. If you need to add a new specification to this list, please also file a
  349. bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues
  350. Setting this variable directly has no effect. You must set it
  351. through Customize."
  352. :type '(repeat ido-ubiquitous-function-override-spec)
  353. :set 'ido-ubiquitous-set-function-overrides
  354. :group 'ido-ubiquitous)
  355. (defcustom ido-ubiquitous-allow-on-functional-collection nil
  356. "Allow ido completion when COLLECTION is a function.
  357. The `completing-read' function allows its COLLECTION argument to
  358. be a function instead of a list of choices. Some such functions
  359. simply return a list of completions and are suitable for use with
  360. ido, but others implement more complex behavior and will result
  361. in incorrect behavior if used with ido. Since there is no way to
  362. tell the difference, this preference defaults to nil, which means
  363. that ido-ubiquitous will not work when COLLECTION is a function
  364. unless there is a specific override in effect. To disable this
  365. safeguard and guarantee breakage on some functions, you may set
  366. this to non-nil, but this is not recommended."
  367. :type 'boolean
  368. :group 'ido-ubiquitous)
  369. ;;; ido-ubiquitous core
  370. (defvar ido-ubiquitous-next-call-replaces-completing-read nil
  371. "If t, then the next call to `ido-completing-read' is by ido-ubiquitous.")
  372. (defvar ido-ubiquitous-this-call-replaces-completing-read nil
  373. "If t, then the current call to `ido-completing-read' is by ido-ubiquitous.")
  374. (defvar ido-ubiquitous-next-override nil
  375. "This holds the override to be applied on the next call to `completing-read'.")
  376. (defvar ido-ubiquitous-active-override nil
  377. "This holds the override being applied to the current call to `completing-read'.")
  378. (defun ido-ubiquitous-completing-read (&rest args)
  379. "Wrapper for `ido-completing-read' that enables ido-ubiquitous features."
  380. (let ((ido-ubiquitous-next-call-replaces-completing-read t))
  381. (apply 'ido-completing-read args)))
  382. (defadvice ido-completing-read (around detect-replacing-cr activate)
  383. "Enable workarounds if this call was done through ido-ubiquitous.
  384. This advice implements the logic required for
  385. `ido-completing-read' to handle a number of special cases that
  386. `completing-read' can handle. It only has an effect if
  387. `ido-completing-read' is called through
  388. `ido-ubiquitous-completing-read', so other packages that use
  389. `ido-completing-read', such as `smex', will not be affected."
  390. (let* ((ido-ubiquitous-this-call-replaces-completing-read ido-ubiquitous-next-call-replaces-completing-read)
  391. (ido-ubiquitous-next-call-replaces-completing-read nil)
  392. (error-during-setup nil))
  393. (when ido-ubiquitous-this-call-replaces-completing-read
  394. (condition-case nil
  395. (progn
  396. ;; ido doesn't natively handle DEF being a list. If DEF is
  397. ;; a list, prepend it to CHOICES and set DEF to just the
  398. ;; car of the default list.
  399. (when (and def (listp def))
  400. (setq choices
  401. (append def
  402. (nreverse (cl-set-difference choices def)))
  403. def (car def)))
  404. ;; Work around a bug in ido when both INITIAL-INPUT and
  405. ;; DEF are provided More info:
  406. ;; https://github.com/technomancy/ido-ubiquitous/issues/18
  407. (let ((initial (cond ((null initial-input) "")
  408. ((stringp initial-input) initial-input)
  409. ((consp initial-input) (car initial-input))
  410. (t initial-input))))
  411. (when (and def initial
  412. (stringp initial)
  413. (not (string= initial "")))
  414. ;; Both default and initial input were provided. So
  415. ;; keep the initial input and preprocess the choices
  416. ;; list to put the default at the head, then proceed
  417. ;; with default = nil.
  418. (setq choices (cons def (remove def choices))
  419. def nil))))
  420. (error
  421. (progn
  422. (warn "ido-ubiquitous: failed during setup. Falling back to standard completion")
  423. (setq error-during-setup t)))))
  424. ;; For ido-ubiquitous, only attempt ido completion if setup
  425. ;; completed without error
  426. (if (not error-during-setup)
  427. ad-do-it
  428. (setq ad-return-value
  429. (funcall
  430. ido-ubiquitous-fallback-completing-read-function
  431. prompt choices predicate require-match initial-input
  432. hist def inherit-input-method)))))
  433. (defun completing-read-ido (prompt collection &optional predicate
  434. require-match initial-input
  435. hist def inherit-input-method)
  436. "ido-based method for reading from the minibuffer with completion.
  437. See `completing-read' for the meaning of the arguments.
  438. This function is a wrapper for `ido-completing-read' designed to
  439. be used as the value of `completing-read-function'. Importantly,
  440. it detects edge cases that ido cannot handle and uses normal
  441. completion for them."
  442. (let* (;; Set the active override and clear the "next" one so it
  443. ;; doesn't apply to nested calls.
  444. (ido-ubiquitous-active-override ido-ubiquitous-next-override)
  445. (ido-ubiquitous-next-override nil)
  446. ;; Check if ido can handle this collection. If collection is
  447. ;; a function, require an override to be ok.
  448. (collection-ok
  449. (or ido-ubiquitous-allow-on-functional-collection
  450. (not (functionp collection))
  451. (memq ido-ubiquitous-active-override '(enable enable-old))))
  452. ;; Check for conditions that ido can't or shouldn't handle
  453. (ido-allowed
  454. (and ido-mode
  455. ido-ubiquitous-mode
  456. ;; Check for disable override
  457. (not (eq ido-ubiquitous-active-override 'disable))
  458. ;; Can't handle this arg
  459. (not inherit-input-method)
  460. ;; Can't handle this being set
  461. (not (bound-and-true-p completion-extra-properties))))
  462. ;; Pre-expand list of possible completions, but only if we
  463. ;; have a chance of using ido. This is executed after the
  464. ;; ido-allowed check to avoid unnecessary work if ido isn't
  465. ;; going to used.
  466. (_ignore ;; (Return value doesn't matter).
  467. (when (and ido-allowed collection-ok)
  468. (setq collection (all-completions "" collection predicate)
  469. ;; Don't need this any more
  470. predicate nil)))
  471. (colection-ok
  472. ;; Don't use ido if the collection is empty or too large.
  473. (and collection-ok
  474. collection
  475. (or (null ido-ubiquitous-max-items)
  476. (<= (length collection) ido-ubiquitous-max-items))))
  477. ;; Final check for everything
  478. (ido-allowed (and ido-allowed collection-ok))
  479. (comp-read-fun
  480. (if ido-allowed
  481. 'ido-ubiquitous-completing-read
  482. ido-ubiquitous-fallback-completing-read-function)))
  483. (funcall comp-read-fun
  484. prompt collection predicate
  485. require-match initial-input
  486. hist def inherit-input-method)))
  487. ;;; Old-style default support
  488. (defvar ido-ubiquitous-initial-item nil
  489. "The first item selected when ido starts.
  490. This is initialized to the first item in the list of completions
  491. when ido starts, and is cleared when any character is entered
  492. into the prompt or the list is cycled. If it is non-nil and still
  493. equal to the first item in the completion list when ido exits,
  494. then if `ido-ubiquitous-enable-old-style-default' is
  495. non-nil, ido returns an empty string instead of the first item on
  496. the list.")
  497. (defadvice ido-read-internal (before clear-initial-item activate)
  498. (setq ido-ubiquitous-initial-item nil))
  499. (defadvice ido-make-choice-list (after set-initial-item activate)
  500. (when (and ad-return-value (listp ad-return-value))
  501. (setq ido-ubiquitous-initial-item (car ad-return-value))))
  502. (defadvice ido-next-match (after clear-initial-item activate)
  503. (setq ido-ubiquitous-initial-item nil))
  504. (defadvice ido-prev-match (after clear-initial-item activate)
  505. (setq ido-ubiquitous-initial-item nil))
  506. (defadvice ido-exit-minibuffer (around compatibility activate)
  507. "Emulate a quirk of `completing-read'.
  508. > If the input is null, `completing-read' returns DEF, or the
  509. > first element of the list of default values, or an empty string
  510. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  511. See `ido-ubiquitous-enable-old-style-default', which
  512. controls whether this advice has any effect."
  513. (condition-case nil
  514. (let* ((enable-oldstyle
  515. (and
  516. ;; Completing a list, not a buffer or file
  517. (eq ido-cur-item 'list)
  518. ;; Only enable if we are replacing `completing-read'
  519. ido-ubiquitous-this-call-replaces-completing-read
  520. ;; Default is nil
  521. (null ido-default-item)
  522. ;; Input is empty
  523. (string= ido-text "")
  524. ;; Old-style default enabled
  525. (if ido-ubiquitous-active-override
  526. (eq ido-ubiquitous-active-override 'enable-old)
  527. ido-ubiquitous-enable-old-style-default)
  528. ;; First item on the list hasn't changed
  529. (string= (car ido-cur-list)
  530. ido-ubiquitous-initial-item)))
  531. ;; Prefix inverts oldstyle behavior
  532. (should-invert current-prefix-arg)
  533. (actually-enable-oldstyle
  534. (if should-invert (not enable-oldstyle) enable-oldstyle)))
  535. (if actually-enable-oldstyle
  536. (ido-select-text)
  537. ad-do-it))
  538. (error ad-do-it))
  539. (setq ido-ubiquitous-initial-item nil))
  540. ;;; Overrides
  541. (defun ido-ubiquitous-restore-default-overrides (&optional save)
  542. "Re-add the default overrides for ido-ubiquitous.
  543. This will ensure that the default overrides are all present and
  544. at the head of the list in `ido-ubiquitous-command-overrides' and
  545. `ido-ubiquitous-function-overrides'. User-added overrides will
  546. not be removed, but they may be masked if one of the default
  547. overrides affects the same functions.
  548. With a prefix arg, also save the above variables' new values for
  549. future sessions."
  550. (interactive "P")
  551. (let ((setter (if save
  552. 'customize-save-variable
  553. 'customize-set-variable)))
  554. (loop for (var def) in '((ido-ubiquitous-command-overrides
  555. ido-ubiquitous-default-command-overrides)
  556. (ido-ubiquitous-function-overrides
  557. ido-ubiquitous-default-function-overrides))
  558. do (let* ((curval (eval var))
  559. (defval (eval def))
  560. (newval (delete-dups (append defval curval))))
  561. (funcall setter var newval)))
  562. (message (if save
  563. "ido-ubiquitous: Restored default command and function overrides and saved for future sessions."
  564. "ido-ubiquitous: Restored default command and function overrides for current session only."))))
  565. (defun ido-ubiquitous-spec-match (spec symbol)
  566. "Returns t if SPEC matches SYMBOL (which should be a function name).
  567. See `ido-ubiquitous-command-overrides'."
  568. (when (and symbol (symbolp symbol))
  569. (destructuring-bind (type text) spec
  570. (let ((matcher (cdr (assoc type ido-ubiquitous-spec-matchers)))
  571. (text (ido-ubiquitous--as-string text))
  572. (symname (ido-ubiquitous--as-string symbol)))
  573. (when (null matcher)
  574. (error "ido-ubiquitous: Unknown match spec type \"%s\". See `ido-ubiquitous-spec-matchers' for valid types." type))
  575. (funcall matcher text symname)))))
  576. (defun ido-ubiquitous-get-command-override (cmd)
  577. "Return the override associated with the command CMD.
  578. If there is no override set for CMD in
  579. `ido-ubiquitous-command-overrides', return nil."
  580. (when (and cmd (symbolp cmd))
  581. (loop for (action . spec) in ido-ubiquitous-command-overrides
  582. when (memq action '(disable enable enable-old nil))
  583. when (ido-ubiquitous-spec-match spec cmd)
  584. return action
  585. finally return nil)))
  586. ;;; Workaround for https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/24
  587. ;; When `call-interactively' is advised, `called-interactively-p'
  588. ;; always returns nil. So we redefine it (and `interactive-p') to test
  589. ;; the correct condition.
  590. (defsubst ido-ubiquitous--looks-like-advised-orig (func)
  591. "Returns t if FUNC is a symbol starting with \"ad-Orig-\".
  592. Such symbols are used to store the original definitions of
  593. functions that have been advised by `defadvice' or similar."
  594. (and (symbolp func)
  595. (string-prefix-p "ad-Orig-" (symbol-name func))))
  596. (defsubst ido-ubiquitous--looks-like-call-interactively (func)
  597. "Returns t if FUNC looks like the function `call-interactively'.
  598. FUNC \"looks like\" `call-interactively' if it is the literal
  599. symbol `call-interactively', or the value of `(symbol-function
  600. 'call-interactively)', or a symbol whose `symbol-function' is the
  601. same as that of `call-interactively'.
  602. This function is used to determine whether a given function was
  603. \"called by\" `call-interactively' and therefore was called
  604. interactively."
  605. (when func
  606. (eq (symbol-function 'call-interactively)
  607. (if (symbolp func)
  608. (symbol-function func)
  609. func))))
  610. (defun ido-ubiquitous--backtrace-from (fun)
  611. "Return all backtrace frames, starting with the one for FUN.
  612. FUN may be a list of functions, in which case the first one found
  613. on the stack will be used."
  614. (let ((stack
  615. (loop for i upfrom 0
  616. for frame = (backtrace-frame i)
  617. while frame
  618. collect frame))
  619. (funcs (if (functionp fun)
  620. (list fun)
  621. fun)))
  622. (while (and stack
  623. (not (memq (cadar stack) funcs)))
  624. (setq stack (cdr stack)))
  625. stack))
  626. (defun ido-ubiquitous--clean-advice-from-backtrace (stack)
  627. "Takes a stack trace and cleans all evidence of advice.
  628. Specifically, for each call to a function starting with
  629. \"ad-Orig-\", that call and all prior calls up to but not
  630. including the advised function's original name are deleted from
  631. the stack."
  632. (let ((skipping-until nil))
  633. (loop for frame in stack
  634. for func = (cadr frame)
  635. ;; Check if we found the frame we we're skipping to
  636. if (and skipping-until
  637. (eq func skipping-until))
  638. do (setq skipping-until nil)
  639. ;; If we're looking at an the original form of an advised
  640. ;; function, skip until the real name of that function.
  641. if (and (not skipping-until)
  642. (ido-ubiquitous--looks-like-advised-orig func))
  643. do (setq skipping-until
  644. (intern
  645. (substring (symbol-name func)
  646. (eval-when-compile (length "ad-Orig-")))))
  647. unless skipping-until collect frame)))
  648. (defsubst ido-ubiquitous--interactive-internal ()
  649. "Eqivalent of the INTERACTIVE macro in the Emacs C source.
  650. This is an internal function that should never be called
  651. directly.
  652. See the C source for the logic behind this function."
  653. (and (not executing-kbd-macro)
  654. (not noninteractive)))
  655. (defun ido-ubiquitous--interactive-p-internal ()
  656. "Equivalent of C function \"interactive_p\".
  657. This is an internal function that should never be called
  658. directly.
  659. See the C source for the logic behind this function."
  660. (let ((stack
  661. ;; We clean advice from the backtrace. This ensures that we
  662. ;; get the right answer even if `call-interactively' has been
  663. ;; advised.
  664. (ido-ubiquitous--clean-advice-from-backtrace
  665. (cdr
  666. (ido-ubiquitous--backtrace-from
  667. '(called-interactively-p interactive-p))))))
  668. ;; See comments in the C function for the logic here.
  669. (while (and stack
  670. (or (eq (cadar stack) 'bytecode)
  671. (null (caar stack))))
  672. (setq stack (cdr stack)))
  673. ;; Top of stack is now the function that we want to know
  674. ;; about. Pop it, then check if the next function is
  675. ;; `call-interactively', using a more permissive test than the default.
  676. (ido-ubiquitous--looks-like-call-interactively (cadadr stack))))
  677. (defadvice call-interactively (around ido-ubiquitous activate)
  678. "Implements the behavior specified in `ido-ubiquitous-command-overrides'."
  679. (ido-ubiquitous-with-override
  680. (ido-ubiquitous-get-command-override (ad-get-arg 0))
  681. ad-do-it))
  682. ;; Work around `called-interactively-p' in Emacs 24.3 and earlier,
  683. ;; which always returns nil when `call-interactively' is advised.
  684. (when (not (and (featurep 'nadvice)
  685. (boundp 'called-interactively-p-functions)))
  686. (defadvice interactive-p (around ido-ubiquitous activate)
  687. "Return the correct result when `call-interactively' is advised.
  688. This advice completely overrides the original definition."
  689. (condition-case nil
  690. (setq ad-return-value
  691. (and (ido-ubiquitous--interactive-internal)
  692. (ido-ubiquitous--interactive-p-internal)))
  693. ;; In case of error in the advice, fall back to the default
  694. ;; implementation
  695. (error ad-do-it)))
  696. (defadvice called-interactively-p (around ido-ubiquitous activate)
  697. "Return the correct result when `call-interactively' is advised.
  698. This advice completely overrides the original definition."
  699. (condition-case nil
  700. (setq ad-return-value
  701. (and (or (ido-ubiquitous--interactive-internal)
  702. (not (eq kind 'interactive)))
  703. (ido-ubiquitous--interactive-p-internal)))
  704. ;; In case of error in the advice, fall back to the default
  705. ;; implementation
  706. (error ad-do-it))))
  707. ;;; Other
  708. (defun ido-ubiquitous-warn-about-ido-disabled ()
  709. "Warn if ido-ubiquitous is enabled without ido.
  710. Don't warn if emacs is still initializing, since ido-ubiquitous
  711. could be enabled first during init."
  712. (when (and ido-ubiquitous-mode
  713. after-init-time
  714. (not (bound-and-true-p ido-mode)))
  715. (warn "ido-ubiquitous-mode enabled without ido mode. ido-ubiquitous requires ido mode to be enabled.")))
  716. (defun ido-ubiquitous-initialize ()
  717. "Do initial setup for ido-ubiquitous.
  718. This only needs to be called once when the file is first loaded."
  719. ;; Clean up old versions of ido-ubiquitous that defined advice on
  720. ;; `completing-read' instead of modifying
  721. ;; `completing-read-function'.
  722. (when (ad-find-advice 'completing-read 'around 'ido-ubiquitous)
  723. (ad-remove-advice 'completing-read 'around 'ido-ubiquitous)
  724. (ad-activate 'completing-read))
  725. ;; Make sure the mode is turned on/off as specified by the value of
  726. ;; the mode variable
  727. (ido-ubiquitous-mode (if ido-ubiquitous-mode 1 0)))
  728. (ido-ubiquitous-initialize)
  729. (provide 'ido-ubiquitous)
  730. ;;; ido-ubiquitous.el ends here