ido-ubiquitous.el 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230
  1. ;;; ido-ubiquitous.el --- Use ido (nearly) everywhere. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2011-2015 Ryan C. Thompson
  3. ;; Author: Ryan C. Thompson
  4. ;; URL: https://github.com/DarwinAwardWinner/ido-ubiquitous
  5. ;; Version: 3.16
  6. ;; Created: 2011-09-01
  7. ;; Keywords: convenience, completion, ido
  8. ;; EmacsWiki: InteractivelyDoThings
  9. ;; Package-Requires: ((emacs "24.1") (ido-completing-read+ "3.16") (cl-lib "0.5"))
  10. ;; Filename: ido-ubiquitous.el
  11. ;; This file is NOT part of GNU Emacs.
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. ;;
  14. ;;; Commentary:
  15. ;; If you use the excellent `ido-mode' for efficient completion of
  16. ;; file names and buffers, you might wonder if you can get ido-style
  17. ;; completion everywhere else too. Well, that's what this package
  18. ;; does! ido-ubiquitous is here to enable ido-style completion for
  19. ;; (almost) every function that uses the standard completion function
  20. ;; `completing-read'.
  21. ;; To use this package, call `ido-ubiquitous-mode' to enable the mode,
  22. ;; or use `M-x customize-variable ido-ubiquitous-mode' it to enable it
  23. ;; permanently. Once the mode is enabled, most functions that use
  24. ;; `completing-read' will now have ido completion. If you decide in
  25. ;; the middle of a command that you would rather not use ido, just C-f
  26. ;; or C-b at the end/beginning of the input to fall back to non-ido
  27. ;; completion (this is the same shortcut as when using ido for buffers
  28. ;; or files).
  29. ;; Note that `completing-read' has some quirks and complex behavior
  30. ;; that ido cannot emulate. Ido-ubiquitous attempts to detect some of
  31. ;; these quirks and avoid using ido when it sees them. So some
  32. ;; functions will not have ido completion even when this mode is
  33. ;; enabled. Some other functions have ido disabled in them because
  34. ;; their packages already provide support for ido via other means (for
  35. ;; example, magit). See `M-x customize-group ido-ubiquitous' and read
  36. ;; about the override variables for more information.
  37. ;; ido-ubiquitous version 3.0 is a major update, including a split
  38. ;; into two packages, and some of the configuration options have
  39. ;; changed in non-backwards-compatible ways. If you have customized
  40. ;; ido-ubiquitous, be sure to check out `M-x customize-group
  41. ;; ido-ubiquitous' and `M-x customize-group ido-completing-read+'
  42. ;; after updating to 3.0 and make sure the new settings are to your
  43. ;; liking.
  44. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45. ;;
  46. ;; This program is free software: you can redistribute it and/or modify
  47. ;; it under the terms of the GNU General Public License as published by
  48. ;; the Free Software Foundation, either version 3 of the License, or (at
  49. ;; your option) any later version.
  50. ;;
  51. ;; This program is distributed in the hope that it will be useful, but
  52. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  53. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  54. ;; General Public License for more details.
  55. ;;
  56. ;; You should have received a copy of the GNU General Public License
  57. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  58. ;;
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60. ;;
  61. ;;; Code:
  62. (defconst ido-ubiquitous-version "3.16"
  63. "Currently running version of ido-ubiquitous.
  64. Note that when you update ido-ubiquitous, this variable may not
  65. be updated until you restart Emacs.")
  66. (eval-when-compile
  67. (when (or (not (boundp 'completing-read-function))
  68. (< emacs-major-version 24))
  69. (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 (or upgrade Emacs).")))
  70. (require 'ido)
  71. (require 'advice)
  72. (require 'cl-lib)
  73. (require 'cus-edit)
  74. (require 'ido-completing-read+)
  75. ;; Only exists in emacs 24.4 and up; we don't use this library
  76. ;; directly, but we load it here so we can test if it's available,
  77. ;; because if it isn't we need enable a workaround.
  78. (require 'nadvice nil 'noerror)
  79. ;;; Debug messages
  80. ;;;###autoload
  81. (define-minor-mode ido-ubiquitous-debug-mode
  82. "If non-nil, ido-ubiquitous will print debug info.
  83. Debug info is printed to the *Messages* buffer."
  84. nil
  85. :global t
  86. :group 'ido-ubiquitous)
  87. (defun ido-ubiquitous--debug-message (format-string &rest args)
  88. (when ido-ubiquitous-debug-mode
  89. (apply #'message (concat "ido-ubiquitous: " format-string) args)))
  90. (defun ido-ubiquitous--explain-fallback (arg)
  91. ;; This function accepts a string, or an ido-ubiquitous-fallback
  92. ;; signal.
  93. (when ido-ubiquitous-debug-mode
  94. (when (and (listp arg)
  95. (eq (car arg) 'ido-ubiquitous-fallback))
  96. (setq arg (cadr arg)))
  97. (ido-ubiquitous--debug-message "Falling back to `%s' because %s."
  98. ido-cr+-fallback-function arg)))
  99. ;;; Internal utility functions
  100. (defun ido-ubiquitous--as-string (sym-or-str)
  101. "Return name of symbol, return string as is."
  102. (if (symbolp sym-or-str)
  103. (symbol-name sym-or-str)
  104. sym-or-str))
  105. (defun ido-ubiquitous--as-symbol (sym-or-str)
  106. "Return string as symbol, return symbol as is."
  107. (if (symbolp sym-or-str)
  108. sym-or-str
  109. (intern sym-or-str)))
  110. ;;; Custom widget definitions
  111. ;; We need to define some custom widget types for use in the override
  112. ;; variables.
  113. (define-widget 'lazy-notag 'lazy
  114. "Like lazy widget, but does not display its tag, only its value."
  115. :format "%v")
  116. ;; Define matcher functions and widgets for match specifications
  117. (defvar ido-ubiquitous-match-spec-widget-types nil
  118. "List of widget names for match specs.")
  119. (defvar ido-ubiquitous-spec-matchers nil
  120. "Alist of functions for matching function specs against function names.")
  121. (cl-loop for (widget-name widget-tag key field-type matcher) in
  122. '((exact-match "Exact match" exact string string=)
  123. (prefix-match "Prefix match" prefix string string-prefix-p)
  124. (regexp-match "Regexp match" regexp regexp string-match-p))
  125. do (define-widget (ido-ubiquitous--as-symbol widget-name) 'lazy-notag widget-tag
  126. :menu-tag widget-tag
  127. :type `(list :tag ,widget-tag :format "%v"
  128. (const :format ""
  129. :tag ,widget-tag
  130. ,key)
  131. (,field-type :tag ,widget-tag)))
  132. do (add-to-list 'ido-ubiquitous-match-spec-widget-types
  133. widget-name 'append)
  134. do (add-to-list 'ido-ubiquitous-spec-matchers
  135. (cons key matcher) 'append))
  136. (define-widget 'ido-ubiquitous-match-spec 'lazy-notag
  137. "Choice of exact, prefix, or regexp match."
  138. :type `(choice :tag "Match type"
  139. ,@ido-ubiquitous-match-spec-widget-types))
  140. (define-widget 'ido-ubiquitous-command-override-spec 'lazy-notag
  141. "Choice of override action plus match specification."
  142. :type '(cons :tag "Override rule"
  143. (choice :tag "For matching commands"
  144. (const :menu-tag "Disable"
  145. :tag "Disable ido-ubiquitous"
  146. disable)
  147. (const :menu-tag "Enable"
  148. :tag "Enable ido-ubiquitous in normal default mode"
  149. enable)
  150. (const :menu-tag "Enable old-style default"
  151. :tag "Enable ido-ubiquitous in old-style default mode"
  152. enable-old))
  153. ido-ubiquitous-match-spec))
  154. (define-widget 'ido-ubiquitous-function-override-spec 'lazy-notag
  155. "Choice of override action and function name. (Exact match only.)"
  156. :type '(list :tag "Override rule"
  157. (choice :tag "Do the following"
  158. (const :menu-tag "Disable"
  159. :tag "Disable ido-ubiquitous"
  160. disable)
  161. (const :menu-tag "Enable"
  162. :tag "Enable ido-ubiquitous in normal default mode"
  163. enable)
  164. (const :menu-tag "Enable old-style default"
  165. :tag "Enable ido-ubiquitous in old-style default mode"
  166. enable-old))
  167. (const :format "" exact)
  168. (string :tag "For function")))
  169. ;;; Custom Declarations
  170. (defgroup ido-ubiquitous nil
  171. "Use ido for (almost) all completion."
  172. :group 'ido
  173. :group 'ido-completing-read-plus)
  174. ;;;###autoload
  175. (define-obsolete-variable-alias 'ido-ubiquitous
  176. 'ido-ubiquitous-mode "ido-ubiquitous 0.8")
  177. ;;;###autoload
  178. (define-obsolete-function-alias 'ido-ubiquitous
  179. 'ido-ubiquitous-mode "ido-ubiquitous 0.8")
  180. ;;;###autoload
  181. (define-minor-mode ido-ubiquitous-mode
  182. "Use `ido-completing-read' instead of `completing-read' almost everywhere.
  183. If this mode causes problems for a function, you can customize
  184. when ido completion is or is not used by customizing
  185. `ido-ubiquitous-command-overrides' or
  186. `ido-ubiquitous-function-overrides'."
  187. nil
  188. :global t
  189. :group 'ido-ubiquitous
  190. ;; Actually enable/disable the mode by setting
  191. ;; `completing-read-function'.
  192. (setq completing-read-function
  193. (if ido-ubiquitous-mode
  194. #'completing-read-ido-ubiquitous
  195. ido-cr+-fallback-function)))
  196. ;; Variables for functionality that has moved to ido-completing-read+
  197. (define-obsolete-variable-alias
  198. 'ido-ubiquitous-max-items
  199. 'ido-cr+-max-items
  200. "ido-ubiquitous 3.0")
  201. (define-obsolete-variable-alias
  202. 'ido-ubiquitous-fallback-completing-read-function
  203. 'ido-cr+-fallback-function
  204. "ido-ubiquitous 3.0")
  205. (define-obsolete-variable-alias
  206. 'ido-ubiquitous-enable-compatibility-globally
  207. 'ido-ubiquitous-enable-old-style-default
  208. "ido-ubiquitous 2.0")
  209. (defcustom ido-ubiquitous-default-state 'enable
  210. "Default ido-ubiquitous mode of operation for commands with no override.
  211. This can be set to one of three options:
  212. * `enable': use normal ido completion;
  213. * `enable-old': use ido completion, but with emulation of the
  214. old-style default selection of `completing-read';
  215. * `disable': use non-ido completion.
  216. Command-specific and function-specific overrides are available to
  217. override this default for specific commands/functions. See
  218. `ido-ubiquitous-command-overrides' and
  219. `ido-ubiquitous-function-overrides'.
  220. The `enable-old' option swaps the behavior of RET and C-j but
  221. only for the first keypress after beginning completion.
  222. Specifically, on the first keypress, RET will return an empty
  223. string and C-j will return the first item on the list. The
  224. purpose of this is to emulate a legacy compatibility quirk of
  225. `completing-read'. From the `completing-read' docstring:
  226. > If the input is null, `completing-read' returns DEF, or the
  227. > first element of the list of default values, or an empty string
  228. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  229. This odd behavior is required for compatibility with an old-style
  230. usage pattern whereby the default was requested by returning an
  231. empty string. In this mode, the caller receives the empty string
  232. and handles the default case manually, while `completing-read'
  233. never has any knowledge of the default. This is a problem for
  234. ido, which normally returns the first element in the list, not an
  235. empty string, when the input is empty and you press RET. Without
  236. knowledge of the default, it cannot ensure that the default is
  237. first on the list, so returning the first item is not the correct
  238. behavior. Instead, it must return an empty string like
  239. `completing-read'.
  240. The `disable' mode is available as a default, which seems
  241. counterintuitive. But this allows you, if you so desire, to
  242. enable ido-ubiquitous selectively for only a few specific commands
  243. using overrides and disable it for everything else."
  244. :type '(choice :tag "Default mode"
  245. (const :menu-tag "Disable"
  246. :tag "Disable ido-ubiquitous"
  247. disable)
  248. (const :menu-tag "Enable"
  249. :tag "Enable ido-ubiquitous in normal default mode"
  250. enable)
  251. (const :menu-tag "Enable old-style default"
  252. :tag "Enable ido-ubiquitous in old-style default mode"
  253. enable-old))
  254. :group 'ido-ubiquitous)
  255. (make-obsolete-variable
  256. 'ido-ubiquitous-enable-old-style-default
  257. "This variable no longer has any effect. Set
  258. `ido-ubiquitous-default-state' to `enable-old' instead."
  259. "ido-ubiquitous 3.0")
  260. (defconst ido-ubiquitous-default-command-overrides
  261. '(;; If you want ido for M-x, install smex
  262. (disable exact "execute-extended-command")
  263. ;; Wanderlust uses new-style default
  264. (enable prefix "wl-")
  265. ;; Info functions use old-style default selection
  266. (enable-old prefix "Info-")
  267. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  268. (enable exact "webjump")
  269. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/28
  270. (enable regexp "\\`\\(find\\|load\\|locate\\)-library\\'")
  271. ;; https://github.com/bbatsov/prelude/issues/488
  272. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/44
  273. ;; tmm implements its own non-standard completion mechanics
  274. (disable prefix "tmm-")
  275. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/47
  276. ;; theme functions don't need old-style compatibility
  277. (enable regexp "\\`\\(load\\|enable\\|disable\\|describe\\|custom-theme-visit\\)-theme\\'")
  278. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/79
  279. (enable-old prefix "bbdb-")
  280. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/83
  281. (enable-old exact "where-is")
  282. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/60
  283. (disable exact "todo-add-category")
  284. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/51
  285. (enable exact "find-tag")
  286. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/89
  287. (enable prefix "etags-select-")
  288. (enable regexp "\\`describe-\\(function\\|variable\\)\\'")
  289. ) ; Close paren on separate line for better VC diffs
  290. "Default value of `ido-ubiquitous-command-overrides'.
  291. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  292. (defconst ido-ubiquitous-default-function-overrides
  293. '((disable exact "read-file-name")
  294. (disable exact "read-file-name-internal")
  295. (disable exact "read-buffer")
  296. (disable exact "gnus-emacs-completing-read")
  297. (disable exact "gnus-iswitchb-completing-read")
  298. (disable exact "grep-read-files")
  299. (disable exact "magit-builtin-completing-read")
  300. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/36
  301. (enable exact "bookmark-completing-read")
  302. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/4
  303. (enable-old exact "webjump-read-choice")
  304. (enable-old exact "webjump-read-url-choice")
  305. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/9
  306. (disable exact "isearchp-read-unicode-char")
  307. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/38
  308. (enable exact "read-char-by-name")
  309. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/39
  310. (disable exact "Info-read-node-name")
  311. ;; https://github.com/purcell/emacs.d/issues/182#issuecomment-44212927
  312. (disable exact "tmm-menubar")
  313. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/58
  314. ;; https://github.com/mooz/js2-mode/issues/181
  315. (enable exact "imenu--completion-buffer")
  316. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/74
  317. (enable-old exact "auto-insert")
  318. ;; https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/116
  319. (enable exact "project--completing-read-strict")
  320. ) ; Close paren on separate line for better VC diffs
  321. "Default value of `ido-ubiquitous-function-overrides'.
  322. You can restore these using the command `ido-ubiquitous-restore-default-overrides'.")
  323. (defcustom ido-ubiquitous-command-overrides ido-ubiquitous-default-command-overrides
  324. "List of command override specifications for ido-ubiquitous
  325. Each override specification describes how ido-ubiquitous should
  326. behave one or many commands. A specification has the
  327. form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'. BEHAVIOR is one of the
  328. following:
  329. * `disable': ido-ubiquitous should not be used at all for the
  330. specified commands;
  331. * `enable': ido-ubiquitous may be used with the specified
  332. commands, without emulating the old-style default selection
  333. of `completing-read';
  334. * `enable-old': ido-ubiquitous may be used with the specified
  335. commands, and should emulate the old-style default selection
  336. of `completing-read'.
  337. MATCH-TYPE affects how MATCH-TEXT is interpreted, as follows:
  338. * `exact': the specification only affects the one command
  339. whose name is MATCH-TEXT;
  340. * `prefix': the specification affects any command whose name
  341. starts with MATCH-TEXT (This is useful for specifying a
  342. certain behavior for an entire package);
  343. * `regexp': the specification affects any command whose name
  344. matches MATCH-TEXT (with MATCH-TEXT being interpreted as a
  345. regular expression)
  346. MATCH-TEXT should be a string.
  347. Since this variable's has a somewhat complex structure, it is
  348. recommended that you set this variable through Customize.
  349. Note that this variable only affects *commands*, which are
  350. functions marked as interactive. See
  351. `ido-ubiquitous-function-overrides' for how to modify the
  352. behavior of ido-ubiquitous for arbitrary functions.
  353. Note: If multiple overrides match the same commmand, the first
  354. one in the list will take precedence.
  355. If you need to add a new specification to this list, please also
  356. file a bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues"
  357. :type '(repeat ido-ubiquitous-command-override-spec)
  358. :group 'ido-ubiquitous)
  359. (defmacro ido-ubiquitous-with-override (override &rest body)
  360. "Eval BODY with specified OVERRIDE in place.
  361. The OVERRIDE argument is evaluated normally, so if it is a
  362. literal symbol, it must be quoted.
  363. See `ido-ubiquitous-command-overrides' for valid override types."
  364. (declare (indent 1))
  365. ;; Eval override
  366. `(let ((ido-ubiquitous-next-override ,override))
  367. ,@body))
  368. (defun ido-ubiquitous-apply-function-override (func override)
  369. "Set the override property on FUNC to OVERRIDE and set up advice to apply the override."
  370. (setq func (ido-ubiquitous--as-symbol func)
  371. override (ido-ubiquitous--as-symbol override))
  372. (if (memq override '(disable enable enable-old nil))
  373. (progn
  374. (put func 'ido-ubiquitous-override override)
  375. (when override
  376. (let ((docstring
  377. (format "Override ido-ubiquitous behavior in %s if its `ido-ubiquitous-override' property is non-nil." func)))
  378. (eval
  379. `(defadvice ,func (around ido-ubiquitous-override activate)
  380. ,docstring
  381. (let* ((func ',func)
  382. (override (get func 'ido-ubiquitous-override)))
  383. (when override
  384. (ido-ubiquitous--debug-message
  385. "Using override `%s' for function `%s'"
  386. override func))
  387. (ido-ubiquitous-with-override override
  388. ad-do-it)))))))
  389. (display-warning
  390. 'ido-ubiquitous
  391. (format "Ignoring invalid override action `%s' for function `%s' found in `ido-ubiquitous-function-overrides'."
  392. override func)
  393. :warning)))
  394. (defun ido-ubiquitous-set-function-overrides (sym newval)
  395. "Custom setter function for `ido-ubiquitous-function-overrides'.
  396. In addition to setting the variable, this also sets up advice on
  397. each function to apply the appropriate override."
  398. ;; Unset all previous overrides
  399. (when (boundp sym)
  400. (let ((oldval (eval sym)))
  401. (cl-loop for (_action _match-type func) in oldval
  402. do (ido-ubiquitous-apply-function-override func nil))))
  403. ;; Ensure that function names are strings, not symbols
  404. (setq newval
  405. (cl-loop for (action match-type func) in newval
  406. collect (list action match-type
  407. (ido-ubiquitous--as-string func))))
  408. ;; set new overrides
  409. (cl-loop for override in newval
  410. for (action match-type func) = override
  411. ;; Remove duplicate overrides
  412. if (member func overridden-functions)
  413. do (display-warning
  414. 'ido-ubiquitous
  415. (format
  416. "Removing duplicate override for function `%s'" func))
  417. ;; Apply valid overrides
  418. else if (eq match-type 'exact)
  419. do (ido-ubiquitous-apply-function-override func action)
  420. and collect func into overridden-functions
  421. and collect override into final-value
  422. ;; Remove invalid overrides
  423. else
  424. do (display-warning
  425. 'ido-ubiquitous
  426. (format
  427. "Removing invalid function override match-type `%s' for function `%s'; only match-type `exact' is supported in `ido-ubiquitous-function-overrides'."
  428. match-type func))
  429. ;; Set the value to only the overrides that were actually
  430. ;; applied.
  431. finally return
  432. (set-default sym final-value)))
  433. (defcustom ido-ubiquitous-auto-update-overrides 'notify
  434. "Whether to add new overrides when updating ido-ubiquitous.
  435. Ido-ubiquitous comes with a default set of overrides for commands
  436. that are known to require them. New versions of ido-ubiquitous
  437. may come with updates to the default overrides as more commands
  438. are discovered to require them. However, customizing your own
  439. overrides would normally prevent you from receiving these
  440. updates, since Emacs will not overwrite your customizations.
  441. To resolve this problem, you can set this variable to `t', and
  442. then ido-ubiquitous can automatically add any new built-in
  443. overrides whenever it is updated. (Actually, the update will
  444. happen the next time Emacs is restarted after the update.) This
  445. allows you to add your own overrides but still receive updates to
  446. the default set. The default overrides will always be added with
  447. lower precedence than user-added ones.
  448. If you want ido-ubiquitous to just notify you about new default
  449. overrides instead of adding them itself, set this variable to
  450. `notify'. If you don't want this auto-update behavior at all, set
  451. it to `nil'.
  452. (Note that having this option enabled effectively prevents you
  453. from removing any of the built-in default overrides, since they
  454. will simply be re-added the next time Emacs starts. However, your
  455. custom overrides will still take precedence, so this shouldn't be
  456. a problem.)"
  457. :type '(choice :tag "When new overrides are available:"
  458. (const :menu-tag "Auto-add"
  459. :tag "Add them automatically"
  460. t)
  461. (const :menu-tag "Notify"
  462. :tag "Notify the user about them"
  463. notify)
  464. (const :menu-tag "Ignore"
  465. :tag "Ignore them"
  466. nil))
  467. :group 'ido-ubiquitous)
  468. (defcustom ido-ubiquitous-function-overrides ido-ubiquitous-default-function-overrides
  469. "List of function override specifications for ido-ubiquitous
  470. Function override specifications have a similar structure to
  471. command override specifications (see
  472. `ido-ubiquitous-command-overrides'). A function override
  473. specification has the form `(BEHAVIOR MATCH-TYPE MATCH-TEXT)'.
  474. However, `MATCH-TYPE' may ONLY be `exact'; No other match type is
  475. supported.
  476. Note: If multiple overrides are set for the same function, the
  477. first one in the list will take precedence, and the rest will be
  478. ignored and deleted from the override list, with a warning.
  479. Invalid override specifications will also be deleted with a
  480. warning.
  481. If you need to add a new specification to this list, please also file a
  482. bug report at https://github.com/DarwinAwardWinner/ido-ubiquitous/issues
  483. Setting this variable directly has no effect. You must set it
  484. through Customize."
  485. :type '(repeat ido-ubiquitous-function-override-spec)
  486. :set 'ido-ubiquitous-set-function-overrides
  487. :group 'ido-ubiquitous)
  488. (defcustom ido-ubiquitous-allow-on-functional-collection nil
  489. "Allow ido completion when COLLECTION is a function.
  490. The `completing-read' function allows its COLLECTION argument to
  491. be a function instead of a list of choices. Some such functions
  492. simply return a list of completions and are suitable for use with
  493. ido, but others implement more complex behavior and will result
  494. in incorrect behavior if used with ido. Since there is no way to
  495. tell the difference, this preference defaults to nil, which means
  496. that ido-ubiquitous will not work when COLLECTION is a function
  497. unless there is a specific override in effect. To disable this
  498. safeguard and GUARANTEE ERRORS on some functions, you may set
  499. this to non-nil, but this is not recommended."
  500. :type 'boolean
  501. :group 'ido-ubiquitous)
  502. ;;; ido-ubiquitous core
  503. ;; These variable are used to make ido-ubiquitous work properly in the
  504. ;; case that `completing-read' is called recursively (which is
  505. ;; possible when `enable-recursive-minibuffers' is non-nil.)
  506. (defvar ido-ubiquitous-enable-next-call nil
  507. "If non-nil, then the next call to `ido-completing-read' is by ido-ubiquitous.")
  508. (defvar ido-ubiquitous-enable-this-call nil
  509. "If non-nil, then the current call to `ido-completing-read' is by ido-ubiquitous.")
  510. (defvar ido-ubiquitous-next-override nil
  511. "This holds the override to be applied on the next call to `completing-read'.
  512. It's value can be nil or one of the symbols `disable', `enable', or
  513. `enable-old'.
  514. You should not modify this variable directly. Instead use the
  515. macro `ido-ubiquitous-with-override'.")
  516. (defvar ido-ubiquitous-active-override nil
  517. "This holds the override being applied to the current call to `completing-read'.
  518. It's value can be nil or one of the symbols `disable', `enable', or
  519. `enable-old'.
  520. You should not modify this variable directly. Instead use the
  521. macro `ido-ubiquitous-with-override'.")
  522. (defvar ido-ubiquitous-active-state nil
  523. "This holds the ido-ubiquitous mode of operation for the current call to `completing-read'.
  524. It's value can be nil or one of the symbols `disable', `enable', or
  525. `enable-old'.
  526. You should not modify this variable directly.")
  527. (defadvice ido-completing-read (around ido-ubiquitous activate)
  528. "Enable ido-ubiquitous features if this call was done through ido-ubiquitous.
  529. This advice ensures that `ido-ubiquitous-enable-this-call' is set
  530. properly while `ido-completing-read' is executing. This variable
  531. is used to determine whether to enable certain behaviors only for
  532. ido-ubiquitous, not for ordinary ido completion."
  533. ;; Set "this" and clear "next" so it doesn't apply to nested calls.
  534. (let* ((ido-ubiquitous-enable-this-call ido-ubiquitous-enable-next-call)
  535. (ido-ubiquitous-enable-next-call nil)
  536. (ido-ubiquitous-initial-item nil))
  537. ad-do-it))
  538. ;; Signal used to trigger fallback (don't use `define-error' because
  539. ;; it's only supported in 24.4 and up)
  540. (put 'ido-ubiquitous-fallback 'error-conditions '(ido-ubiquitous-fallback error))
  541. (put 'ido-ubiquitous-fallback 'error-message "ido-ubiquitous-fallback")
  542. (defun completing-read-ido-ubiquitous
  543. (prompt collection &optional predicate
  544. require-match initial-input
  545. hist def inherit-input-method)
  546. "ido-based method for reading from the minibuffer with completion.
  547. See `completing-read' for the meaning of the arguments.
  548. This function is a wrapper for `ido-completing-read' designed to
  549. be used as the value of `completing-read-function'. Importantly,
  550. it detects edge cases that ido cannot handle and uses normal
  551. completion for them."
  552. (let (;; Save the original arguments in case we need to do the
  553. ;; fallback
  554. (orig-args
  555. (list prompt collection predicate require-match
  556. initial-input hist def inherit-input-method)))
  557. ;; Outer `condition-case' is the fallback handler
  558. (condition-case sig
  559. ;; Inner `condition-case' converts any unexpected errors into
  560. ;; fallback signals.
  561. (condition-case err
  562. (let* (;; Set the active override and clear the "next" one so it
  563. ;; doesn't apply to nested calls.
  564. (ido-ubiquitous-active-override ido-ubiquitous-next-override)
  565. (ido-ubiquitous-next-override nil)
  566. ;; Apply the active override, if any
  567. (ido-ubiquitous-active-state
  568. (or ido-ubiquitous-active-override
  569. ido-ubiquitous-default-state
  570. 'enable)))
  571. ;; If ido-ubiquitous is disabled this time, fall back
  572. (when (eq ido-ubiquitous-active-state 'disable)
  573. (signal 'ido-ubiquitous-fallback
  574. '("`ido-ubiquitous-active-state' is `disable'")))
  575. ;; Handle a collection that is a function: either expand
  576. ;; completion list now or fall back
  577. (when (and (functionp collection)
  578. (not (eq collection 'help--symbol-completion-table)))
  579. (if (or ido-ubiquitous-allow-on-functional-collection
  580. (memq ido-ubiquitous-active-override
  581. '(enable enable-old)))
  582. (setq collection (all-completions "" collection predicate)
  583. ;; `all-completions' will apply the predicate,
  584. ;; so it now becomes redundant.
  585. predicate nil)
  586. (signal 'ido-ubiquitous-fallback
  587. '("COLLECTION is a function and there is no override"))))
  588. (let ((ido-ubiquitous-enable-next-call t))
  589. (ido-completing-read+
  590. prompt collection predicate require-match
  591. initial-input hist def inherit-input-method)))
  592. ;; Pass through any known fallback signals to the outer
  593. ;; `condition-case'
  594. (ido-ubiquitous-fallback
  595. (signal (car err) (cdr err)))
  596. ;; Convert any other error into a fallback signal.
  597. (error
  598. (signal 'ido-ubiquitous-fallback
  599. (list (format "ido-ubiquitous encountered an unexpected error: %S"
  600. err)))))
  601. ;; Handler for ido-ubiquitous-fallback signal
  602. (ido-ubiquitous-fallback
  603. (ido-ubiquitous--explain-fallback sig)
  604. (apply ido-cr+-fallback-function orig-args)))))
  605. (define-obsolete-function-alias 'completing-read-ido 'completing-read-ido-ubiquitous
  606. "ido-ubiquitous 3.0")
  607. ;;; Old-style default support
  608. (defvar ido-ubiquitous-initial-item nil
  609. "The first item selected when ido starts.
  610. This is initialized to the first item in the list of completions
  611. when ido starts, and is cleared when any character is entered
  612. into the prompt or the list is cycled. If it is non-nil and still
  613. equal to the first item in the completion list when ido exits,
  614. then if `ido-ubiquitous-active-state' is `enable-old', ido
  615. returns an empty string instead of the first item on the list.")
  616. (defmacro ido-ubiquitous-set-initial-item (item)
  617. "Wrapper for `(setq ido-ubiquitous-initial-item ITEM)'.
  618. This wrapper differs from simply doing `(setq
  619. ido-ubiquitous-initial-item ITEM)' in several ways. First, it has
  620. no effect (and does not evaluate ITEM) unless
  621. `ido-ubiquitous-active-state' is `enable-old'. Second, it emits
  622. appropriate debug messages."
  623. `(when (eq ido-ubiquitous-active-state 'enable-old)
  624. (let ((item ,item))
  625. (cond
  626. (item
  627. (ido-ubiquitous--debug-message
  628. "Setting `ido-ubiquitous-initial-item' to `%S'."
  629. item))
  630. (ido-ubiquitous-initial-item
  631. (ido-ubiquitous--debug-message "Clearing `ido-ubiquitous-initial-item'.")))
  632. (setq ido-ubiquitous-initial-item item))))
  633. (defadvice ido-read-internal (before ido-ubiquitous-clear-initial-item activate)
  634. (ido-ubiquitous-set-initial-item nil))
  635. (defadvice ido-make-choice-list (after ido-ubiquitous-set-initial-item activate)
  636. (ido-ubiquitous-set-initial-item
  637. (when (and ad-return-value (listp ad-return-value))
  638. (car ad-return-value))))
  639. (defadvice ido-next-match (after ido-ubiquitous-clear-initial-item activate)
  640. (ido-ubiquitous-set-initial-item nil))
  641. (defadvice ido-prev-match (after ido-ubiquitous-clear-initial-item activate)
  642. (ido-ubiquitous-set-initial-item nil))
  643. ;; Clear initial item after `self-insert-command'
  644. (defun ido-ubiquitous-post-insert-hook ()
  645. (eval '(ido-ubiquitous-set-initial-item nil)))
  646. (defun ido-ubiquitous-ido-minibuffer-setup-hook ()
  647. (add-hook
  648. 'post-self-insert-hook
  649. #'ido-ubiquitous-post-insert-hook
  650. nil
  651. 'local))
  652. (add-hook 'ido-minibuffer-setup-hook
  653. #'ido-ubiquitous-ido-minibuffer-setup-hook)
  654. (defun ido-ubiquitous-should-use-old-style-default ()
  655. "Returns non nil if ido-ubiquitous should emulate old-style default.
  656. This function simply encapsulates all the checks that need to be
  657. done in order to decide whether to swap RET and C-j. See
  658. `ido-ubiquitous-default-state' for more information."
  659. ;; These checks outside the loop don't produce debug messages
  660. (and
  661. ;; Only if old-style default enabled
  662. (eq ido-ubiquitous-active-state 'enable-old)
  663. ;; This loop is just an implementation of `and' that reports which
  664. ;; arg was nil for debugging purposes.
  665. (cl-loop
  666. for test in
  667. '((bound-and-true-p ido-cur-item)
  668. ;; Only if completing a list, not a buffer or file
  669. (eq ido-cur-item 'list)
  670. ;; Only if this call was done through ido-ubiquitous
  671. ido-ubiquitous-enable-this-call
  672. ;; Only if default is nil
  673. (null ido-default-item)
  674. ;; Only if input is empty
  675. (string= ido-text "")
  676. ;; Only if `ido-ubiquitous-initial-item' hasn't been cleared
  677. ido-ubiquitous-initial-item
  678. ;; Only if initial item hasn't changed
  679. (string= (car ido-cur-list)
  680. ido-ubiquitous-initial-item))
  681. for test-result = (eval test)
  682. if (not test-result)
  683. do (ido-ubiquitous--debug-message
  684. "Not enabling old-style default selection because `%S' is nil"
  685. test)
  686. and return nil
  687. finally do (ido-ubiquitous--debug-message
  688. "Enabling old-style default selection")
  689. finally return t)))
  690. (defadvice ido-exit-minibuffer (around ido-ubiquitous-old-style-default-compat activate)
  691. "Emulate a quirk of `completing-read'.
  692. > If the input is null, `completing-read' returns DEF, or the
  693. > first element of the list of default values, or an empty string
  694. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  695. See `ido-ubiquitous-default-state', which controls whether this
  696. advice has any effect."
  697. (condition-case nil
  698. (if (ido-ubiquitous-should-use-old-style-default)
  699. (let ((ido-ubiquitous-active-state 'enable))
  700. (ido-select-text))
  701. ad-do-it)
  702. (error
  703. (display-warning 'ido-ubiquitous "Advice on `ido-exit-minibuffer' failed." :warning)
  704. ad-do-it))
  705. (ido-ubiquitous-set-initial-item nil))
  706. (defadvice ido-select-text (around ido-ubiquitous-old-style-default-compat activate)
  707. "Emulate a quirk of `completing-read'.
  708. > If the input is null, `completing-read' returns DEF, or the
  709. > first element of the list of default values, or an empty string
  710. > if DEF is nil, regardless of the value of REQUIRE-MATCH.
  711. See `ido-ubiquitous-default-state', which controls whether this
  712. advice has any effect."
  713. (condition-case nil
  714. (if (ido-ubiquitous-should-use-old-style-default)
  715. (let ((ido-ubiquitous-active-state 'enable))
  716. (ido-exit-minibuffer))
  717. ad-do-it)
  718. (error
  719. (display-warning 'ido-ubiquitous "Advice on `ido-select-text' failed." :warning)
  720. ad-do-it))
  721. (ido-ubiquitous-set-initial-item nil))
  722. ;;; Overrides
  723. (defun ido-ubiquitous--overrides-have-same-target-p (o1 o2)
  724. (cl-destructuring-bind (oride1 type1 text1) o1
  725. (cl-destructuring-bind(oride2 type2 text2) o2
  726. ;; Avoid warnings about unused vars
  727. oride1 oride2
  728. (and (string= text1 text2)
  729. (eq type1 type2)))))
  730. (defun ido-ubiquitous--combine-override-lists (olist1 olist2)
  731. "Append OLIST2 to OLIST1, but remove redundant elements.
  732. Redundancy is determined using
  733. `ido-ubiquitous--overrides-have-same-target-p'."
  734. (let ((olist2
  735. (cl-remove-if
  736. (lambda (o2) (cl-member
  737. o2 olist1
  738. :test #'ido-ubiquitous--overrides-have-same-target-p))
  739. olist2)))
  740. (append olist1 olist2)))
  741. (defun ido-ubiquitous-update-overrides (&optional save quiet)
  742. "Re-add the default overrides without erasing custom overrides.
  743. This is useful after an update of ido-ubiquitous that adds new
  744. default overrides. See `ido-ubiquitous-auto-update-overrides' for
  745. more information.
  746. If SAVE is non-nil, also save the overrides to the user's custom
  747. file (but only if they were already customized). When called
  748. interactively, a prefix argument triggers a save.
  749. When called from Lisp code, this function returns the list of
  750. variables whose values were modified. In particular, it returns
  751. non-nil if any variables were modified, and nil if no modifications
  752. were made."
  753. (interactive "P")
  754. (let ((unmodified-vars nil)
  755. (updated-vars nil)
  756. (final-message-lines nil)
  757. (final-message-is-warning nil))
  758. (cl-loop
  759. for (var def) in
  760. '((ido-ubiquitous-command-overrides
  761. ido-ubiquitous-default-command-overrides)
  762. (ido-ubiquitous-function-overrides
  763. ido-ubiquitous-default-function-overrides))
  764. do (let* ((var-state (custom-variable-state var (eval var)))
  765. (curval (eval var))
  766. (defval (eval def))
  767. (newval (ido-ubiquitous--combine-override-lists
  768. curval defval)))
  769. (cond
  770. ;; Nothing to add to var, do nothing
  771. ((and (equal curval newval)
  772. (eq var-state 'saved))
  773. (ido-ubiquitous--debug-message
  774. "No need to modify value of option `%s'"
  775. var)
  776. (push var unmodified-vars))
  777. ;; Var is not customized, just set the new default
  778. ((eq var-state 'standard)
  779. (ido-ubiquitous--debug-message
  780. "Setting uncustomized option `%s' to its default value"
  781. var)
  782. (push var unmodified-vars)
  783. (set var defval))
  784. ;; Var is saved to custom.el, set and save new value (if
  785. ;; SAVE is t)
  786. ((and save
  787. (eq var-state 'saved))
  788. (ido-ubiquitous--debug-message
  789. "Updating option `%s' with new overrides and saving it."
  790. var)
  791. (push var updated-vars)
  792. (customize-save-variable var newval))
  793. ;; Var is modified but not saved (or SAVE is nil), update it
  794. ;; but don't save it
  795. (t
  796. (ido-ubiquitous--debug-message
  797. "Updating option `%s' with new overrides but not saving it for future sessions."
  798. var)
  799. (push var updated-vars)
  800. (customize-set-variable var newval)))))
  801. (unless quiet
  802. ;; Now compose a single message that summarizes what was done
  803. (if (null updated-vars)
  804. (push "No updates to ido-ubiquitous override variables were needed."
  805. final-message-lines)
  806. (push
  807. (format "Updated the following ido-ubiquitous override variables: %S"
  808. (sort updated-vars #'string<))
  809. final-message-lines)
  810. (if save
  811. (push
  812. "All updated variables were successfully saved."
  813. final-message-lines)
  814. (push
  815. "However, they have not been saved for future sessions. To save them, re-run this command with a prefix argument: `C-u M-x ido-ubiquitous-update-overrides'; or else manually inspect and save their values using `M-x customize-group ido-ubiquitous'."
  816. final-message-lines)
  817. (setq final-message-is-warning t)))
  818. (if final-message-is-warning
  819. (display-warning 'ido-ubiquitous
  820. (mapconcat 'identity (nreverse final-message-lines) "\n"))
  821. (message (mapconcat 'identity (nreverse final-message-lines) "\n"))))
  822. updated-vars))
  823. (defun ido-ubiquitous--find-override-updates (current-value available-updates)
  824. (cl-set-difference (ido-ubiquitous--combine-override-lists
  825. current-value available-updates)
  826. current-value))
  827. (defun ido-ubiquitous--maybe-update-overrides ()
  828. "Maybe call `ido-ubiquitous-update-overrides.
  829. See `ido-ubiquitous-auto-update-overrides."
  830. (if ido-ubiquitous-auto-update-overrides
  831. (let* ((command-override-updates
  832. (ido-ubiquitous--find-override-updates
  833. ido-ubiquitous-command-overrides
  834. ido-ubiquitous-default-command-overrides))
  835. (function-override-updates
  836. (ido-ubiquitous--find-override-updates
  837. ido-ubiquitous-function-overrides
  838. ido-ubiquitous-default-function-overrides))
  839. (update-count
  840. (+ (length command-override-updates)
  841. (length function-override-updates))))
  842. (if (> update-count 0)
  843. (if (eq ido-ubiquitous-auto-update-overrides 'notify)
  844. (display-warning
  845. 'ido-ubiquitous
  846. (format "There are %s new overrides available. Use `M-x ido-ubiquitous-update-overrides' to enable them. (See `ido-ubiquitous-auto-update-overrides' for more information.)"
  847. update-count))
  848. (ido-ubiquitous--debug-message "Applying override updates.")
  849. (ido-ubiquitous-update-overrides t))
  850. (ido-ubiquitous--debug-message "No override updates availble.")))
  851. (ido-ubiquitous--debug-message "Skipping override updates by user preference.")))
  852. (define-obsolete-function-alias
  853. 'ido-ubiquitous-restore-default-overrides
  854. 'ido-ubiquitous-update-overrides
  855. "ido-ubiquitous 3.9")
  856. (defun ido-ubiquitous-spec-match (spec symbol)
  857. "Returns t if SPEC matches SYMBOL (which should be a function name).
  858. See `ido-ubiquitous-command-overrides'. If the match spec is
  859. invalid or any other error occurs, the error is demoted to a
  860. warning and the function returns nil."
  861. (condition-case err
  862. (when (and symbol (symbolp symbol))
  863. (cl-destructuring-bind (type text) spec
  864. (let ((matcher (cdr (assoc type ido-ubiquitous-spec-matchers)))
  865. (text (ido-ubiquitous--as-string text))
  866. (symname (ido-ubiquitous--as-string symbol)))
  867. (if matcher
  868. (funcall matcher text symname)
  869. ;; If the matcher is invalid, issue a warning and return
  870. ;; nil.
  871. (error "Unknown match spec type \"%s\". See `ido-ubiquitous-spec-matchers' for valid types." type)
  872. nil))))
  873. (error
  874. (display-warning 'ido-ubiquitous "Error during ido-ubiquitous spec matching: %S" err)
  875. nil)))
  876. (defun ido-ubiquitous-get-command-override (cmd)
  877. "Return the override associated with the command CMD.
  878. If there is no override set for CMD in
  879. `ido-ubiquitous-command-overrides', return nil."
  880. (when (and cmd (symbolp cmd))
  881. (cl-loop for override in ido-ubiquitous-command-overrides
  882. for (action . spec) = override
  883. for valid-action = (and (memq action '(disable enable enable-old nil))
  884. (assoc (car spec) ido-ubiquitous-spec-matchers))
  885. unless valid-action
  886. do (progn
  887. (display-warning
  888. 'ido-ubiquitous
  889. (format "Removing invalid override `%S' from `ido-ubiquitous-command-overrides'"
  890. (cons action spec))
  891. :warning)
  892. (setq ido-ubiquitous-command-overrides
  893. (remove override ido-ubiquitous-command-overrides)))
  894. when (and valid-action (ido-ubiquitous-spec-match spec cmd))
  895. return action
  896. finally return nil)))
  897. ;;; Workaround for https://github.com/DarwinAwardWinner/ido-ubiquitous/issues/24
  898. ;; When `call-interactively' is advised, `called-interactively-p'
  899. ;; always returns nil. So we redefine it (and `interactive-p') to test
  900. ;; the correct condition.
  901. (defsubst ido-ubiquitous--looks-like-advised-orig (func)
  902. "Returns t if FUNC is a symbol starting with \"ad-Orig-\".
  903. Such symbols are used to store the original definitions of
  904. functions that have been advised by `defadvice' or similar."
  905. (and (symbolp func)
  906. (string-prefix-p "ad-Orig-" (symbol-name func))))
  907. (defsubst ido-ubiquitous--looks-like-call-interactively (func)
  908. "Returns t if FUNC looks like the function `call-interactively'.
  909. FUNC \"looks like\" `call-interactively' if it is the literal
  910. symbol `call-interactively', or the value of `(symbol-function
  911. 'call-interactively)', or a symbol whose `symbol-function' is the
  912. same as that of `call-interactively'.
  913. This function is used to determine whether a given function was
  914. \"called by\" `call-interactively' and therefore was called
  915. interactively."
  916. (when func
  917. (eq (symbol-function 'call-interactively)
  918. (if (symbolp func)
  919. (symbol-function func)
  920. func))))
  921. (defun ido-ubiquitous--backtrace-from (fun)
  922. "Return all backtrace frames, starting with the one for FUN.
  923. FUN may be a list of functions, in which case the first one found
  924. on the stack will be used."
  925. (let ((stack
  926. (cl-loop for i upfrom 0
  927. for frame = (backtrace-frame i)
  928. while frame
  929. collect frame))
  930. (funcs (if (functionp fun)
  931. (list fun)
  932. fun)))
  933. (while (and stack
  934. (not (memq (cl-cadar stack) funcs)))
  935. (setq stack (cdr stack)))
  936. stack))
  937. (defun ido-ubiquitous--clean-advice-from-backtrace (stack)
  938. "Takes a stack trace and cleans all evidence of advice.
  939. Specifically, for each call to a function starting with
  940. \"ad-Orig-\", that call and all prior calls up to but not
  941. including the advised function's original name are deleted from
  942. the stack."
  943. (let ((skipping-until nil))
  944. (cl-loop for frame in stack
  945. for func = (cadr frame)
  946. ;; Check if we found the frame we we're skipping to
  947. if (and skipping-until
  948. (eq func skipping-until))
  949. do (setq skipping-until nil)
  950. ;; If we're looking at an the original form of an advised
  951. ;; function, skip until the real name of that function.
  952. if (and (not skipping-until)
  953. (ido-ubiquitous--looks-like-advised-orig func))
  954. do (setq skipping-until
  955. (intern
  956. (substring (symbol-name func)
  957. (eval-when-compile (length "ad-Orig-")))))
  958. unless skipping-until collect frame)))
  959. (defsubst ido-ubiquitous--interactive-internal ()
  960. "Equivalent of the INTERACTIVE macro in the Emacs C source.
  961. This is an internal function that should never be called
  962. directly.
  963. See the C source for the logic behind this function."
  964. (and (not executing-kbd-macro)
  965. (not noninteractive)))
  966. (defun ido-ubiquitous--interactive-p-internal ()
  967. "Equivalent of C function \"interactive_p\".
  968. This is an internal function that should never be called
  969. directly.
  970. See the C source for the logic behind this function."
  971. (let ((stack
  972. ;; We clean advice from the backtrace. This ensures that we
  973. ;; get the right answer even if `call-interactively' has been
  974. ;; advised.
  975. (ido-ubiquitous--clean-advice-from-backtrace
  976. (cdr
  977. (ido-ubiquitous--backtrace-from
  978. '(called-interactively-p interactive-p))))))
  979. ;; See comments in the C function for the logic here.
  980. (while (and stack
  981. (or (eq (cl-cadar stack) 'bytecode)
  982. (null (caar stack))))
  983. (setq stack (cdr stack)))
  984. ;; Top of stack is now the function that we want to know
  985. ;; about. Pop it, then check if the next function is
  986. ;; `call-interactively', using a more permissive test than the default.
  987. (ido-ubiquitous--looks-like-call-interactively (cl-cadadr stack))))
  988. (defadvice call-interactively (around ido-ubiquitous activate)
  989. "Implements the behavior specified in `ido-ubiquitous-command-overrides'."
  990. (let* ((cmd (ad-get-arg 0))
  991. (override (ido-ubiquitous-get-command-override cmd)))
  992. (when override
  993. (ido-ubiquitous--debug-message "Using override `%s' for command `%s'"
  994. override cmd))
  995. (ido-ubiquitous-with-override override
  996. ad-do-it)))
  997. ;; Work around `called-interactively-p' in Emacs 24.3 and earlier,
  998. ;; which always returns nil when `call-interactively' is advised.
  999. (when (not (and (featurep 'nadvice)
  1000. (boundp 'called-interactively-p-functions)))
  1001. (defadvice interactive-p (around ido-ubiquitous activate)
  1002. "Return the correct result when `call-interactively' is advised.
  1003. This advice completely overrides the original definition."
  1004. (condition-case nil
  1005. (setq ad-return-value
  1006. (and (ido-ubiquitous--interactive-internal)
  1007. (ido-ubiquitous--interactive-p-internal)))
  1008. ;; In case of error in the advice, fall back to the default
  1009. ;; implementation
  1010. (error ad-do-it)))
  1011. (defadvice called-interactively-p (around ido-ubiquitous activate)
  1012. "Return the correct result when `call-interactively' is advised.
  1013. This advice completely overrides the original definition."
  1014. (condition-case nil
  1015. (setq ad-return-value
  1016. (and (or (ido-ubiquitous--interactive-internal)
  1017. (not (eq kind 'interactive)))
  1018. (ido-ubiquitous--interactive-p-internal)))
  1019. ;; In case of error in the advice, fall back to the default
  1020. ;; implementation
  1021. (error ad-do-it))))
  1022. ;;; Other
  1023. (defsubst ido-ubiquitous--fixup-old-advice ()
  1024. ;; Clean up old versions of ido-ubiquitous advice if they exist
  1025. (ignore-errors (ad-remove-advice 'completing-read 'around 'ido-ubiquitous))
  1026. (ignore-errors (ad-remove-advice 'ido-completing-read 'around 'detect-replacing-cr))
  1027. (ignore-errors (ad-remove-advice 'ido-magic-forward-char 'before 'ido-ubiquitous-fallback))
  1028. (ignore-errors (ad-remove-advice 'ido-magic-backward-char 'before 'ido-ubiquitous-fallback))
  1029. (ignore-errors (ad-remove-advice 'ido-exit-minibuffer 'around 'compatibility))
  1030. (ad-activate-all))
  1031. (defsubst ido-ubiquitous--fixup-old-magit-overrides ()
  1032. (let ((old-override '(disable prefix "magit-"))
  1033. (new-override '(disable exact "magit-builtin-completing-read")))
  1034. (when (member old-override
  1035. ido-ubiquitous-command-overrides)
  1036. (customize-set-variable
  1037. 'ido-ubiquitous-command-overrides
  1038. (remove old-override ido-ubiquitous-command-overrides))
  1039. (unless (member new-override ido-ubiquitous-function-overrides)
  1040. (customize-set-variable 'ido-ubiquitous-function-overrides
  1041. (append ido-ubiquitous-function-overrides
  1042. (list new-override))))
  1043. (display-warning
  1044. 'ido-ubiquitous
  1045. "Fixing obsolete magit overrides.
  1046. Magit has changed recently such that the old override that
  1047. ido-ubiquitous defined for it now causes problems. This old
  1048. override has been automatically removed and the new one added.
  1049. Please use `M-x customize-group ido-ubiquitous' and review the
  1050. override variables and save them to your customization file."
  1051. :warning))))
  1052. (defun ido-ubiquitous-initialize ()
  1053. "Do initial setup for ido-ubiquitous.
  1054. This only needs to be called once when the file is first loaded.
  1055. It cleans up any traces of old versions of ido-ubiquitous and
  1056. then sets up the mode."
  1057. (ido-ubiquitous--fixup-old-advice)
  1058. (ido-ubiquitous--fixup-old-magit-overrides)
  1059. (ido-ubiquitous--maybe-update-overrides)
  1060. ;; Make sure the mode is turned on/off as specified by the value of
  1061. ;; the mode variable
  1062. (ido-ubiquitous-mode (if ido-ubiquitous-mode 1 0)))
  1063. (ido-ubiquitous-initialize)
  1064. (provide 'ido-ubiquitous)
  1065. ;; Local Variables:
  1066. ;; indent-tabs-mode: nil
  1067. ;; End:
  1068. ;;; ido-ubiquitous.el ends here