ido-ubiquitous.el 31 KB

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