ido-ubiquitous.el 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792
  1. ;;; ido-ubiquitous.el --- Use ido (nearly) everywhere.
  2. ;; Author: Ryan C. Thompson
  3. ;; URL: https://github.com/DarwinAwardWinner/ido-ubiquitous
  4. ;; Version: 2.1.2
  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.1.2"
  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. (defcustom ido-ubiquitous-fallback-completing-read-function
  148. ;; Initialize to the current value of `completing-read-function',
  149. ;; unless that is already set to the ido completer, in which case
  150. ;; use `completing-read-default'.
  151. (if (eq completing-read-function 'completing-read-ido)
  152. 'completing-read-default
  153. completing-read-function)
  154. "Alternate completing-read function to use when ido is not wanted.
  155. This will be used for functions that are incompatibile with ido
  156. or if ido cannot handle the completion arguments.
  157. If you turn off ido-ubiquitous mode, `completing-read-function'
  158. will be set back to this."
  159. :type '(choice (const :tag "Standard emacs completion"
  160. completing-read-default)
  161. (function :tag "Other function"))
  162. :group 'ido-ubiquitous)
  163. (define-obsolete-variable-alias
  164. 'ido-ubiquitous-enable-compatibility-globally
  165. 'ido-ubiquitous-enable-old-style-default
  166. "2.0")
  167. (defcustom ido-ubiquitous-enable-old-style-default t
  168. "Allow ido to emulate a quirk of `completing-read'.
  169. From the `completing-read' docstring:
  170. > If the input is null, `completing-read' returns DEF, or the
  171. > first element of the list of default values, or an empty string
  172. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  173. If this variable is non-nil, then ido-ubiquitous will attempt to
  174. emulate this behavior. Specifically, if RET is pressed
  175. immediately upon entering completion, an empty string will be
  176. returned instead of the first element in the list. This behavior
  177. is only enabled when ido is being used as a substitute for
  178. `completing-read', and not when it is used directly.
  179. This odd behavior is required for compatibility with an old-style
  180. usage pattern whereby the default was requested by returning an
  181. empty string. In this mode, the caller receives the empty string
  182. and handles the default case manually, while `completing-read'
  183. never has any knowledge of the default. This is a problem for
  184. ido, which always returns the first element in the list when the
  185. input is empty. Without knowledge of the default, it cannot
  186. ensure that the default is first on the list, so returning the
  187. first item is not the correct behavior. Instead, it must return
  188. an empty string like `completing-read'.
  189. You can termporarily invert this behavior by prefixing \"RET\"
  190. with \"C-u\".
  191. If you want to enable old-style default selection selectively for
  192. specific commands or functions, set appropriate overrides in
  193. `ido-ubiquitous-command-overrides' or
  194. `ido-ubiquitous-function-overrides'."
  195. :type 'boolean
  196. :group 'ido-ubiquitous)
  197. (defconst ido-ubiquitous-default-command-overrides
  198. '(;; If you want ido for M-x, install smex
  199. (disable exact "execute-extended-command")
  200. ;; https://github.com/technomancy/ido-ubiquitous/issues/13#issuecomment-8033522
  201. (enable prefix "wl-")
  202. ;; https://github.com/technomancy/ido-ubiquitous/issues/7
  203. (enable-old prefix "Info-")
  204. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  205. (enable exact "webjump"))
  206. "Default value of `ido-ubiquitous-command-overrides'.
  207. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  208. (defconst ido-ubiquitous-default-function-overrides
  209. '((disable exact "read-file-name")
  210. (disable exact "read-file-name-internal")
  211. (disable exact "read-buffer")
  212. (disable exact "gnus-emacs-completing-read")
  213. (disable exact "gnus-iswitchb-completing-read")
  214. (disable exact "man")
  215. ;; https://github.com/technomancy/ido-ubiquitous/issues/3
  216. (disable exact "grep-read-files")
  217. ;; https://github.com/technomancy/ido-ubiquitous/issues/9
  218. (enable exact "bookmark-completing-read")
  219. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  220. (enable-old exact "webjump-read-choice")
  221. (enable-old exact "webjump-read-url-choice")
  222. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/9
  223. (disable exact "isearchp-read-unicode-char"))
  224. "Default value of `ido-ubiquitous-function-overrides'.
  225. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  226. (defcustom ido-ubiquitous-command-overrides ido-ubiquitous-default-command-overrides
  227. "List of command override specifications for ido-ubiquitous
  228. Each override specification describes how ido-ubiquitous should
  229. behave one or many commands. A specification has the
  230. form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'. BEHAVIOR is one of the
  231. following:
  232. * `disable': ido-ubiquitous should not be used at all for the
  233. specified commands;
  234. * `enable': ido-ubiquitous may be used with the specified
  235. commands, without emulating the old-style default selection
  236. of `completing-read';
  237. * `enable-old': ido-ubiquitous may be used with the specified
  238. commands, and should emulate the old-style default selection
  239. of `completing-read'.
  240. MATCH-TYPE affects how MATCH-TEXT is interpreted, as follows:
  241. * `exact': the specification only affects the one command
  242. whose name is MATCH-TEXT;
  243. * `prefix': the specification affects any command whose name
  244. starts with MATCH-TEXT (This is useful for specifying a
  245. certain behavior for an entire package);
  246. * `regexp': the specification affects any command whose name
  247. matches MATCH-TEXT (with MATCH-TEXT being interpreted as a
  248. regular expression)
  249. MATCH-TEXT should be a string.
  250. Since this variable's has a somewhat complex structure, it is
  251. recommended that you set this variable through Customize.
  252. Note that this variable only affects *commands*, which are
  253. functions marked as interactive. See
  254. `ido-ubiquitous-function-overrides' for how to modify the
  255. behavior of ido-ubiquitous for arbitrary functions.
  256. If you need to add a new specification to this list, please also
  257. file a bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues"
  258. :type '(repeat ido-ubiquitous-command-override-spec)
  259. :group 'ido-ubiquitous)
  260. (defmacro ido-ubiquitous-with-override (override &rest body)
  261. "Eval BODY with specicified OVERRIDE in place.
  262. The OVERRIDE argument is evaluated normally, so if it is a
  263. literal symbol, it must be quoted.
  264. See `ido-ubiquitous-command-overrides' for valid override types."
  265. ;; Eval override
  266. (setq override (ignore-errors (eval override)))
  267. `(let ((ido-ubiquitous-next-override ',override))
  268. ,@body))
  269. (put 'ido-ubiquitous-with-override 'lisp-indent-function
  270. (get 'prog1 'lisp-indent-function))
  271. (defun ido-ubiquitous-apply-function-override (func override)
  272. "Set the override property on FUNC to OVERRIDE and set up advice to apply the override."
  273. (setq func (ido-ubiquitous--as-symbol func)
  274. override (ido-ubiquitous--as-symbol override))
  275. (put func 'ido-ubiquitous-override override)
  276. (when override
  277. (let ((docstring
  278. (format "Override ido-ubiquitous behavior in %s if its `ido-ubiquitous-override' property is non-nil." func)))
  279. (eval
  280. `(defadvice ,func (around ido-ubiquitous-override activate)
  281. ,docstring
  282. (ido-ubiquitous-with-override
  283. (get ',func 'ido-ubiquitous-override)
  284. ad-do-it))))))
  285. (defun ido-ubiquitous-set-function-overrides (sym newval)
  286. "Custom setter function for `ido-ubiquitous-function-overrides'.
  287. In addition to setting the variable, this also sets up advice on
  288. each function to apply the appropriate override."
  289. ;; Unset all previous overrides
  290. (when (boundp sym)
  291. (let ((oldval (eval sym)))
  292. (loop for (action match-type func) in oldval
  293. do (ido-ubiquitous-apply-function-override func nil))))
  294. ;; Ensure that function names are strings, not symbols
  295. (setq newval
  296. (loop for (action match-type func) in newval
  297. collect (list action match-type
  298. (ido-ubiquitous--as-string func))))
  299. (set-default sym newval)
  300. ;; set new overrides
  301. (loop for (action match-type func) in (eval sym)
  302. do (ido-ubiquitous-apply-function-override func action)))
  303. (defcustom ido-ubiquitous-function-overrides ido-ubiquitous-default-function-overrides
  304. "List of function override specifications for ido-ubiquitous
  305. Function override specifications have a similar structure to
  306. command override specifications (see
  307. `ido-ubiquitous-command-overrides'). A function override
  308. specification has the form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'.
  309. However, `MATCH-TYPE' may ONLY be `exact'; No other match type is
  310. supported.
  311. If you need to add a new specification to this list, please also file a
  312. bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues
  313. Setting this variable directly has no effect. You must set it
  314. through Customize."
  315. :type '(repeat ido-ubiquitous-function-override-spec)
  316. :set 'ido-ubiquitous-set-function-overrides
  317. :group 'ido-ubiquitous)
  318. ;;; ido-ubiquitous core
  319. (defvar ido-ubiquitous-next-call-replaces-completing-read nil
  320. "If t, then the next call to `ido-completing-read' is by ido-ubiquitous.")
  321. (defvar ido-ubiquitous-this-call-replaces-completing-read nil
  322. "If t, then the current call to `ido-completing-read' is by ido-ubiquitous.")
  323. (defvar ido-ubiquitous-next-override nil
  324. "This holds the override to be applied on the next call to `completing-read'.")
  325. (defvar ido-ubiquitous-active-override nil
  326. "This holds the override being applied to the current call to `completing-read'.")
  327. (defun ido-ubiquitous-completing-read (&rest args)
  328. "Wrapper for `ido-completing-read' that enables ido-ubiquitous features."
  329. (let ((ido-ubiquitous-next-call-replaces-completing-read t))
  330. (apply 'ido-completing-read args)))
  331. (defadvice ido-completing-read (around detect-replacing-cr activate)
  332. "Enable workarounds if this call was done through ido-ubiquitous.
  333. This advice implements the logic required for
  334. `ido-completing-read' to handle a number of special cases that
  335. `completing-read' can handle. It only has an effect if
  336. `ido-completing-read' is called through
  337. `ido-ubiquitous-completing-read', so other packages that use
  338. `ido-completing-read', such as `smex', will not be affected."
  339. (let* ((ido-ubiquitous-this-call-replaces-completing-read ido-ubiquitous-next-call-replaces-completing-read)
  340. (ido-ubiquitous-next-call-replaces-completing-read nil)
  341. (error-during-setup nil))
  342. (when ido-ubiquitous-this-call-replaces-completing-read
  343. (condition-case nil
  344. (progn
  345. ;; ido doesn't natively handle DEF being a list. If DEF is
  346. ;; a list, prepend it to CHOICES and set DEF to just the
  347. ;; car of the default list.
  348. (when (and def (listp def))
  349. (setq choices (delete-dups (append def choices))
  350. def (car def)))
  351. ;; Work around a bug in ido when both INITIAL-INPUT and
  352. ;; DEF are provided More info:
  353. ;; https://github.com/technomancy/ido-ubiquitous/issues/18
  354. (let ((initial (cond ((null initial-input) "")
  355. ((stringp initial-input) initial-input)
  356. ((consp initial-input) (car initial-input))
  357. (t initial-input)))
  358. (deflist (if (listp def)
  359. def
  360. (list def))))
  361. (when (and deflist initial
  362. (stringp initial)
  363. (not (string= initial "")))
  364. ;; Both default and initial input were provided. So
  365. ;; keep the initial input and preprocess the choices
  366. ;; list to put the default at the head, then proceed
  367. ;; with default = nil.
  368. (setq choices (delete-dups (append deflist choices))
  369. def nil))))
  370. (error
  371. (progn
  372. (warn "ido-ubiquitous: failed during setup. Falling back to standard completion")
  373. (setq error-during-setup t)))))
  374. ;; For ido-ubiquitous, only attempt ido completion if setup completed without error
  375. (if (not error-during-setup)
  376. ad-do-it
  377. (setq ad-return-value
  378. (funcall
  379. ido-ubiquitous-fallback-completing-read-function
  380. prompt choices predicate require-match initial-input
  381. hist def inherit-input-method)))))
  382. (defun completing-read-ido (prompt collection &optional predicate
  383. require-match initial-input
  384. hist def inherit-input-method)
  385. "ido-based method for reading from the minibuffer with completion.
  386. See `completing-read' for the meaning of the arguments.
  387. This function is a wrapper for `ido-completing-read' designed to
  388. be used as the value of `completing-read-function'. Importantly,
  389. it detects edge cases that ido cannot handle and uses normal
  390. completion for them."
  391. ;; Pre-expand list of possible completions (but we can't handle a
  392. ;; collection that is a function)
  393. (unless (functionp collection)
  394. (setq collection (all-completions "" collection predicate)
  395. ;; Don't need this any more
  396. predicate nil))
  397. (let* (;; Set the active override and clear the "next" one so it
  398. ;; doesn't apply to nested calls.
  399. (ido-ubiquitous-active-override ido-ubiquitous-next-override)
  400. (ido-ubiquitous-next-override nil)
  401. ;; Check for conditions that ido can't or shouldn't handle
  402. (ido-allowed
  403. (and ido-mode
  404. ido-ubiquitous-mode
  405. ;; Don't use ido if there are no completions, or if the
  406. ;; collection is a function.
  407. (and (not (functionp collection))
  408. collection)
  409. ;; Check for disable override
  410. (not (eq ido-ubiquitous-active-override 'disable))
  411. ;; Can't handle this arg
  412. (not inherit-input-method)
  413. ;; Can't handle this being set
  414. (not (bound-and-true-p completion-extra-properties))))
  415. (comp-read-fun
  416. (if ido-allowed
  417. 'ido-ubiquitous-completing-read
  418. ido-ubiquitous-fallback-completing-read-function)))
  419. (funcall comp-read-fun
  420. prompt collection predicate
  421. require-match initial-input
  422. hist def inherit-input-method)))
  423. ;;; Old-style default support
  424. (defvar ido-ubiquitous-initial-item nil
  425. "The first item selected when ido starts.
  426. This is initialized to the first item in the list of completions
  427. when ido starts, and is cleared when any character is entered
  428. into the prompt or the list is cycled. If it is non-nil and still
  429. equal to the first item in the completion list when ido exits,
  430. then if `ido-ubiquitous-enable-old-style-default' is
  431. non-nil, ido returns an empty string instead of the first item on
  432. the list.")
  433. (defadvice ido-read-internal (before clear-initial-item activate)
  434. (setq ido-ubiquitous-initial-item nil))
  435. (defadvice ido-make-choice-list (after set-initial-item activate)
  436. (when (and ad-return-value (listp ad-return-value))
  437. (setq ido-ubiquitous-initial-item (car ad-return-value))))
  438. (defadvice ido-next-match (after clear-initial-item activate)
  439. (setq ido-ubiquitous-initial-item nil))
  440. (defadvice ido-prev-match (after clear-initial-item activate)
  441. (setq ido-ubiquitous-initial-item nil))
  442. (defadvice ido-exit-minibuffer (around compatibility activate)
  443. "Emulate a quirk of `completing-read'.
  444. > If the input is null, `completing-read' returns DEF, or the
  445. > first element of the list of default values, or an empty string
  446. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  447. See `ido-ubiquitous-enable-old-style-default', which
  448. controls whether this advice has any effect."
  449. (condition-case nil
  450. (let* ((enable-oldstyle
  451. (and
  452. ;; Completing a list, not a buffer or file
  453. (eq ido-cur-item 'list)
  454. ;; Only enable if we are replacing `completing-read'
  455. ido-ubiquitous-this-call-replaces-completing-read
  456. ;; Default is nil
  457. (null ido-default-item)
  458. ;; Input is empty
  459. (string= ido-text "")
  460. ;; Old-style default enabled
  461. (if ido-ubiquitous-active-override
  462. (eq ido-ubiquitous-active-override 'enable-old)
  463. ido-ubiquitous-enable-old-style-default)
  464. ;; First item on the list hasn't changed
  465. (string= (car ido-cur-list)
  466. ido-ubiquitous-initial-item)))
  467. ;; Prefix inverts oldstyle behavior
  468. (should-invert current-prefix-arg)
  469. (actually-enable-oldstyle
  470. (if should-invert (not enable-oldstyle) enable-oldstyle)))
  471. (if actually-enable-oldstyle
  472. (ido-select-text)
  473. ad-do-it))
  474. (error ad-do-it))
  475. (setq ido-ubiquitous-initial-item nil))
  476. ;;; Overrides
  477. (defun ido-ubiquitous-restore-default-overrides (&optional save)
  478. "Re-add the default overrides for ido-ubiquitous.
  479. This will ensure that the default overrides are all present and
  480. at the head of the list in `ido-ubiquitous-command-overrides' and
  481. `ido-ubiquitous-function-overrides'. User-added overrides will
  482. not be removed, but they may be masked if one of the default
  483. overrides affects the same functions.
  484. With a prefix arg, also save the above variables' new values for
  485. future sessions."
  486. (interactive "P")
  487. (let ((setter (if save
  488. 'customize-save-variable
  489. 'customize-set-variable)))
  490. (loop for (var def) in '((ido-ubiquitous-command-overrides
  491. ido-ubiquitous-default-command-overrides)
  492. (ido-ubiquitous-function-overrides
  493. ido-ubiquitous-default-function-overrides))
  494. do (let* ((curval (eval var))
  495. (defval (eval def))
  496. (newval (delete-dups (append defval curval))))
  497. (funcall setter var newval)))
  498. (message (if save
  499. "ido-ubiquitous: Restored default command and function overrides and saved for future sessions."
  500. "ido-ubiquitous: Restored default command and function overrides for current session only."))))
  501. (defun ido-ubiquitous-spec-match (spec symbol)
  502. "Returns t if SPEC matches SYMBOL (which should be a function name).
  503. See `ido-ubiquitous-command-overrides'."
  504. (when (and symbol (symbolp symbol))
  505. (destructuring-bind (type text) spec
  506. (let ((matcher (cdr (assoc type ido-ubiquitous-spec-matchers)))
  507. (text (ido-ubiquitous--as-string text))
  508. (symname (ido-ubiquitous--as-string symbol)))
  509. (when (null matcher)
  510. (error "ido-ubiquitous: Unknown match spec type \"%s\". See `ido-ubiquitous-spec-matchers' for valid types." type))
  511. (funcall matcher text symname)))))
  512. (defun ido-ubiquitous-get-command-override (cmd)
  513. "Return the override associated with the command CMD.
  514. If there is no override set for CMD in
  515. `ido-ubiquitous-command-overrides', return nil."
  516. (when (and cmd (symbolp cmd))
  517. (loop for (action . spec) in ido-ubiquitous-command-overrides
  518. when (memq action '(disable enable enable-old nil))
  519. when (ido-ubiquitous-spec-match spec cmd)
  520. return action
  521. finally return nil)))
  522. ;;; Workaround for https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/24
  523. ;; When `call-interactively' is advised, `called-interactively-p'
  524. ;; always returns nil. So we redefine it (and `interactive-p') to test
  525. ;; the correct condition.
  526. (defsubst ido-ubiquitous--looks-like-advised-orig (func)
  527. "Returns t if FUNC is a symbol starting with \"ad-Orig-\".
  528. Such symbols are used to store the original definitions of
  529. functions that have been advised by `defadvice' or similar."
  530. (and (symbolp func)
  531. (string-prefix-p "ad-Orig-" (symbol-name func))))
  532. (defsubst ido-ubiquitous--looks-like-call-interactively (func)
  533. "Returns t if FUNC looks like the function `call-interactively'.
  534. FUNC \"looks like\" `call-interactively' if it is the literal
  535. symbol `call-interactively', or the value of `(symbol-function
  536. 'call-interactively)', or a symbol whose `symbol-function' is the
  537. same as that of `call-interactively'.
  538. This function is used to determine whether a given function was
  539. \"called by\" `call-interactively' and therefore was called
  540. interactively."
  541. (when func
  542. (eq (symbol-function 'call-interactively)
  543. (if (symbolp func)
  544. (symbol-function func)
  545. func))))
  546. (defun ido-ubiquitous--backtrace-from (fun)
  547. "Return all backtrace frames, starting with the one for FUN.
  548. FUN may be a list of functions, in which case the first one found
  549. on the stack will be used."
  550. (let ((stack
  551. (loop for i upfrom 0
  552. for frame = (backtrace-frame i)
  553. while frame
  554. collect frame))
  555. (funcs (if (functionp fun)
  556. (list fun)
  557. fun)))
  558. (while (and stack
  559. (not (memq (cadar stack) funcs)))
  560. (setq stack (cdr stack)))
  561. stack))
  562. (defun ido-ubiquitous--clean-advice-from-backtrace (stack)
  563. "Takes a stack trace and cleans all evidence of advice.
  564. Specifically, for each call to a function starting with
  565. \"ad-Orig-\", that call and all prior calls up to but not
  566. including the advised function's original name are deleted from
  567. the stack."
  568. (let ((skipping-until nil))
  569. (loop for frame in stack
  570. for func = (cadr frame)
  571. ;; Check if we found the frame we we're skipping to
  572. if (and skipping-until
  573. (eq func skipping-until))
  574. do (setq skipping-until nil)
  575. ;; If we're looking at an the original form of an advised
  576. ;; function, skip until the real name of that function.
  577. if (and (not skipping-until)
  578. (ido-ubiquitous--looks-like-advised-orig func))
  579. do (setq skipping-until
  580. (intern
  581. (substring (symbol-name func)
  582. (eval-when-compile (length "ad-Orig-")))))
  583. unless skipping-until collect frame)))
  584. (defsubst ido-ubiquitous--interactive-internal ()
  585. "Eqivalent of the INTERACTIVE macro in the Emacs C source.
  586. This is an internal function that should never be called
  587. directly.
  588. See the C source for the logic behind this function."
  589. (and (not executing-kbd-macro)
  590. (not noninteractive)))
  591. (defun ido-ubiquitous--interactive-p-internal ()
  592. "Equivalent of C function \"interactive_p\".
  593. This is an internal function that should never be called
  594. directly.
  595. See the C source for the logic behind this function."
  596. (let ((stack
  597. ;; We clean advice from the backtrace. This ensures that we
  598. ;; get the right answer even if `call-interactively' has been
  599. ;; advised.
  600. (ido-ubiquitous--clean-advice-from-backtrace
  601. (cdr
  602. (ido-ubiquitous--backtrace-from
  603. '(called-interactively-p interactive-p))))))
  604. ;; See comments in the C function for the logic here.
  605. (while (and stack
  606. (or (eq (cadar stack) 'bytecode)
  607. (null (caar stack))))
  608. (setq stack (cdr stack)))
  609. ;; Top of stack is now the function that we want to know
  610. ;; about. Pop it, then check if the next function is
  611. ;; `call-interactively', using a more permissive test than the default.
  612. (ido-ubiquitous--looks-like-call-interactively (cadadr stack))))
  613. (if (boundp 'called-interactively-p-functions)
  614. ;; Emacs trunk, in which called-interactively-p logic has
  615. ;; changed, so we can't work around the "advice on
  616. ;; call-interactively" bug. Define advice instead on
  617. ;; `command-execute', which will not work for key bindings, but
  618. ;; will work for many other things.
  619. (defadvice command-execute (around ido-ubiquitous activate)
  620. "Implements the behavior specified in `ido-ubiquitous-command-overrides'.
  621. Does not work for keybindings or anything else that skips `command-execute'."
  622. (ido-ubiquitous-with-override
  623. (ido-ubiquitous-get-command-override
  624. ;; Ugly hack because Emacs byte compiler doesn't know that CMD
  625. ;; is defined for some reason
  626. (bound-and-true-p cmd))
  627. ad-do-it))
  628. ;; Emacs release 24.3.1: Old called-interactively-p logic & advice
  629. ;; system, which we know how to manipulate.
  630. (defadvice call-interactively (around ido-ubiquitous activate)
  631. "Implements the behavior specified in `ido-ubiquitous-command-overrides'."
  632. (ido-ubiquitous-with-override
  633. (ido-ubiquitous-get-command-override (ad-get-arg 0))
  634. ad-do-it))
  635. (defadvice interactive-p (around ido-ubiquitous activate)
  636. "Return the correct result when `call-interactively' is advised."
  637. (condition-case nil
  638. (setq ad-return-value
  639. (and (ido-ubiquitous--interactive-internal)
  640. (ido-ubiquitous--interactive-p-internal)))
  641. ;; In case of error in the advice, fall back to the default
  642. ;; implementation
  643. ad-do-it))
  644. (defadvice called-interactively-p (around ido-ubiquitous activate)
  645. "Return the correct result when `call-interactively' is advised."
  646. (condition-case nil
  647. (setq ad-return-value
  648. (and (or (ido-ubiquitous--interactive-internal)
  649. (not (eq kind 'interactive)))
  650. (ido-ubiquitous--interactive-p-internal)))
  651. ;; In case of error in the advice, fall back to the default
  652. ;; implementation
  653. ad-do-it)))
  654. ;;; Other
  655. (defun ido-ubiquitous-warn-about-ido-disabled ()
  656. "Warn if ido-ubiquitous is enabled without ido.
  657. Don't warn if emacs is still initializing, since ido-ubiquitous
  658. could be enabled first during init."
  659. (when (and ido-ubiquitous-mode
  660. after-init-time
  661. (not (bound-and-true-p ido-mode)))
  662. (warn "ido-ubiquitous-mode enabled without ido mode. ido-ubiquitous requires ido mode to be enabled.")))
  663. (defun ido-ubiquitous-initialize ()
  664. "Do initial setup for ido-ubiquitous.
  665. This only needs to be called once when the file is first loaded."
  666. ;; Clean up old versions of ido-ubiquitous that defined advice on
  667. ;; `completing-read' instead of modifying
  668. ;; `completing-read-function'.
  669. (when (ad-find-advice 'completing-read 'around 'ido-ubiquitous)
  670. (ad-remove-advice 'completing-read 'around 'ido-ubiquitous)
  671. (ad-activate 'completing-read))
  672. ;; Make sure the mode is turned on/off as specified by the value of
  673. ;; the mode variable
  674. (ido-ubiquitous-mode (if ido-ubiquitous-mode 1 0)))
  675. (ido-ubiquitous-initialize)
  676. (provide 'ido-ubiquitous) ;;; ido-ubiquitous.el ends here