custom.el 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515
  1. ;;; custom.el --- tools for declaring and initializing options
  2. ;;
  3. ;; Copyright (C) 1996-1997, 1999, 2001-2017 Free Software Foundation,
  4. ;; Inc.
  5. ;;
  6. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  7. ;; Maintainer: emacs-devel@gnu.org
  8. ;; Keywords: help, faces
  9. ;; Package: emacs
  10. ;; This file is part of GNU Emacs.
  11. ;; GNU Emacs is free software: you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation, either version 3 of the License, or
  14. ;; (at your option) any later version.
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18. ;; GNU General Public License for more details.
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  21. ;;; Commentary:
  22. ;;
  23. ;; This file only contains the code needed to declare and initialize
  24. ;; user options. The code to customize options is autoloaded from
  25. ;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual.
  26. ;; The code implementing face declarations is in `cus-face.el'.
  27. ;;; Code:
  28. (require 'widget)
  29. (defvar custom-define-hook nil
  30. ;; Customize information for this option is in `cus-edit.el'.
  31. "Hook called after defining each customize option.")
  32. (defvar custom-dont-initialize nil
  33. "Non-nil means `defcustom' should not initialize the variable.
  34. That is used for the sake of `custom-make-dependencies'.
  35. Users should not set it.")
  36. (defvar custom-current-group-alist nil
  37. "Alist of (FILE . GROUP) indicating the current group to use for FILE.")
  38. ;;; The `defcustom' Macro.
  39. (defun custom-initialize-default (symbol exp)
  40. "Initialize SYMBOL with EXP.
  41. This will do nothing if symbol already has a default binding.
  42. Otherwise, if symbol has a `saved-value' property, it will evaluate
  43. the car of that and use it as the default binding for symbol.
  44. Otherwise, EXP will be evaluated and used as the default binding for
  45. symbol."
  46. (eval `(defvar ,symbol ,(let ((sv (get symbol 'saved-value)))
  47. (if sv (car sv) exp)))))
  48. (defun custom-initialize-set (symbol exp)
  49. "Initialize SYMBOL based on EXP.
  50. If the symbol doesn't have a default binding already,
  51. then set it using its `:set' function (or `set-default' if it has none).
  52. The value is either the value in the symbol's `saved-value' property,
  53. if any, or the value of EXP."
  54. (condition-case nil
  55. (default-toplevel-value symbol)
  56. (error
  57. (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
  58. symbol
  59. (eval (let ((sv (get symbol 'saved-value)))
  60. (if sv (car sv) exp)))))))
  61. (defun custom-initialize-reset (symbol exp)
  62. "Initialize SYMBOL based on EXP.
  63. Set the symbol, using its `:set' function (or `set-default' if it has none).
  64. The value is either the symbol's current value
  65. (as obtained using the `:get' function), if any,
  66. or the value in the symbol's `saved-value' property if any,
  67. or (last of all) the value of EXP."
  68. (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
  69. symbol
  70. (condition-case nil
  71. (let ((def (default-toplevel-value symbol))
  72. (getter (get symbol 'custom-get)))
  73. (if getter (funcall getter symbol) def))
  74. (error
  75. (eval (let ((sv (get symbol 'saved-value)))
  76. (if sv (car sv) exp)))))))
  77. (defun custom-initialize-changed (symbol exp)
  78. "Initialize SYMBOL with EXP.
  79. Like `custom-initialize-reset', but only use the `:set' function if
  80. not using the standard setting.
  81. For the standard setting, use `set-default'."
  82. (condition-case nil
  83. (let ((def (default-toplevel-value symbol)))
  84. (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
  85. symbol
  86. (let ((getter (get symbol 'custom-get)))
  87. (if getter (funcall getter symbol) def))))
  88. (error
  89. (cond
  90. ((get symbol 'saved-value)
  91. (funcall (or (get symbol 'custom-set) #'set-default-toplevel-value)
  92. symbol
  93. (eval (car (get symbol 'saved-value)))))
  94. (t
  95. (set-default symbol (eval exp)))))))
  96. (defvar custom-delayed-init-variables nil
  97. "List of variables whose initialization is pending.")
  98. (defun custom-initialize-delay (symbol _value)
  99. "Delay initialization of SYMBOL to the next Emacs start.
  100. This is used in files that are preloaded (or for autoloaded
  101. variables), so that the initialization is done in the run-time
  102. context rather than the build-time context. This also has the
  103. side-effect that the (delayed) initialization is performed with
  104. the :set function.
  105. For variables in preloaded files, you can simply use this
  106. function for the :initialize property. For autoloaded variables,
  107. you will also need to add an autoload stanza calling this
  108. function, and another one setting the standard-value property.
  109. Or you can wrap the defcustom in a progn, to force the autoloader
  110. to include all of it." ; see eg vc-sccs-search-project-dir
  111. ;; No longer true:
  112. ;; "See `send-mail-function' in sendmail.el for an example."
  113. ;; Until the var is actually initialized, it is kept unbound.
  114. ;; This seemed to be at least as good as setting it to an arbitrary
  115. ;; value like nil (evaluating `value' is not an option because it
  116. ;; may have undesirable side-effects).
  117. (push symbol custom-delayed-init-variables))
  118. (defun custom-declare-variable (symbol default doc &rest args)
  119. "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
  120. DEFAULT should be an expression to evaluate to compute the default value,
  121. not the default value itself.
  122. DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property
  123. `standard-value'. At the same time, SYMBOL's property `force-value' is
  124. set to nil, as the value is no longer rogue."
  125. (put symbol 'standard-value (purecopy (list default)))
  126. ;; Maybe this option was rogue in an earlier version. It no longer is.
  127. (when (get symbol 'force-value)
  128. (put symbol 'force-value nil))
  129. (if (keywordp doc)
  130. (error "Doc string is missing"))
  131. (let ((initialize 'custom-initialize-reset)
  132. (requests nil))
  133. (unless (memq :group args)
  134. (custom-add-to-group (custom-current-group) symbol 'custom-variable))
  135. (while args
  136. (let ((keyword (pop args)))
  137. (unless (symbolp keyword)
  138. (error "Junk in args %S" args))
  139. (unless args
  140. (error "Keyword %s is missing an argument" keyword))
  141. (let ((value (pop args)))
  142. ;; Can't use `pcase' because it is loaded after `custom.el'
  143. ;; during bootstrap. See `loadup.el'.
  144. (cond ((eq keyword :initialize)
  145. (setq initialize value))
  146. ((eq keyword :set)
  147. (put symbol 'custom-set value))
  148. ((eq keyword :get)
  149. (put symbol 'custom-get value))
  150. ((eq keyword :require)
  151. (push value requests))
  152. ((eq keyword :risky)
  153. (put symbol 'risky-local-variable value))
  154. ((eq keyword :safe)
  155. (put symbol 'safe-local-variable value))
  156. ((eq keyword :type)
  157. (put symbol 'custom-type (purecopy value)))
  158. ((eq keyword :options)
  159. (if (get symbol 'custom-options)
  160. ;; Slow safe code to avoid duplicates.
  161. (mapc (lambda (option)
  162. (custom-add-option symbol option))
  163. value)
  164. ;; Fast code for the common case.
  165. (put symbol 'custom-options (copy-sequence value))))
  166. (t
  167. (custom-handle-keyword symbol keyword value
  168. 'custom-variable))))))
  169. (put symbol 'custom-requests requests)
  170. ;; Do the actual initialization.
  171. (unless custom-dont-initialize
  172. (funcall initialize symbol default)))
  173. ;; Use defvar to set the docstring as well as the special-variable-p flag.
  174. ;; FIXME: We should reproduce more of `defvar's behavior, such as the warning
  175. ;; when the var is currently let-bound.
  176. (if (not (default-boundp symbol))
  177. ;; Don't use defvar to avoid setting a default-value when undesired.
  178. (when doc (put symbol 'variable-documentation doc))
  179. (eval `(defvar ,symbol nil ,@(when doc (list doc)))))
  180. (push symbol current-load-list)
  181. (run-hooks 'custom-define-hook)
  182. symbol)
  183. (defmacro defcustom (symbol standard doc &rest args)
  184. "Declare SYMBOL as a customizable variable.
  185. SYMBOL is the variable name; it should not be quoted.
  186. STANDARD is an expression specifying the variable's standard
  187. value. It should not be quoted. It is evaluated once by
  188. `defcustom', and the value is assigned to SYMBOL if the variable
  189. is unbound. The expression itself is also stored, so that
  190. Customize can re-evaluate it later to get the standard value.
  191. DOC is the variable documentation.
  192. This macro uses `defvar' as a subroutine, which also marks the
  193. variable as \"special\", so that it is always dynamically bound
  194. even when `lexical-binding' is t.
  195. The remaining arguments to `defcustom' should have the form
  196. [KEYWORD VALUE]...
  197. The following keywords are meaningful:
  198. :type VALUE should be a widget type for editing the symbol's value.
  199. Every `defcustom' should specify a value for this keyword.
  200. :options VALUE should be a list of valid members of the widget type.
  201. :initialize
  202. VALUE should be a function used to initialize the
  203. variable. It takes two arguments, the symbol and value
  204. given in the `defcustom' call. The default is
  205. `custom-initialize-reset'.
  206. :set VALUE should be a function to set the value of the symbol
  207. when using the Customize user interface. It takes two arguments,
  208. the symbol to set and the value to give it. The function should
  209. not modify its value argument destructively. The default choice
  210. of function is `set-default'.
  211. :get VALUE should be a function to extract the value of symbol.
  212. The function takes one argument, a symbol, and should return
  213. the current value for that symbol. The default choice of function
  214. is `default-value'.
  215. :require
  216. VALUE should be a feature symbol. If you save a value
  217. for this option, then when your init file loads the value,
  218. it does (require VALUE) first.
  219. :set-after VARIABLES
  220. Specifies that SYMBOL should be set after the list of variables
  221. VARIABLES when both have been customized.
  222. :risky Set SYMBOL's `risky-local-variable' property to VALUE.
  223. :safe Set SYMBOL's `safe-local-variable' property to VALUE.
  224. See Info node `(elisp) File Local Variables'.
  225. The following common keywords are also meaningful.
  226. :group VALUE should be a customization group.
  227. Add SYMBOL (or FACE with `defface') to that group.
  228. :link LINK-DATA
  229. Include an external link after the documentation string for this
  230. item. This is a sentence containing an active field which
  231. references some other documentation.
  232. There are several alternatives you can use for LINK-DATA:
  233. (custom-manual INFO-NODE)
  234. Link to an Info node; INFO-NODE is a string which specifies
  235. the node name, as in \"(emacs)Top\".
  236. (info-link INFO-NODE)
  237. Like `custom-manual' except that the link appears in the
  238. customization buffer with the Info node name.
  239. (url-link URL)
  240. Link to a web page; URL is a string which specifies the URL.
  241. (emacs-commentary-link LIBRARY)
  242. Link to the commentary section of LIBRARY.
  243. (emacs-library-link LIBRARY)
  244. Link to an Emacs Lisp LIBRARY file.
  245. (file-link FILE)
  246. Link to FILE.
  247. (function-link FUNCTION)
  248. Link to the documentation of FUNCTION.
  249. (variable-link VARIABLE)
  250. Link to the documentation of VARIABLE.
  251. (custom-group-link GROUP)
  252. Link to another customization GROUP.
  253. You can specify the text to use in the customization buffer by
  254. adding `:tag NAME' after the first element of the LINK-DATA; for
  255. example, (info-link :tag \"foo\" \"(emacs)Top\") makes a link to the
  256. Emacs manual which appears in the buffer as `foo'.
  257. An item can have more than one external link; however, most items
  258. have none at all.
  259. :version
  260. VALUE should be a string specifying that the variable was
  261. first introduced, or its default value was changed, in Emacs
  262. version VERSION.
  263. :package-version
  264. VALUE should be a list with the form (PACKAGE . VERSION)
  265. specifying that the variable was first introduced, or its
  266. default value was changed, in PACKAGE version VERSION. This
  267. keyword takes priority over :version. The PACKAGE and VERSION
  268. must appear in the alist `customize-package-emacs-version-alist'.
  269. Since PACKAGE must be unique and the user might see it in an
  270. error message, a good choice is the official name of the
  271. package, such as MH-E or Gnus.
  272. :tag LABEL
  273. Use LABEL, a string, instead of the item's name, to label the item
  274. in customization menus and buffers.
  275. :load FILE
  276. Load file FILE (a string) before displaying this customization
  277. item. Loading is done with `load', and only if the file is
  278. not already loaded.
  279. If SYMBOL has a local binding, then this form affects the local
  280. binding. This is normally not what you want. Thus, if you need
  281. to load a file defining variables with this form, or with
  282. `defvar' or `defconst', you should always load that file
  283. _outside_ any bindings for these variables. (`defvar' and
  284. `defconst' behave similarly in this respect.)
  285. See Info node `(elisp) Customization' in the Emacs Lisp manual
  286. for more information."
  287. (declare (doc-string 3) (debug (name body)))
  288. ;; It is better not to use backquote in this file,
  289. ;; because that makes a bootstrapping problem
  290. ;; if you need to recompile all the Lisp files using interpreted code.
  291. `(custom-declare-variable
  292. ',symbol
  293. ,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
  294. ;; The STANDARD arg should be an expression that evaluates to
  295. ;; the standard value. The use of `eval' for it is spread
  296. ;; over many different places and hence difficult to
  297. ;; eliminate, yet we want to make sure that the `standard'
  298. ;; expression is checked by the byte-compiler, and that
  299. ;; lexical-binding is obeyed, so quote the expression with
  300. ;; `lambda' rather than with `quote'.
  301. ``(funcall #',(lambda () ,standard))
  302. `',standard)
  303. ,doc
  304. ,@args))
  305. ;;; The `defface' Macro.
  306. (defmacro defface (face spec doc &rest args)
  307. "Declare FACE as a customizable face that defaults to SPEC.
  308. FACE does not need to be quoted.
  309. Third argument DOC is the face documentation.
  310. If FACE has been set with `custom-theme-set-faces', set the face
  311. attributes as specified by that function, otherwise set the face
  312. attributes according to SPEC.
  313. The remaining arguments should have the form [KEYWORD VALUE]...
  314. For a list of valid keywords, see the common keywords listed in
  315. `defcustom'.
  316. SPEC should be a \"face spec\", i.e., an alist of the form
  317. ((DISPLAY . ATTS)...)
  318. where DISPLAY is a form specifying conditions to match certain
  319. terminals and ATTS is a property list (ATTR VALUE ATTR VALUE...)
  320. specifying face attributes and values for frames on those
  321. terminals. On each terminal, the first element with a matching
  322. DISPLAY specification takes effect, and the remaining elements in
  323. SPEC are disregarded.
  324. As a special exception, in the first element of SPEC, DISPLAY can
  325. be the special value `default'. Then the ATTS in that element
  326. act as defaults for all the following elements.
  327. For backward compatibility, elements of SPEC can be written
  328. as (DISPLAY ATTS) instead of (DISPLAY . ATTS).
  329. Each DISPLAY can have the following values:
  330. - `default' (only in the first element).
  331. - The symbol t, which matches all terminals.
  332. - An alist of conditions. Each alist element must have the form
  333. (REQ ITEM...). A matching terminal must satisfy each
  334. specified condition by matching one of its ITEMs. Each REQ
  335. must be one of the following:
  336. - `type' (the terminal type).
  337. Each ITEM must be one of the values returned by
  338. `window-system'. Under X, additional allowed values are
  339. `motif', `lucid', `gtk' and `x-toolkit'.
  340. - `class' (the terminal's color support).
  341. Each ITEM should be one of `color', `grayscale', or `mono'.
  342. - `background' (what color is used for the background text)
  343. Each ITEM should be one of `light' or `dark'.
  344. - `min-colors' (the minimum number of supported colors)
  345. Each ITEM should be an integer, which is compared with the
  346. result of `display-color-cells'.
  347. - `supports' (match terminals supporting certain attributes).
  348. Each ITEM should be a list of face attributes. See
  349. `display-supports-face-attributes-p' for more information on
  350. exactly how testing is done.
  351. In the ATTS property list, possible attributes are `:family',
  352. `:width', `:height', `:weight', `:slant', `:underline',
  353. `:overline', `:strike-through', `:box', `:foreground',
  354. `:background', `:stipple', `:inverse-video', and `:inherit'.
  355. See Info node `(elisp) Faces' in the Emacs Lisp manual for more
  356. information."
  357. (declare (doc-string 3))
  358. ;; It is better not to use backquote in this file,
  359. ;; because that makes a bootstrapping problem
  360. ;; if you need to recompile all the Lisp files using interpreted code.
  361. (nconc (list 'custom-declare-face (list 'quote face) spec doc) args))
  362. ;;; The `defgroup' Macro.
  363. (defun custom-current-group ()
  364. (cdr (assoc load-file-name custom-current-group-alist)))
  365. (defun custom-declare-group (symbol members doc &rest args)
  366. "Like `defgroup', but SYMBOL is evaluated as a normal argument."
  367. (while members
  368. (apply 'custom-add-to-group symbol (car members))
  369. (setq members (cdr members)))
  370. (when doc
  371. ;; This text doesn't get into DOC.
  372. (put symbol 'group-documentation (purecopy doc)))
  373. (while args
  374. (let ((arg (car args)))
  375. (setq args (cdr args))
  376. (unless (symbolp arg)
  377. (error "Junk in args %S" args))
  378. (let ((keyword arg)
  379. (value (car args)))
  380. (unless args
  381. (error "Keyword %s is missing an argument" keyword))
  382. (setq args (cdr args))
  383. (cond ((eq keyword :prefix)
  384. (put symbol 'custom-prefix (purecopy value)))
  385. (t
  386. (custom-handle-keyword symbol keyword value
  387. 'custom-group))))))
  388. ;; Record the group on the `current' list.
  389. (let ((elt (assoc load-file-name custom-current-group-alist)))
  390. (if elt (setcdr elt symbol)
  391. (push (cons load-file-name symbol) custom-current-group-alist)))
  392. (run-hooks 'custom-define-hook)
  393. symbol)
  394. (defmacro defgroup (symbol members doc &rest args)
  395. "Declare SYMBOL as a customization group containing MEMBERS.
  396. SYMBOL does not need to be quoted.
  397. Third argument DOC is the group documentation. This should be a short
  398. description of the group, beginning with a capital and ending with
  399. a period. Words other than the first should not be capitalized, if they
  400. are not usually written so.
  401. MEMBERS should be an alist of the form ((NAME WIDGET)...) where
  402. NAME is a symbol and WIDGET is a widget for editing that symbol.
  403. Useful widgets are `custom-variable' for editing variables,
  404. `custom-face' for editing faces, and `custom-group' for editing groups.
  405. The remaining arguments should have the form
  406. [KEYWORD VALUE]...
  407. For a list of valid keywords, see the common keywords listed in
  408. `defcustom'.
  409. See Info node `(elisp) Customization' in the Emacs Lisp manual
  410. for more information."
  411. (declare (doc-string 3))
  412. ;; It is better not to use backquote in this file,
  413. ;; because that makes a bootstrapping problem
  414. ;; if you need to recompile all the Lisp files using interpreted code.
  415. (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args))
  416. (defun custom-add-to-group (group option widget)
  417. "To existing GROUP add a new OPTION of type WIDGET.
  418. If there already is an entry for OPTION and WIDGET, nothing is done."
  419. (let ((members (get group 'custom-group))
  420. (entry (list option widget)))
  421. (unless (member entry members)
  422. (put group 'custom-group (nconc members (list entry))))))
  423. (defun custom-group-of-mode (mode)
  424. "Return the custom group corresponding to the major or minor MODE.
  425. If no such group is found, return nil."
  426. (or (get mode 'custom-mode-group)
  427. (if (or (get mode 'custom-group)
  428. (and (string-match "-mode\\'" (symbol-name mode))
  429. (get (setq mode (intern (substring (symbol-name mode)
  430. 0 (match-beginning 0))))
  431. 'custom-group)))
  432. mode)))
  433. ;;; Properties.
  434. (defun custom-handle-all-keywords (symbol args type)
  435. "For customization option SYMBOL, handle keyword arguments ARGS.
  436. Third argument TYPE is the custom option type."
  437. (unless (memq :group args)
  438. (custom-add-to-group (custom-current-group) symbol type))
  439. (while args
  440. (let ((arg (car args)))
  441. (setq args (cdr args))
  442. (unless (symbolp arg)
  443. (error "Junk in args %S" args))
  444. (let ((keyword arg)
  445. (value (car args)))
  446. (unless args
  447. (error "Keyword %s is missing an argument" keyword))
  448. (setq args (cdr args))
  449. (custom-handle-keyword symbol keyword value type)))))
  450. (defun custom-handle-keyword (symbol keyword value type)
  451. "For customization option SYMBOL, handle KEYWORD with VALUE.
  452. Fourth argument TYPE is the custom option type."
  453. (if purify-flag
  454. (setq value (purecopy value)))
  455. (cond ((eq keyword :group)
  456. (custom-add-to-group value symbol type))
  457. ((eq keyword :version)
  458. (custom-add-version symbol value))
  459. ((eq keyword :package-version)
  460. (custom-add-package-version symbol value))
  461. ((eq keyword :link)
  462. (custom-add-link symbol value))
  463. ((eq keyword :load)
  464. (custom-add-load symbol value))
  465. ((eq keyword :tag)
  466. (put symbol 'custom-tag value))
  467. ((eq keyword :set-after)
  468. (custom-add-dependencies symbol value))
  469. (t
  470. (error "Unknown keyword %s" keyword))))
  471. (defun custom-add-dependencies (symbol value)
  472. "To the custom option SYMBOL, add dependencies specified by VALUE.
  473. VALUE should be a list of symbols. For each symbol in that list,
  474. this specifies that SYMBOL should be set after the specified symbol,
  475. if both appear in constructs like `custom-set-variables'."
  476. (unless (listp value)
  477. (error "Invalid custom dependency `%s'" value))
  478. (let* ((deps (get symbol 'custom-dependencies))
  479. (new-deps deps))
  480. (while value
  481. (let ((dep (car value)))
  482. (unless (symbolp dep)
  483. (error "Invalid custom dependency `%s'" dep))
  484. (unless (memq dep new-deps)
  485. (setq new-deps (cons dep new-deps)))
  486. (setq value (cdr value))))
  487. (unless (eq deps new-deps)
  488. (put symbol 'custom-dependencies new-deps))))
  489. (defun custom-add-option (symbol option)
  490. "To the variable SYMBOL add OPTION.
  491. If SYMBOL's custom type is a hook, OPTION should be a hook member.
  492. If SYMBOL's custom type is an alist, OPTION specifies a symbol
  493. to offer to the user as a possible key in the alist.
  494. For other custom types, this has no effect."
  495. (let ((options (get symbol 'custom-options)))
  496. (unless (member option options)
  497. (put symbol 'custom-options (cons option options)))))
  498. (defalias 'custom-add-frequent-value 'custom-add-option)
  499. (defun custom-add-link (symbol widget)
  500. "To the custom option SYMBOL add the link WIDGET."
  501. (let ((links (get symbol 'custom-links)))
  502. (unless (member widget links)
  503. (put symbol 'custom-links (cons (purecopy widget) links)))))
  504. (defun custom-add-version (symbol version)
  505. "To the custom option SYMBOL add the version VERSION."
  506. (put symbol 'custom-version (purecopy version)))
  507. (defun custom-add-package-version (symbol version)
  508. "To the custom option SYMBOL add the package version VERSION."
  509. (put symbol 'custom-package-version (purecopy version)))
  510. (defun custom-add-load (symbol load)
  511. "To the custom option SYMBOL add the dependency LOAD.
  512. LOAD should be either a library file name, or a feature name."
  513. (let ((loads (get symbol 'custom-loads)))
  514. (unless (member load loads)
  515. (put symbol 'custom-loads (cons (purecopy load) loads)))))
  516. (defun custom-autoload (symbol load &optional noset)
  517. "Mark SYMBOL as autoloaded custom variable and add dependency LOAD.
  518. If NOSET is non-nil, don't bother autoloading LOAD when setting the variable."
  519. (put symbol 'custom-autoload (if noset 'noset t))
  520. (custom-add-load symbol load))
  521. (defun custom-variable-p (variable)
  522. "Return non-nil if VARIABLE is a customizable variable.
  523. A customizable variable is either (i) a variable whose property
  524. list contains a non-nil `standard-value' or `custom-autoload'
  525. property, or (ii) an alias for another customizable variable."
  526. (when (symbolp variable)
  527. (setq variable (indirect-variable variable))
  528. (or (get variable 'standard-value)
  529. (get variable 'custom-autoload))))
  530. (define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3")
  531. (defun custom-note-var-changed (variable)
  532. "Inform Custom that VARIABLE has been set (changed).
  533. VARIABLE is a symbol that names a user option.
  534. The result is that the change is treated as having been made through Custom."
  535. (put variable 'customized-value (list (custom-quote (eval variable)))))
  536. ;;; Custom Themes
  537. ;;; Loading files needed to customize a symbol.
  538. ;;; This is in custom.el because menu-bar.el needs it for toggle cmds.
  539. (defvar custom-load-recursion nil
  540. "Hack to avoid recursive dependencies.")
  541. (defun custom-load-symbol (symbol)
  542. "Load all dependencies for SYMBOL."
  543. (unless custom-load-recursion
  544. (let ((custom-load-recursion t))
  545. ;; Load these files if not already done,
  546. ;; to make sure we know all the dependencies of SYMBOL.
  547. (condition-case nil
  548. (require 'cus-load)
  549. (error nil))
  550. (condition-case nil
  551. (require 'cus-start)
  552. (error nil))
  553. (dolist (load (get symbol 'custom-loads))
  554. (cond ((symbolp load) (condition-case nil (require load) (error nil)))
  555. ;; This is subsumed by the test below, but it's much faster.
  556. ((assoc load load-history))
  557. ;; This was just (assoc (locate-library load) load-history)
  558. ;; but has been optimized not to load locate-library
  559. ;; if not necessary.
  560. ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
  561. "\\(\\'\\|\\.\\)"))
  562. (found nil))
  563. (dolist (loaded load-history)
  564. (and (stringp (car loaded))
  565. (string-match-p regexp (car loaded))
  566. (setq found t)))
  567. found))
  568. ;; Without this, we would load cus-edit recursively.
  569. ;; We are still loading it when we call this,
  570. ;; and it is not in load-history yet.
  571. ((equal load "cus-edit"))
  572. (t (condition-case nil (load load) (error nil))))))))
  573. (defvar custom-local-buffer nil
  574. "Non-nil, in a Customization buffer, means customize a specific buffer.
  575. If this variable is non-nil, it should be a buffer,
  576. and it means customize the local bindings of that buffer.
  577. This variable is a permanent local, and it normally has a local binding
  578. in every Customization buffer.")
  579. (put 'custom-local-buffer 'permanent-local t)
  580. (defun custom-set-default (variable value)
  581. "Default :set function for a customizable variable.
  582. Normally, this sets the default value of VARIABLE to VALUE,
  583. but if `custom-local-buffer' is non-nil,
  584. this sets the local binding in that buffer instead."
  585. (if custom-local-buffer
  586. (with-current-buffer custom-local-buffer
  587. (set variable value))
  588. (set-default variable value)))
  589. (defun custom-set-minor-mode (variable value)
  590. ":set function for minor mode variables.
  591. Normally, this sets the default value of VARIABLE to nil if VALUE
  592. is nil and to t otherwise,
  593. but if `custom-local-buffer' is non-nil,
  594. this sets the local binding in that buffer instead."
  595. (if custom-local-buffer
  596. (with-current-buffer custom-local-buffer
  597. (funcall variable (if value 1 0)))
  598. (funcall variable (if value 1 0))))
  599. (defun custom-quote (sexp)
  600. "Quote SEXP if it is not self quoting."
  601. (if (or (memq sexp '(t nil))
  602. (keywordp sexp)
  603. (and (listp sexp)
  604. (memq (car sexp) '(lambda)))
  605. (stringp sexp)
  606. (numberp sexp)
  607. (vectorp sexp)
  608. ;;; (and (fboundp 'characterp)
  609. ;;; (characterp sexp))
  610. )
  611. sexp
  612. (list 'quote sexp)))
  613. (defun customize-mark-to-save (symbol)
  614. "Mark SYMBOL for later saving.
  615. If the default value of SYMBOL is different from the standard value,
  616. set the `saved-value' property to a list whose car evaluates to the
  617. default value. Otherwise, set it to nil.
  618. To actually save the value, call `custom-save-all'.
  619. Return non-nil if the `saved-value' property actually changed."
  620. (custom-load-symbol symbol)
  621. (let* ((get (or (get symbol 'custom-get) 'default-value))
  622. (value (funcall get symbol))
  623. (saved (get symbol 'saved-value))
  624. (standard (get symbol 'standard-value))
  625. (comment (get symbol 'customized-variable-comment)))
  626. ;; Save default value if different from standard value.
  627. (if (or (null standard)
  628. (not (equal value (condition-case nil
  629. (eval (car standard))
  630. (error nil)))))
  631. (put symbol 'saved-value (list (custom-quote value)))
  632. (put symbol 'saved-value nil))
  633. ;; Clear customized information (set, but not saved).
  634. (put symbol 'customized-value nil)
  635. ;; Save any comment that might have been set.
  636. (when comment
  637. (put symbol 'saved-variable-comment comment))
  638. (not (equal saved (get symbol 'saved-value)))))
  639. (defun customize-mark-as-set (symbol)
  640. "Mark current value of SYMBOL as being set from customize.
  641. If the default value of SYMBOL is different from the saved value if any,
  642. or else if it is different from the standard value, set the
  643. `customized-value' property to a list whose car evaluates to the
  644. default value. Otherwise, set it to nil.
  645. Return non-nil if the `customized-value' property actually changed."
  646. (custom-load-symbol symbol)
  647. (let* ((get (or (get symbol 'custom-get) 'default-value))
  648. (value (funcall get symbol))
  649. (customized (get symbol 'customized-value))
  650. (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
  651. ;; Mark default value as set if different from old value.
  652. (if (not (and old
  653. (equal value (condition-case nil
  654. (eval (car old))
  655. (error nil)))))
  656. (progn (put symbol 'customized-value (list (custom-quote value)))
  657. (custom-push-theme 'theme-value symbol 'user 'set
  658. (custom-quote value)))
  659. (put symbol 'customized-value nil))
  660. ;; Changed?
  661. (not (equal customized (get symbol 'customized-value)))))
  662. (defun custom-reevaluate-setting (symbol)
  663. "Reset the value of SYMBOL by re-evaluating its saved or standard value.
  664. Use the :set function to do so. This is useful for customizable options
  665. that are defined before their standard value can really be computed.
  666. E.g. dumped variables whose default depends on run-time information."
  667. ;; If it has never been set at all, defvar it so as to mark it
  668. ;; special, etc (bug#25770). This means we are initializing
  669. ;; the variable, and normally any :set function would not apply.
  670. ;; For custom-initialize-delay, however, it is documented that "the
  671. ;; (delayed) initialization is performed with the :set function".
  672. ;; This is needed by eg global-font-lock-mode, which uses
  673. ;; custom-initialize-delay but needs the :set function custom-set-minor-mode
  674. ;; to also run during initialization. So, long story short, we
  675. ;; always do the funcall step, even if symbol was not bound before.
  676. (or (default-boundp symbol)
  677. (eval `(defvar ,symbol nil))) ; reset below, so any value is fine
  678. (funcall (or (get symbol 'custom-set) 'set-default)
  679. symbol
  680. (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value))))))
  681. ;;; Custom Themes
  682. ;; Custom themes are collections of settings that can be enabled or
  683. ;; disabled as a unit.
  684. ;; Each Custom theme is defined by a symbol, called the theme name.
  685. ;; The `theme-settings' property of the theme name records the
  686. ;; variable and face settings of the theme. This property is a list
  687. ;; of elements, each of the form
  688. ;;
  689. ;; (PROP SYMBOL THEME VALUE)
  690. ;;
  691. ;; - PROP is either `theme-value' or `theme-face'
  692. ;; - SYMBOL is the face or variable name
  693. ;; - THEME is the theme name (redundant, but simplifies the code)
  694. ;; - VALUE is an expression that gives the theme's setting for SYMBOL.
  695. ;;
  696. ;; The theme name also has a `theme-feature' property, whose value is
  697. ;; specified when the theme is defined (see `custom-declare-theme').
  698. ;; Usually, this is just a symbol named THEME-theme. This lets
  699. ;; external libraries call (require 'foo-theme).
  700. ;; In addition, each symbol (either a variable or a face) affected by
  701. ;; an *enabled* theme has a `theme-value' or `theme-face' property,
  702. ;; which is a list of elements each of the form
  703. ;;
  704. ;; (THEME VALUE)
  705. ;;
  706. ;; which have the same meanings as in `theme-settings'.
  707. ;;
  708. ;; The `theme-value' and `theme-face' lists are ordered by decreasing
  709. ;; theme precedence. Thus, the first element is always the one that
  710. ;; is in effect.
  711. ;; Each theme is stored in a theme file, with filename THEME-theme.el.
  712. ;; Loading a theme basically involves calling (load "THEME-theme")
  713. ;; This is done by the function `load-theme'. Loading a theme
  714. ;; automatically enables it.
  715. ;;
  716. ;; When a theme is enabled, the `theme-value' and `theme-face'
  717. ;; properties for the affected symbols are set. When a theme is
  718. ;; disabled, its settings are removed from the `theme-value' and
  719. ;; `theme-face' properties, but the theme's own `theme-settings'
  720. ;; property remains unchanged.
  721. (defvar custom-known-themes '(user changed)
  722. "Themes that have been defined with `deftheme'.
  723. The default value is the list (user changed). The theme `changed'
  724. contains the settings before custom themes are applied. The theme
  725. `user' contains all the settings the user customized and saved.
  726. Additional themes declared with the `deftheme' macro will be added
  727. to the front of this list.")
  728. (defsubst custom-theme-p (theme)
  729. "Non-nil when THEME has been defined."
  730. (memq theme custom-known-themes))
  731. (defsubst custom-check-theme (theme)
  732. "Check whether THEME is valid, and signal an error if it is not."
  733. (unless (custom-theme-p theme)
  734. (error "Unknown theme `%s'" theme)))
  735. (defun custom-push-theme (prop symbol theme mode &optional value)
  736. "Record VALUE for face or variable SYMBOL in custom theme THEME.
  737. PROP is `theme-face' for a face, `theme-value' for a variable.
  738. MODE can be either the symbol `set' or the symbol `reset'. If it is the
  739. symbol `set', then VALUE is the value to use. If it is the symbol
  740. `reset', then SYMBOL will be removed from THEME (VALUE is ignored).
  741. See `custom-known-themes' for a list of known themes."
  742. (unless (memq prop '(theme-value theme-face))
  743. (error "Unknown theme property"))
  744. (let* ((old (get symbol prop))
  745. (setting (assq theme old)) ; '(theme value)
  746. (theme-settings ; '(prop symbol theme value)
  747. (get theme 'theme-settings)))
  748. (cond
  749. ;; Remove a setting:
  750. ((eq mode 'reset)
  751. (when setting
  752. (let (res)
  753. (dolist (theme-setting theme-settings)
  754. (if (and (eq (car theme-setting) prop)
  755. (eq (cadr theme-setting) symbol))
  756. (setq res theme-setting)))
  757. (put theme 'theme-settings (delq res theme-settings)))
  758. (put symbol prop (delq setting old))))
  759. ;; Alter an existing setting:
  760. (setting
  761. (let (res)
  762. (dolist (theme-setting theme-settings)
  763. (if (and (eq (car theme-setting) prop)
  764. (eq (cadr theme-setting) symbol))
  765. (setq res theme-setting)))
  766. (put theme 'theme-settings
  767. (cons (list prop symbol theme value)
  768. (delq res theme-settings)))
  769. (setcar (cdr setting) value)))
  770. ;; Add a new setting:
  771. (t
  772. (unless custom--inhibit-theme-enable
  773. (unless old
  774. ;; If the user changed a variable outside of Customize, save
  775. ;; the value to a fake theme, `changed'. If the theme is
  776. ;; later disabled, we use this to bring back the old value.
  777. ;;
  778. ;; For faces, we just use `face-new-frame-defaults' to
  779. ;; recompute when the theme is disabled.
  780. (when (and (eq prop 'theme-value)
  781. (boundp symbol))
  782. (let ((sv (get symbol 'standard-value))
  783. (val (symbol-value symbol)))
  784. (unless (and sv (equal (eval (car sv)) val))
  785. (setq old `((changed ,(custom-quote val))))))))
  786. (put symbol prop (cons (list theme value) old)))
  787. (put theme 'theme-settings
  788. (cons (list prop symbol theme value) theme-settings))))))
  789. (defun custom-fix-face-spec (spec)
  790. "Convert face SPEC, replacing obsolete :bold and :italic attributes.
  791. Also change :reverse-video to :inverse-video."
  792. (when (listp spec)
  793. (if (or (memq :bold spec)
  794. (memq :italic spec)
  795. (memq :inverse-video spec))
  796. (let (result)
  797. (while spec
  798. (let ((key (car spec))
  799. (val (car (cdr spec))))
  800. (cond ((eq key :italic)
  801. (push :slant result)
  802. (push (if val 'italic 'normal) result))
  803. ((eq key :bold)
  804. (push :weight result)
  805. (push (if val 'bold 'normal) result))
  806. ((eq key :reverse-video)
  807. (push :inverse-video result)
  808. (push val result))
  809. (t
  810. (push key result)
  811. (push val result))))
  812. (setq spec (cddr spec)))
  813. (nreverse result))
  814. spec)))
  815. (defun custom-set-variables (&rest args)
  816. "Install user customizations of variable values specified in ARGS.
  817. These settings are registered as theme `user'.
  818. The arguments should each be a list of the form:
  819. (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
  820. This stores EXP (without evaluating it) as the saved value for SYMBOL.
  821. If NOW is present and non-nil, then also evaluate EXP and set
  822. the default value for the SYMBOL to the value of EXP.
  823. REQUEST is a list of features we must require in order to
  824. handle SYMBOL properly.
  825. COMMENT is a comment string about SYMBOL."
  826. (apply 'custom-theme-set-variables 'user args))
  827. (defun custom-theme-set-variables (theme &rest args)
  828. "Initialize variables for theme THEME according to settings in ARGS.
  829. Each of the arguments in ARGS should be a list of this form:
  830. (SYMBOL EXP [NOW [REQUEST [COMMENT]]])
  831. SYMBOL is the variable name, and EXP is an expression which
  832. evaluates to the customized value. EXP will also be stored,
  833. without evaluating it, in SYMBOL's `saved-value' property, so
  834. that it can be restored via the Customize interface. It is also
  835. added to the alist in SYMBOL's `theme-value' property (by
  836. calling `custom-push-theme').
  837. NOW, if present and non-nil, means to install the variable's
  838. value directly now, even if its `defcustom' declaration has not
  839. been executed. This is for internal use only.
  840. REQUEST is a list of features to `require' (which are loaded
  841. prior to evaluating EXP).
  842. COMMENT is a comment string about SYMBOL."
  843. (custom-check-theme theme)
  844. ;; Process all the needed autoloads before anything else, so that the
  845. ;; subsequent code has all the info it needs (e.g. which var corresponds
  846. ;; to a minor mode), regardless of the ordering of the variables.
  847. (dolist (entry args)
  848. (let* ((symbol (indirect-variable (nth 0 entry))))
  849. (unless (or (get symbol 'standard-value)
  850. (memq (get symbol 'custom-autoload) '(nil noset)))
  851. ;; This symbol needs to be autoloaded, even just for a `set'.
  852. (custom-load-symbol symbol))))
  853. (setq args (custom--sort-vars args))
  854. (dolist (entry args)
  855. (unless (listp entry)
  856. (error "Incompatible Custom theme spec"))
  857. (let* ((symbol (indirect-variable (nth 0 entry)))
  858. (value (nth 1 entry)))
  859. (custom-push-theme 'theme-value symbol theme 'set value)
  860. (unless custom--inhibit-theme-enable
  861. ;; Now set the variable.
  862. (let* ((now (nth 2 entry))
  863. (requests (nth 3 entry))
  864. (comment (nth 4 entry))
  865. set)
  866. (when requests
  867. (put symbol 'custom-requests requests)
  868. (mapc 'require requests))
  869. (setq set (or (get symbol 'custom-set) 'custom-set-default))
  870. (put symbol 'saved-value (list value))
  871. (put symbol 'saved-variable-comment comment)
  872. ;; Allow for errors in the case where the setter has
  873. ;; changed between versions, say, but let the user know.
  874. (condition-case data
  875. (cond (now
  876. ;; Rogue variable, set it now.
  877. (put symbol 'force-value t)
  878. (funcall set symbol (eval value)))
  879. ((default-boundp symbol)
  880. ;; Something already set this, overwrite it.
  881. (funcall set symbol (eval value))))
  882. (error
  883. (message "Error setting %s: %s" symbol data)))
  884. (and (or now (default-boundp symbol))
  885. (put symbol 'variable-comment comment)))))))
  886. (defvar custom--sort-vars-table)
  887. (defvar custom--sort-vars-result)
  888. (defun custom--sort-vars (vars)
  889. "Sort VARS based on custom dependencies.
  890. VARS is a list whose elements have the same form as the ARGS
  891. arguments to `custom-theme-set-variables'. Return the sorted
  892. list, in which A occurs before B if B was defined with a
  893. `:set-after' keyword specifying A (see `defcustom')."
  894. (let ((custom--sort-vars-table (make-hash-table))
  895. (dependants (make-hash-table))
  896. (custom--sort-vars-result nil)
  897. last)
  898. ;; Construct a pair of tables keyed with the symbols of VARS.
  899. (dolist (var vars)
  900. (puthash (car var) (cons t var) custom--sort-vars-table)
  901. (puthash (car var) var dependants))
  902. ;; From the second table, remove symbols that are depended-on.
  903. (dolist (var vars)
  904. (dolist (dep (get (car var) 'custom-dependencies))
  905. (remhash dep dependants)))
  906. ;; If a variable is "stand-alone", put it last if it's a minor
  907. ;; mode or has a :require flag. This is not really necessary, but
  908. ;; putting minor modes last helps ensure that the mode function
  909. ;; sees other customized values rather than default values.
  910. (maphash (lambda (sym var)
  911. (when (and (null (get sym 'custom-dependencies))
  912. (or (nth 3 var)
  913. (eq (get sym 'custom-set)
  914. 'custom-set-minor-mode)))
  915. (remhash sym dependants)
  916. (push var last)))
  917. dependants)
  918. ;; The remaining symbols depend on others but are not
  919. ;; depended-upon. Do a depth-first topological sort.
  920. (maphash #'custom--sort-vars-1 dependants)
  921. (nreverse (append last custom--sort-vars-result))))
  922. (defun custom--sort-vars-1 (sym &optional _ignored)
  923. (let ((elt (gethash sym custom--sort-vars-table)))
  924. ;; The car of the hash table value is nil if the variable has
  925. ;; already been processed, `dependant' if it is a dependant in the
  926. ;; current graph descent, and t otherwise.
  927. (when elt
  928. (cond
  929. ((eq (car elt) 'dependant)
  930. (error "Circular custom dependency on `%s'" sym))
  931. ((car elt)
  932. (setcar elt 'dependant)
  933. (dolist (dep (get sym 'custom-dependencies))
  934. (custom--sort-vars-1 dep))
  935. (setcar elt nil)
  936. (push (cdr elt) custom--sort-vars-result))))))
  937. ;;; Defining themes.
  938. ;; A theme file is named `THEME-theme.el' (where THEME is the theme
  939. ;; name) found in `custom-theme-load-path'. It has this format:
  940. ;;
  941. ;; (deftheme THEME
  942. ;; DOCSTRING)
  943. ;;
  944. ;; (custom-theme-set-variables
  945. ;; 'THEME
  946. ;; [THEME-VARIABLES])
  947. ;;
  948. ;; (custom-theme-set-faces
  949. ;; 'THEME
  950. ;; [THEME-FACES])
  951. ;;
  952. ;; (provide-theme 'THEME)
  953. ;; The IGNORED arguments to deftheme come from the XEmacs theme code, where
  954. ;; they were used to supply keyword-value pairs like `:immediate',
  955. ;; `:variable-reset-string', etc. We don't use any of these, so ignore them.
  956. (defmacro deftheme (theme &optional doc &rest ignored)
  957. "Declare THEME to be a Custom theme.
  958. The optional argument DOC is a doc string describing the theme.
  959. Any theme `foo' should be defined in a file called `foo-theme.el';
  960. see `custom-make-theme-feature' for more information."
  961. (declare (doc-string 2))
  962. (let ((feature (custom-make-theme-feature theme)))
  963. ;; It is better not to use backquote in this file,
  964. ;; because that makes a bootstrapping problem
  965. ;; if you need to recompile all the Lisp files using interpreted code.
  966. (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc)))
  967. (defun custom-declare-theme (theme feature &optional doc &rest ignored)
  968. "Like `deftheme', but THEME is evaluated as a normal argument.
  969. FEATURE is the feature this theme provides. Normally, this is a symbol
  970. created from THEME by `custom-make-theme-feature'."
  971. (unless (custom-theme-name-valid-p theme)
  972. (error "Custom theme cannot be named %S" theme))
  973. (add-to-list 'custom-known-themes theme)
  974. (put theme 'theme-feature feature)
  975. (when doc (put theme 'theme-documentation doc)))
  976. (defun custom-make-theme-feature (theme)
  977. "Given a symbol THEME, create a new symbol by appending \"-theme\".
  978. Store this symbol in the `theme-feature' property of THEME.
  979. Calling `provide-theme' to provide THEME actually puts `THEME-theme'
  980. into `features'.
  981. This allows for a file-name convention for autoloading themes:
  982. Every theme X has a property `provide-theme' whose value is \"X-theme\".
  983. \(load-theme X) then attempts to load the file `X-theme.el'."
  984. (intern (concat (symbol-name theme) "-theme")))
  985. ;;; Loading themes.
  986. (defcustom custom-theme-directory user-emacs-directory
  987. "Default user directory for storing custom theme files.
  988. The command `customize-create-theme' writes theme files into this
  989. directory. By default, Emacs searches for custom themes in this
  990. directory first---see `custom-theme-load-path'."
  991. :type 'string
  992. :group 'customize
  993. :version "22.1")
  994. (defvar custom-theme-load-path (list 'custom-theme-directory t)
  995. "List of directories to search for custom theme files.
  996. When loading custom themes (e.g. in `customize-themes' and
  997. `load-theme'), Emacs searches for theme files in the specified
  998. order. Each element in the list should be one of the following:
  999. - the symbol `custom-theme-directory', meaning the value of
  1000. `custom-theme-directory'.
  1001. - the symbol t, meaning the built-in theme directory (a directory
  1002. named \"themes\" in `data-directory').
  1003. - a directory name (a string).
  1004. Each theme file is named THEME-theme.el, where THEME is the theme
  1005. name.
  1006. This variable is designed for use in lisp code (including
  1007. external packages). For manual user customizations, use
  1008. `custom-theme-directory' instead.")
  1009. (defvar custom--inhibit-theme-enable nil
  1010. "Whether the custom-theme-set-* functions act immediately.
  1011. If nil, `custom-theme-set-variables' and `custom-theme-set-faces'
  1012. change the current values of the given variable or face. If
  1013. non-nil, they just make a record of the theme settings.")
  1014. (defun provide-theme (theme)
  1015. "Indicate that this file provides THEME.
  1016. This calls `provide' to provide the feature name stored in THEME's
  1017. property `theme-feature' (which is usually a symbol created by
  1018. `custom-make-theme-feature')."
  1019. (unless (custom-theme-name-valid-p theme)
  1020. (error "Custom theme cannot be named %S" theme))
  1021. (custom-check-theme theme)
  1022. (provide (get theme 'theme-feature)))
  1023. (defcustom custom-safe-themes '(default)
  1024. "Themes that are considered safe to load.
  1025. If the value is a list, each element should be either the SHA-256
  1026. hash of a safe theme file, or the symbol `default', which stands
  1027. for any theme in the built-in Emacs theme directory (a directory
  1028. named \"themes\" in `data-directory').
  1029. If the value is t, Emacs treats all themes as safe.
  1030. This variable cannot be set in a Custom theme."
  1031. :type '(choice (repeat :tag "List of safe themes"
  1032. (choice string
  1033. (const :tag "Built-in themes" default)))
  1034. (const :tag "All themes" t))
  1035. :group 'customize
  1036. :risky t
  1037. :version "24.1")
  1038. (defun load-theme (theme &optional no-confirm no-enable)
  1039. "Load Custom theme named THEME from its file.
  1040. The theme file is named THEME-theme.el, in one of the directories
  1041. specified by `custom-theme-load-path'.
  1042. If the theme is not considered safe by `custom-safe-themes',
  1043. prompt the user for confirmation before loading it. But if
  1044. optional arg NO-CONFIRM is non-nil, load the theme without
  1045. prompting.
  1046. Normally, this function also enables THEME. If optional arg
  1047. NO-ENABLE is non-nil, load the theme but don't enable it, unless
  1048. the theme was already enabled.
  1049. This function is normally called through Customize when setting
  1050. `custom-enabled-themes'. If used directly in your init file, it
  1051. should be called with a non-nil NO-CONFIRM argument, or after
  1052. `custom-safe-themes' has been loaded.
  1053. Return t if THEME was successfully loaded, nil otherwise."
  1054. (interactive
  1055. (list
  1056. (intern (completing-read "Load custom theme: "
  1057. (mapcar 'symbol-name
  1058. (custom-available-themes))))
  1059. nil nil))
  1060. (unless (custom-theme-name-valid-p theme)
  1061. (error "Invalid theme name `%s'" theme))
  1062. ;; If THEME is already enabled, re-enable it after loading, even if
  1063. ;; NO-ENABLE is t.
  1064. (if no-enable
  1065. (setq no-enable (not (custom-theme-enabled-p theme))))
  1066. ;; If reloading, clear out the old theme settings.
  1067. (when (custom-theme-p theme)
  1068. (disable-theme theme)
  1069. (put theme 'theme-settings nil)
  1070. (put theme 'theme-feature nil)
  1071. (put theme 'theme-documentation nil))
  1072. (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
  1073. (custom-theme--load-path)
  1074. '("" "c"))))
  1075. (unless fn
  1076. (error "Unable to find theme file for `%s'" theme))
  1077. (with-temp-buffer
  1078. (insert-file-contents fn)
  1079. ;; Check file safety with `custom-safe-themes', prompting the
  1080. ;; user if necessary.
  1081. (when (or no-confirm
  1082. (eq custom-safe-themes t)
  1083. (and (memq 'default custom-safe-themes)
  1084. (equal (file-name-directory fn)
  1085. (expand-file-name "themes/" data-directory)))
  1086. (let ((hash (secure-hash 'sha256 (current-buffer))))
  1087. (or (member hash custom-safe-themes)
  1088. (custom-theme-load-confirm hash))))
  1089. (let ((custom--inhibit-theme-enable t)
  1090. (buffer-file-name fn)) ;For load-history.
  1091. (eval-buffer))
  1092. ;; Optimization: if the theme changes the `default' face, put that
  1093. ;; entry first. This avoids some `frame-set-background-mode' rigmarole
  1094. ;; by assigning the new background immediately.
  1095. (let* ((settings (get theme 'theme-settings))
  1096. (tail settings)
  1097. found)
  1098. (while (and tail (not found))
  1099. (and (eq (nth 0 (car tail)) 'theme-face)
  1100. (eq (nth 1 (car tail)) 'default)
  1101. (setq found (car tail)))
  1102. (setq tail (cdr tail)))
  1103. (if found
  1104. (put theme 'theme-settings (cons found (delq found settings)))))
  1105. ;; Finally, enable the theme.
  1106. (unless no-enable
  1107. (enable-theme theme))
  1108. t))))
  1109. (defun custom-theme-load-confirm (hash)
  1110. "Query the user about loading a Custom theme that may not be safe.
  1111. The theme should be in the current buffer. If the user agrees,
  1112. query also about adding HASH to `custom-safe-themes'."
  1113. (unless noninteractive
  1114. (save-window-excursion
  1115. (rename-buffer "*Custom Theme*" t)
  1116. (emacs-lisp-mode)
  1117. (pop-to-buffer (current-buffer))
  1118. (goto-char (point-min))
  1119. (prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ")
  1120. ;; Offer to save to `custom-safe-themes'.
  1121. (and (or custom-file user-init-file)
  1122. (y-or-n-p "Treat this theme as safe in future sessions? ")
  1123. (customize-push-and-save 'custom-safe-themes (list hash)))
  1124. t)
  1125. (quit-window)))))
  1126. (defun custom-theme-name-valid-p (name)
  1127. "Return t if NAME is a valid name for a Custom theme, nil otherwise.
  1128. NAME should be a symbol."
  1129. (and (symbolp name)
  1130. name
  1131. (not (or (zerop (length (symbol-name name)))
  1132. (eq name 'user)
  1133. (eq name 'changed)))))
  1134. (defun custom-available-themes ()
  1135. "Return a list of Custom themes available for loading.
  1136. Search the directories specified by `custom-theme-load-path' for
  1137. files named FOO-theme.el, and return a list of FOO symbols.
  1138. The returned symbols may not correspond to themes that have been
  1139. loaded, and no effort is made to check that the files contain
  1140. valid Custom themes. For a list of loaded themes, check the
  1141. variable `custom-known-themes'."
  1142. (let (sym themes)
  1143. (dolist (dir (custom-theme--load-path))
  1144. (when (file-directory-p dir)
  1145. (dolist (file (file-expand-wildcards
  1146. (expand-file-name "*-theme.el" dir) t))
  1147. (setq file (file-name-nondirectory file))
  1148. (and (string-match "\\`\\(.+\\)-theme.el\\'" file)
  1149. (setq sym (intern (match-string 1 file)))
  1150. (custom-theme-name-valid-p sym)
  1151. (push sym themes)))))
  1152. (nreverse (delete-dups themes))))
  1153. (defun custom-theme--load-path ()
  1154. (let (lpath)
  1155. (dolist (f custom-theme-load-path)
  1156. (cond ((eq f 'custom-theme-directory)
  1157. (setq f custom-theme-directory))
  1158. ((eq f t)
  1159. (setq f (expand-file-name "themes" data-directory))))
  1160. (if (file-directory-p f)
  1161. (push f lpath)))
  1162. (nreverse lpath)))
  1163. ;;; Enabling and disabling loaded themes.
  1164. (defun enable-theme (theme)
  1165. "Reenable all variable and face settings defined by THEME.
  1166. THEME should be either `user', or a theme loaded via `load-theme'.
  1167. After this function completes, THEME will have the highest
  1168. precedence (after `user')."
  1169. (interactive (list (intern
  1170. (completing-read
  1171. "Enable custom theme: "
  1172. obarray (lambda (sym) (get sym 'theme-settings)) t))))
  1173. (if (not (custom-theme-p theme))
  1174. (error "Undefined Custom theme %s" theme))
  1175. (let ((settings (get theme 'theme-settings)))
  1176. ;; Loop through theme settings, recalculating vars/faces.
  1177. (dolist (s settings)
  1178. (let* ((prop (car s))
  1179. (symbol (cadr s))
  1180. (spec-list (get symbol prop)))
  1181. (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
  1182. (cond
  1183. ((eq prop 'theme-face)
  1184. (custom-theme-recalc-face symbol))
  1185. ((eq prop 'theme-value)
  1186. ;; Ignore `custom-enabled-themes' and `custom-safe-themes'.
  1187. (unless (memq symbol '(custom-enabled-themes custom-safe-themes))
  1188. (custom-theme-recalc-variable symbol)))))))
  1189. (unless (eq theme 'user)
  1190. (setq custom-enabled-themes
  1191. (cons theme (delq theme custom-enabled-themes)))
  1192. ;; Give the `user' theme the highest priority.
  1193. (enable-theme 'user)))
  1194. (defcustom custom-enabled-themes nil
  1195. "List of enabled Custom Themes, highest precedence first.
  1196. This list does not include the `user' theme, which is set by
  1197. Customize and always takes precedence over other Custom Themes.
  1198. This variable cannot be defined inside a Custom theme; there, it
  1199. is simply ignored.
  1200. Setting this variable through Customize calls `enable-theme' or
  1201. `load-theme' for each theme in the list."
  1202. :group 'customize
  1203. :type '(repeat symbol)
  1204. :set-after '(custom-theme-directory custom-theme-load-path
  1205. custom-safe-themes)
  1206. :risky t
  1207. :set (lambda (symbol themes)
  1208. (let (failures)
  1209. (setq themes (delq 'user (delete-dups themes)))
  1210. ;; Disable all themes not in THEMES.
  1211. (if (boundp symbol)
  1212. (dolist (theme (symbol-value symbol))
  1213. (if (not (memq theme themes))
  1214. (disable-theme theme))))
  1215. ;; Call `enable-theme' or `load-theme' on each of THEMES.
  1216. (dolist (theme (reverse themes))
  1217. (condition-case nil
  1218. (if (custom-theme-p theme)
  1219. (enable-theme theme)
  1220. (load-theme theme))
  1221. (error (setq failures (cons theme failures)
  1222. themes (delq theme themes)))))
  1223. (enable-theme 'user)
  1224. (custom-set-default symbol themes)
  1225. (if failures
  1226. (message "Failed to enable theme: %s"
  1227. (mapconcat 'symbol-name failures ", "))))))
  1228. (defsubst custom-theme-enabled-p (theme)
  1229. "Return non-nil if THEME is enabled."
  1230. (memq theme custom-enabled-themes))
  1231. (defun disable-theme (theme)
  1232. "Disable all variable and face settings defined by THEME.
  1233. See `custom-enabled-themes' for a list of enabled themes."
  1234. (interactive (list (intern
  1235. (completing-read
  1236. "Disable custom theme: "
  1237. (mapcar 'symbol-name custom-enabled-themes)
  1238. nil t))))
  1239. (when (custom-theme-enabled-p theme)
  1240. (let ((settings (get theme 'theme-settings)))
  1241. (dolist (s settings)
  1242. (let* ((prop (car s))
  1243. (symbol (cadr s))
  1244. (val (assq-delete-all theme (get symbol prop))))
  1245. (put symbol prop val)
  1246. (cond
  1247. ((eq prop 'theme-value)
  1248. (custom-theme-recalc-variable symbol))
  1249. ((eq prop 'theme-face)
  1250. ;; If the face spec specified by this theme is in the
  1251. ;; saved-face property, reset that property.
  1252. (when (equal (nth 3 s) (get symbol 'saved-face))
  1253. (put symbol 'saved-face (and val (cadr (car val)))))))))
  1254. ;; Recompute faces on all frames.
  1255. (dolist (frame (frame-list))
  1256. ;; We must reset the fg and bg color frame parameters, or
  1257. ;; `face-set-after-frame-default' will use the existing
  1258. ;; parameters, which could be from the disabled theme.
  1259. (set-frame-parameter frame 'background-color
  1260. (custom--frame-color-default
  1261. frame :background "background" "Background"
  1262. "unspecified-bg" "white"))
  1263. (set-frame-parameter frame 'foreground-color
  1264. (custom--frame-color-default
  1265. frame :foreground "foreground" "Foreground"
  1266. "unspecified-fg" "black"))
  1267. (face-set-after-frame-default frame))
  1268. (setq custom-enabled-themes
  1269. (delq theme custom-enabled-themes)))))
  1270. ;; Only used if window-system not null.
  1271. (declare-function x-get-resource "frame.c"
  1272. (attribute class &optional component subclass))
  1273. (defun custom--frame-color-default (frame attribute resource-attr resource-class
  1274. tty-default x-default)
  1275. (let ((col (face-attribute 'default attribute t)))
  1276. (cond
  1277. ((and col (not (eq col 'unspecified))) col)
  1278. ((null (window-system frame)) tty-default)
  1279. ((setq col (x-get-resource resource-attr resource-class)) col)
  1280. (t x-default))))
  1281. (defun custom-variable-theme-value (variable)
  1282. "Return (list VALUE) indicating the custom theme value of VARIABLE.
  1283. That is to say, it specifies what the value should be according to
  1284. currently enabled custom themes.
  1285. This function returns nil if no custom theme specifies a value for VARIABLE."
  1286. (let ((theme-value (get variable 'theme-value)))
  1287. (if theme-value
  1288. (cdr (car theme-value)))))
  1289. (defun custom-theme-recalc-variable (variable)
  1290. "Set VARIABLE according to currently enabled custom themes."
  1291. (let ((valspec (custom-variable-theme-value variable)))
  1292. (if valspec
  1293. (put variable 'saved-value valspec)
  1294. (setq valspec (get variable 'standard-value)))
  1295. (if (and valspec
  1296. (or (get variable 'force-value)
  1297. (default-boundp variable)))
  1298. (funcall (or (get variable 'custom-set) 'set-default) variable
  1299. (eval (car valspec))))))
  1300. (defun custom-theme-recalc-face (face)
  1301. "Set FACE according to currently enabled custom themes.
  1302. If FACE is not initialized as a face, do nothing; otherwise call
  1303. `face-spec-recalc' to recalculate the face on all frames."
  1304. (if (get face 'face-alias)
  1305. (setq face (get face 'face-alias)))
  1306. (if (facep face)
  1307. ;; Reset the faces for each frame.
  1308. (dolist (frame (frame-list))
  1309. (face-spec-recalc face frame))))
  1310. ;;; XEmacs compatibility functions
  1311. ;; In XEmacs, when you reset a Custom Theme, you have to specify the
  1312. ;; theme to reset it to. We just apply the next available theme, so
  1313. ;; just ignore the IGNORED arguments.
  1314. (defun custom-theme-reset-variables (theme &rest args)
  1315. "Reset some variable settings in THEME to their values in other themes.
  1316. Each of the arguments ARGS has this form:
  1317. (VARIABLE IGNORED)
  1318. This means reset VARIABLE. (The argument IGNORED is ignored)."
  1319. (custom-check-theme theme)
  1320. (dolist (arg args)
  1321. (custom-push-theme 'theme-value (car arg) theme 'reset)))
  1322. (defun custom-reset-variables (&rest args)
  1323. "Reset the specs of some variables to their values in other themes.
  1324. This creates settings in the `user' theme.
  1325. Each of the arguments ARGS has this form:
  1326. (VARIABLE IGNORED)
  1327. This means reset VARIABLE. (The argument IGNORED is ignored)."
  1328. (apply 'custom-theme-reset-variables 'user args))
  1329. ;;; The End.
  1330. (provide 'custom)
  1331. ;;; custom.el ends here