aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog179
-rw-r--r--lisp/calculator.el5
-rw-r--r--lisp/cus-edit.el652
-rw-r--r--lisp/diff-mode.el4
-rw-r--r--lisp/emulation/pc-select.el3
-rw-r--r--lisp/epg-config.el2
-rw-r--r--lisp/erc/ChangeLog4
-rw-r--r--lisp/facemenu.el106
-rw-r--r--lisp/files.el32
-rw-r--r--lisp/hl-line.el2
-rw-r--r--lisp/image-mode.el2
-rw-r--r--lisp/image.el108
-rw-r--r--lisp/language/misc-lang.el8
-rw-r--r--lisp/log-edit.el3
-rw-r--r--lisp/log-view.el3
-rw-r--r--lisp/mail/metamail.el1
-rw-r--r--lisp/mail/rfc822.el56
-rw-r--r--lisp/mh-e/ChangeLog4
-rw-r--r--lisp/net/ange-ftp.el1
-rw-r--r--lisp/net/browse-url.el3
-rw-r--r--lisp/net/goto-addr.el2
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el2
-rw-r--r--lisp/net/tramp-imap.el2
-rw-r--r--lisp/net/tramp.el1
-rw-r--r--lisp/net/xesam.el2
-rw-r--r--lisp/nxml/nxml-mode.el3
-rw-r--r--lisp/org/ChangeLog8
-rw-r--r--lisp/org/org.el1
-rw-r--r--lisp/outline.el2
-rw-r--r--lisp/ps-print.el2
-rw-r--r--lisp/reveal.el2
-rw-r--r--lisp/textmodes/picture.el2
-rw-r--r--lisp/textmodes/table.el6
-rw-r--r--lisp/textmodes/text-mode.el2
-rw-r--r--lisp/uniquify.el2
-rw-r--r--lisp/url/ChangeLog8
-rw-r--r--lisp/url/url-vars.el2
-rw-r--r--lisp/vc-annotate.el3
-rw-r--r--lisp/vc-bzr.el65
-rw-r--r--lisp/vc-dir.el1
-rw-r--r--lisp/vc-git.el8
-rw-r--r--lisp/vcursor.el2
-rw-r--r--lisp/version.el2
-rw-r--r--lisp/view.el3
-rw-r--r--lisp/whitespace.el3
-rw-r--r--lisp/wid-edit.el82
47 files changed, 907 insertions, 491 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 512e83999ab..5dc59f3cf1c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,172 @@
12010-03-12 Chong Yidong <cyd@stupidchicken.com>
2
3 * facemenu.el (list-colors-display, list-colors-print): New arg
4 callback. Use it to allow selecting colors.
5
6 * wid-edit.el (widget-image-insert): Insert image prop even if the
7 current display is non-graphic.
8 (widget-field-value-set): New fun.
9 (editable-field): Use it.
10 (widget-field-value-get): Clean up unused var.
11 (widget-color-value-create, widget-color--choose-action): New
12 funs. Allow using list-colors-display to choose color.
13
142010-03-12 Chong Yidong <cyd@stupidchicken.com>
15
16 * cus-edit.el: Resort topmost custom groups.
17 (custom-buffer-sort-alphabetically): Default to t.
18 (customize-apropos): Use apropos-parse-pattern.
19 (custom-search-field): New var.
20 (custom-buffer-create-internal): Add custom-apropos search field.
21 (custom-add-parent-links): Don't display parent doc.
22 (custom-group-value-create): Don't sort top-level custom group.
23 (custom-magic-value-create): Show visibility button before option
24 name.
25
26 (custom-variable-state): New fun, from custom-variable-state-set.
27 (custom-variable-state-set): Use it.
28 (custom-group-value-create): Hide options with standard values
29 using the :hidden-states property. Use progress reporter.
30
31 (custom-show): Simplify.
32 (custom-visibility): Disable images by default.
33 (custom-variable): New property :hidden-states.
34 (custom-variable-value-create): Enable images for
35 custom-visibility widgets. Use :hidden-states property to
36 determine initial visibility.
37
38 * wid-edit.el (widget-image-find): Give images center ascent.
39 (visibility): Add :on-image and :off-image properties.
40 (widget-visibility-value-create): Use them.
41
422010-03-12 Chong Yidong <cyd@stupidchicken.com>
43
44 * cus-edit.el (processes): Remove from development group.
45 (oop, hypermedia): Delete group.
46 (comm): Promote to top-level group.
47
48 * net/browse-url.el (browse-url):
49 * net/xesam.el (xesam):
50 * net/tramp.el (tramp):
51 * net/goto-addr.el (goto-address):
52 * net/ange-ftp.el (ange-ftp): Put in comm group.
53
54 * view.el (view): Remove from editing group.
55
56 * uniquify.el (uniquify): Put in files group.
57
58 * net/browse-url.el (browse-url):
59 * ps-print.el (postscript): Put in external group.
60
61 * cus-edit.el (outlines):
62 * textmodes/text-mode.el (text-mode-hook):
63 * textmodes/table.el (table):
64 * textmodes/picture.el (picture):
65 * outline.el (outlines): Put in wp group.
66
67 * nxml/nxml-mode.el (nxml): Remove from wp group.
68
69 * net/tramp-imap.el (tramp-imap): Put in tramp group.
70
71 * mail/metamail.el (metamail): Remove from hypermedia group.
72
73 * cus-edit.el (abbrev):
74 * whitespace.el (whitespace):
75 * vcursor.el (vcursor):
76 * reveal.el (reveal):
77 * hl-line.el (hl-line): Put in convenience group.
78
79 * epg-config.el (epg): Put in data group.
80
81 * emulation/pc-select.el (pc-select): Put in emulations group.
82
83 * calculator.el (calculator): Put in applications group.
84
852010-03-12 Dan Nicolaescu <dann@ics.uci.edu>
86
87 Add .dir-locals.el support for file-less buffers.
88 * files.el (hack-local-variables): Split out code to apply local
89 variable settings ...
90 (hack-local-variables-apply): ... here. New function.
91 (hack-dir-local-variables): Use the default directory for when the
92 buffer does not have an associated file.
93 (hack-dir-local-variables-non-file-buffer): New function.
94 * diff-mode.el (diff-mode):
95 * vc-annotate.el (vc-annotate-mode):
96 * vc-dir.el (vc-dir-mode):
97 * log-edit.el (log-edit-mode):
98 * log-view.el (log-view-mode): Call hack-dir-local-variables-non-file-buffer.
99
1002010-03-12 Dan Nicolaescu <dann@ics.uci.edu>
101
102 Add support for shelving snapshots and for showing shelves.
103 * vc-bzr.el (vc-bzr-shelve-show, vc-bzr-shelve-show-at-point)
104 (vc-bzr-shelve-apply-and-keep-at-point, vc-bzr-shelve-snapshot):
105 New functions.
106 (vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
107 (vc-bzr-extra-menu-map): Map them.
108
1092010-03-11 Glenn Morris <rgm@gnu.org>
110
111 * cus-edit.el (customize-changed-options-previous-release):
112 Bump to 23.1.
113
114 * image.el (image-animate-max-time): Fix :version tag.
115
1162010-03-10 Chong Yidong <cyd@stupidchicken.com>
117
118 * Branch for 23.2.
119
1202010-03-10 Stefan Monnier <monnier@iro.umontreal.ca>
121
122 * vc-git.el (vc-git-revision-table): Include remote branches.
123
1242010-03-10 Kim F. Storm <storm@cua.dk>
125
126 Animated image API.
127 http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00211.html
128
129 * image.el (image-animate-max-time): New defcustom.
130 (image-animated-types): New defconst.
131 (create-animated-image, image-animate-timer)
132 (image-animate-start, image-animate-stop, image-animate-timeout)
133 (image-animated-p): New functions.
134
135 * image-mode.el (image-toggle-display-image):
136 Replace `create-image' with `create-animated-image'.
137
1382010-03-09 Miles Bader <Miles Bader <miles@gnu.org>>
139
140 * vc-git.el (vc-git-print-log): Use "tformat:" for shortlog,
141 instead of "format:"; this ensures that the output is
142 newline-terminated.
143
1442010-03-08 Chong Yidong <cyd@stupidchicken.com>
145
146 * mail/rfc822.el (rfc822-addresses): Use nested catches to ensure
147 that all errors are caught, and that the return value is always a
148 list (Bug#5692).
149
1502010-03-08 Kenichi Handa <handa@m17n.org>
151
152 * language/misc-lang.el (windows-1256): New coding system.
153 (cp1256): New alias of windows-1256 (bug#5690).
154
1552010-03-07 Andreas Schwab <schwab@linux-m68k.org>
156
157 * mail/rfc822.el (rfc822-addresses): Move catch clause down around
158 call to rfc822-bad-address. (Bug#5692)
159
1602010-03-07 Štěpán Němec <stepnem@gmail.com> (tiny change)
161
162 * vc-git.el (vc-git-annotate-extract-revision-at-line): Use
163 vc-git-root as default directory for revision path (Bug#5657).
164
1652010-03-06 Chong Yidong <cyd@stupidchicken.com>
166
167 * calculator.el (calculator): Don't bind split-window-keep-point
168 (Bug#5674).
169
12010-03-06 Stefan Monnier <monnier@iro.umontreal.ca> 1702010-03-06 Stefan Monnier <monnier@iro.umontreal.ca>
2 171
3 * vc-git.el: Re-flow to fit into 80 columns. 172 * vc-git.el: Re-flow to fit into 80 columns.
@@ -61,7 +230,7 @@
612010-03-01 Alan Mackenzie <bug-cc-mode@gnu.org> 2302010-03-01 Alan Mackenzie <bug-cc-mode@gnu.org>
62 231
63 * cc-engine.el (c-remove-stale-state-cache): Take account of when 232 * cc-engine.el (c-remove-stale-state-cache): Take account of when
64 `good-pos' is in the same macro as `here'. Fixes bug 5649. 233 `good-pos' is in the same macro as `here'. Fixes bug#5649.
65 234
662010-02-28 Katsumi Yamaoka <yamaoka@jpl.org> 2352010-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
67 236
@@ -170,8 +339,8 @@
170 339
1712010-02-20 Kevin Ryde <user42@zip.com.au> 3402010-02-20 Kevin Ryde <user42@zip.com.au>
172 341
173 * progmodes/compile.el (compilation-error-regexp-alist-alist): In 342 * progmodes/compile.el (compilation-error-regexp-alist-alist):
174 `watcom' anchor regexp to start of line, to avoid slowness 343 In `watcom' anchor regexp to start of line, to avoid slowness
175 (Bug#5599). 344 (Bug#5599).
176 345
1772010-02-20 Eli Zaretskii <eliz@gnu.org> 3462010-02-20 Eli Zaretskii <eliz@gnu.org>
@@ -236,9 +405,9 @@
236 405
2372010-02-17 Mark A. Hershberger <mah@everybody.org> 4062010-02-17 Mark A. Hershberger <mah@everybody.org>
238 407
239 * vc-bzr.el: fix typo in Known Bugs section. 408 * vc-bzr.el: Fix typo in Known Bugs section.
240 409
241 * isearch.el (isearch-update-post-hook): New hook 410 * isearch.el (isearch-update-post-hook): New hook.
242 (isearch-update): Use the new hook. 411 (isearch-update): Use the new hook.
243 412
2442010-02-16 Michael Albinus <michael.albinus@gmx.de> 4132010-02-16 Michael Albinus <michael.albinus@gmx.de>
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 015fb4cd763..a20efdbc122 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -54,7 +54,7 @@
54 :prefix "calculator" 54 :prefix "calculator"
55 :version "21.1" 55 :version "21.1"
56 :group 'tools 56 :group 'tools
57 :group 'convenience) 57 :group 'applications)
58 58
59(defcustom calculator-electric-mode nil 59(defcustom calculator-electric-mode nil
60 "Run `calculator' electrically, in the echo area. 60 "Run `calculator' electrically, in the echo area.
@@ -724,8 +724,7 @@ See the documentation for `calculator-mode' for more information."
724 (progn 724 (progn
725 (cond 725 (cond
726 ((not (get-buffer-window calculator-buffer)) 726 ((not (get-buffer-window calculator-buffer))
727 (let ((split-window-keep-point nil) 727 (let ((window-min-height 2))
728 (window-min-height 2))
729 ;; maybe leave two lines for our window because of the normal 728 ;; maybe leave two lines for our window because of the normal
730 ;; `raised' modeline in Emacs 21 729 ;; `raised' modeline in Emacs 21
731 (select-window 730 (select-window
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index b815e31f31c..399a6992f41 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -166,10 +166,27 @@
166 "Basic text editing facilities." 166 "Basic text editing facilities."
167 :group 'emacs) 167 :group 'emacs)
168 168
169(defgroup convenience nil
170 "Convenience features for faster editing."
171 :group 'emacs)
172
173(defgroup files nil
174 "Support for editing files."
175 :group 'emacs)
176
177(defgroup wp nil
178 "Support for editing text files."
179 :tag "Text"
180 :group 'emacs)
181
182(defgroup data nil
183 "Support for editing binary data files."
184 :group 'emacs)
185
169(defgroup abbrev nil 186(defgroup abbrev nil
170 "Abbreviation handling, typing shortcuts, macros." 187 "Abbreviation handling, typing shortcuts, macros."
171 :tag "Abbreviations" 188 :tag "Abbreviations"
172 :group 'editing) 189 :group 'convenience)
173 190
174(defgroup matching nil 191(defgroup matching nil
175 "Various sorts of searching and matching." 192 "Various sorts of searching and matching."
@@ -186,20 +203,20 @@
186 203
187(defgroup outlines nil 204(defgroup outlines nil
188 "Support for hierarchical outlining." 205 "Support for hierarchical outlining."
189 :group 'editing) 206 :group 'wp)
190 207
191(defgroup external nil 208(defgroup external nil
192 "Interfacing to external utilities." 209 "Interfacing to external utilities."
193 :group 'emacs) 210 :group 'emacs)
194 211
212(defgroup comm nil
213 "Communications, networking, and remote access to files."
214 :tag "Communication"
215 :group 'emacs)
216
195(defgroup processes nil 217(defgroup processes nil
196 "Process, subshell, compilation, and job control support." 218 "Process, subshell, compilation, and job control support."
197 :group 'external 219 :group 'external)
198 :group 'development)
199
200(defgroup convenience nil
201 "Convenience features for faster editing."
202 :group 'emacs)
203 220
204(defgroup programming nil 221(defgroup programming nil
205 "Support for programming in other languages." 222 "Support for programming in other languages."
@@ -225,10 +242,6 @@
225 "Programming tools." 242 "Programming tools."
226 :group 'programming) 243 :group 'programming)
227 244
228(defgroup oop nil
229 "Support for object-oriented programming."
230 :group 'programming)
231
232(defgroup applications nil 245(defgroup applications nil
233 "Applications written in Emacs." 246 "Applications written in Emacs."
234 :group 'emacs) 247 :group 'emacs)
@@ -275,11 +288,6 @@
275 "Fitting Emacs with its environment." 288 "Fitting Emacs with its environment."
276 :group 'emacs) 289 :group 'emacs)
277 290
278(defgroup comm nil
279 "Communications, networking, remote access to files."
280 :tag "Communication"
281 :group 'environment)
282
283(defgroup hardware nil 291(defgroup hardware nil
284 "Support for interfacing with miscellaneous hardware." 292 "Support for interfacing with miscellaneous hardware."
285 :group 'environment) 293 :group 'environment)
@@ -306,18 +314,6 @@
306 "Support for Emacs frames and window systems." 314 "Support for Emacs frames and window systems."
307 :group 'environment) 315 :group 'environment)
308 316
309(defgroup data nil
310 "Support for editing files of data."
311 :group 'emacs)
312
313(defgroup files nil
314 "Support for editing files."
315 :group 'emacs)
316
317(defgroup wp nil
318 "Word processing."
319 :group 'emacs)
320
321(defgroup tex nil 317(defgroup tex nil
322 "Code related to the TeX formatter." 318 "Code related to the TeX formatter."
323 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 319 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -327,10 +323,6 @@
327 "Support for multiple fonts." 323 "Support for multiple fonts."
328 :group 'emacs) 324 :group 'emacs)
329 325
330(defgroup hypermedia nil
331 "Support for links between text or other media types."
332 :group 'emacs)
333
334(defgroup help nil 326(defgroup help nil
335 "Support for on-line help systems." 327 "Support for on-line help systems."
336 :group 'emacs) 328 :group 'emacs)
@@ -680,8 +672,8 @@ If `last', order groups after non-groups."
680 :group 'custom-browse) 672 :group 'custom-browse)
681 673
682;;;###autoload 674;;;###autoload
683(defcustom custom-buffer-sort-alphabetically nil 675(defcustom custom-buffer-sort-alphabetically t
684 "If non-nil, sort each customization group alphabetically in Custom buffer." 676 "Whether to sort customization groups alphabetically in Custom buffer."
685 :type 'boolean 677 :type 'boolean
686 :group 'custom-buffer) 678 :group 'custom-buffer)
687 679
@@ -1136,7 +1128,7 @@ Show the buffer in another window, but don't select it."
1136 (unless (eq symbol basevar) 1128 (unless (eq symbol basevar)
1137 (message "`%s' is an alias for `%s'" symbol basevar)))) 1129 (message "`%s' is an alias for `%s'" symbol basevar))))
1138 1130
1139(defvar customize-changed-options-previous-release "22.1" 1131(defvar customize-changed-options-previous-release "23.1"
1140 "Version for `customize-changed-options' to refer back to by default.") 1132 "Version for `customize-changed-options' to refer back to by default.")
1141 1133
1142;; Packages will update this variable, so make it available. 1134;; Packages will update this variable, so make it available.
@@ -1382,42 +1374,52 @@ suggest to customize that face, if it's customizable."
1382 (custom-buffer-create (custom-sort-items found t nil) 1374 (custom-buffer-create (custom-sort-items found t nil)
1383 "*Customize Saved*")))) 1375 "*Customize Saved*"))))
1384 1376
1377(declare-function apropos-parse-pattern "apropos" (pattern))
1378
1385;;;###autoload 1379;;;###autoload
1386(defun customize-apropos (regexp &optional all) 1380(defun customize-apropos (pattern &optional type)
1387 "Customize all loaded options, faces and groups matching REGEXP. 1381 "Customize all loaded options, faces and groups matching PATTERN.
1388If ALL is `options', include only options. 1382PATTERN can be a word, a list of words (separated by spaces),
1389If ALL is `faces', include only faces. 1383or a regexp (using some regexp special characters). If it is a word,
1390If ALL is `groups', include only groups. 1384search for matches for that word as a substring. If it is a list of words,
1391If ALL is t (interactively, with prefix arg), include variables 1385search for matches for any two (or more) of those words.
1386
1387If TYPE is `options', include only options.
1388If TYPE is `faces', include only faces.
1389If TYPE is `groups', include only groups.
1390If TYPE is t (interactively, with prefix arg), include variables
1392that are not customizable options, as well as faces and groups 1391that are not customizable options, as well as faces and groups
1393\(but we recommend using `apropos-variable' instead)." 1392\(but we recommend using `apropos-variable' instead)."
1394 (interactive "sCustomize (regexp): \nP") 1393 (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
1395 (let ((found nil)) 1394 (require 'apropos)
1396 (mapatoms (lambda (symbol) 1395 (apropos-parse-pattern pattern)
1397 (when (string-match regexp (symbol-name symbol)) 1396 (let (found tests)
1398 (when (and (not (memq all '(faces options))) 1397 (mapatoms
1399 (get symbol 'custom-group)) 1398 `(lambda (symbol)
1400 (push (list symbol 'custom-group) found)) 1399 (when (string-match apropos-regexp (symbol-name symbol))
1401 (when (and (not (memq all '(options groups))) 1400 ,(if (not (memq type '(faces options)))
1402 (custom-facep symbol)) 1401 '(if (get symbol 'custom-group)
1403 (push (list symbol 'custom-face) found)) 1402 (push (list symbol 'custom-group) found)))
1404 (when (and (not (memq all '(groups faces))) 1403 ,(if (not (memq type '(options groups)))
1405 (boundp symbol) 1404 '(if (custom-facep symbol)
1406 (eq (indirect-variable symbol) symbol) 1405 (push (list symbol 'custom-face) found)))
1407 (or (get symbol 'saved-value) 1406 ,(if (not (memq type '(groups faces)))
1408 (custom-variable-p symbol) 1407 `(if (and (boundp symbol)
1409 (and (not (memq all '(nil options))) 1408 (eq (indirect-variable symbol) symbol)
1410 (get symbol 'variable-documentation)))) 1409 (or (get symbol 'saved-value)
1411 (push (list symbol 'custom-variable) found))))) 1410 (custom-variable-p symbol)
1411 ,(if (not (memq type '(nil options)))
1412 '(get symbol 'variable-documentation))))
1413 (push (list symbol 'custom-variable) found))))))
1412 (if (not found) 1414 (if (not found)
1413 (error "No %s matching %s" 1415 (error "No %s matching %s"
1414 (if (eq all t) 1416 (if (eq type t)
1415 "items" 1417 "items"
1416 (format "customizable %s" 1418 (format "customizable %s"
1417 (if (memq all '(options faces groups)) 1419 (if (memq type '(options faces groups))
1418 (symbol-name all) 1420 (symbol-name type)
1419 "items"))) 1421 "items")))
1420 regexp) 1422 pattern)
1421 (custom-buffer-create 1423 (custom-buffer-create
1422 (custom-sort-items found t custom-buffer-order-groups) 1424 (custom-sort-items found t custom-buffer-order-groups)
1423 "*Customize Apropos*")))) 1425 "*Customize Apropos*"))))
@@ -1540,6 +1542,12 @@ This button will have a menu with all three reset operations."
1540(defvar custom-button-pressed nil 1542(defvar custom-button-pressed nil
1541 "Face used for pressed buttons in customization buffers.") 1543 "Face used for pressed buttons in customization buffers.")
1542 1544
1545(defcustom custom-search-field t
1546 "If non-nil, show a search field in Custom buffers."
1547 :type 'boolean
1548 :version "24.1"
1549 :group 'custom-buffer)
1550
1543(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box) 1551(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
1544 '(("unspecified" . unspecified)))) 1552 '(("unspecified" . unspecified))))
1545 "If non-nil, indicate active buttons in a `raised-button' style. 1553 "If non-nil, indicate active buttons in a `raised-button' style.
@@ -1563,14 +1571,9 @@ Otherwise use brackets."
1563 (let ((init-file (or custom-file user-init-file))) 1571 (let ((init-file (or custom-file user-init-file)))
1564 ;; Insert verbose help at the top of the custom buffer. 1572 ;; Insert verbose help at the top of the custom buffer.
1565 (when custom-buffer-verbose-help 1573 (when custom-buffer-verbose-help
1566 (widget-insert "Editing a setting changes only the text in this buffer." 1574 (widget-insert (if init-file
1567 (if init-file 1575 "To apply changes, use the Save or Set buttons."
1568 " 1576 "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
1569To apply your changes, use the Save or Set buttons.
1570Saving a change normally works by editing your init file."
1571 "
1572Currently, these settings cannot be saved for future Emacs sessions,
1573possibly because you started Emacs with `-q'.")
1574 "\nFor details, see ") 1577 "\nFor details, see ")
1575 (widget-create 'custom-manual 1578 (widget-create 'custom-manual
1576 :tag "Saving Customizations" 1579 :tag "Saving Customizations"
@@ -1582,6 +1585,26 @@ possibly because you started Emacs with `-q'.")
1582 "(emacs)Top") 1585 "(emacs)Top")
1583 (widget-insert ".")) 1586 (widget-insert "."))
1584 (widget-insert "\n") 1587 (widget-insert "\n")
1588
1589 ;; Insert the search field.
1590 (when custom-search-field
1591 (widget-insert "\n")
1592 (let* ((echo "Search for custom items")
1593 (search-widget
1594 (widget-create
1595 'editable-field
1596 :size 40 :help-echo echo
1597 :action `(lambda (widget &optional event)
1598 (customize-apropos (widget-value widget))))))
1599 (widget-insert " ")
1600 (widget-create-child-and-convert
1601 search-widget 'push-button
1602 :tag "Search"
1603 :help-echo echo :action
1604 (lambda (widget &optional event)
1605 (customize-apropos (widget-value (widget-get widget :parent)))))
1606 (widget-insert "\n")))
1607
1585 ;; The custom command buttons are also in the toolbar, so for a 1608 ;; The custom command buttons are also in the toolbar, so for a
1586 ;; time they were not inserted in the buffer if the toolbar was in use. 1609 ;; time they were not inserted in the buffer if the toolbar was in use.
1587 ;; But it can be a little confusing for the buffer layout to 1610 ;; But it can be a little confusing for the buffer layout to
@@ -1589,10 +1612,9 @@ possibly because you started Emacs with `-q'.")
1589 ;; mention that a custom buffer can in theory be created in a 1612 ;; mention that a custom buffer can in theory be created in a
1590 ;; frame with a toolbar, then later viewed in one without. 1613 ;; frame with a toolbar, then later viewed in one without.
1591 ;; So now the buttons are always inserted in the buffer. (Bug#1326) 1614 ;; So now the buttons are always inserted in the buffer. (Bug#1326)
1592;;; (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
1593 (if custom-buffer-verbose-help 1615 (if custom-buffer-verbose-help
1594 (widget-insert "\n 1616 (widget-insert "
1595 Operate on all settings in this buffer that are not marked HIDDEN:\n")) 1617 Operate on all settings in this buffer:\n"))
1596 (let ((button (lambda (tag action active help icon) 1618 (let ((button (lambda (tag action active help icon)
1597 (widget-insert " ") 1619 (widget-insert " ")
1598 (if (eval active) 1620 (if (eval active)
@@ -1988,63 +2010,64 @@ and `face'."
1988 (nth 3 entry))) 2010 (nth 3 entry)))
1989 (form (widget-get parent :custom-form)) 2011 (form (widget-get parent :custom-form))
1990 children) 2012 children)
1991 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text) 2013 (unless (eq state 'hidden)
1992 (setq text (concat (match-string 1 text) 2014 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
1993 (symbol-name category) 2015 (setq text (concat (match-string 1 text)
1994 (match-string 2 text)))) 2016 (symbol-name category)
1995 (when (and custom-magic-show 2017 (match-string 2 text))))
1996 (or (not hidden) 2018 (when (and custom-magic-show
1997 (memq category custom-magic-show-hidden))) 2019 (or (not hidden)
1998 (insert " ") 2020 (memq category custom-magic-show-hidden)))
2021 (insert " ")
2022 (when (and (eq category 'group)
2023 (not (and (eq custom-buffer-style 'links)
2024 (> (widget-get parent :custom-level) 1))))
2025 (insert-char ?\ (* custom-buffer-indent
2026 (widget-get parent :custom-level))))
2027 (push (widget-create-child-and-convert
2028 widget 'choice-item
2029 :help-echo "Change the state of this item."
2030 :format (if hidden "%t" "%[%t%]")
2031 :button-prefix 'widget-push-button-prefix
2032 :button-suffix 'widget-push-button-suffix
2033 :mouse-down-action 'widget-magic-mouse-down-action
2034 :tag "State")
2035 children)
2036 (insert ": ")
2037 (let ((start (point)))
2038 (if (eq custom-magic-show 'long)
2039 (insert text)
2040 (insert (symbol-name state)))
2041 (cond ((eq form 'lisp)
2042 (insert " (lisp)"))
2043 ((eq form 'mismatch)
2044 (insert " (mismatch)")))
2045 (put-text-property start (point) 'face 'custom-state))
2046 (insert "\n"))
1999 (when (and (eq category 'group) 2047 (when (and (eq category 'group)
2000 (not (and (eq custom-buffer-style 'links) 2048 (not (and (eq custom-buffer-style 'links)
2001 (> (widget-get parent :custom-level) 1)))) 2049 (> (widget-get parent :custom-level) 1))))
2002 (insert-char ?\ (* custom-buffer-indent 2050 (insert-char ?\ (* custom-buffer-indent
2003 (widget-get parent :custom-level)))) 2051 (widget-get parent :custom-level))))
2004 (push (widget-create-child-and-convert 2052 (when custom-magic-show-button
2005 widget 'choice-item 2053 (when custom-magic-show
2006 :help-echo "Change the state of this item." 2054 (let ((indent (widget-get parent :indent)))
2007 :format (if hidden "%t" "%[%t%]") 2055 (when indent
2008 :button-prefix 'widget-push-button-prefix 2056 (insert-char ? indent))))
2009 :button-suffix 'widget-push-button-suffix 2057 (push (widget-create-child-and-convert
2010 :mouse-down-action 'widget-magic-mouse-down-action 2058 widget 'choice-item
2011 :tag "State") 2059 :mouse-down-action 'widget-magic-mouse-down-action
2012 children) 2060 :button-face face
2013 (insert ": ") 2061 :button-prefix ""
2014 (let ((start (point))) 2062 :button-suffix ""
2015 (if (eq custom-magic-show 'long) 2063 :help-echo "Change the state."
2016 (insert text) 2064 :format (if hidden "%t" "%[%t%]")
2017 (insert (symbol-name state))) 2065 :tag (if (memq form '(lisp mismatch))
2018 (cond ((eq form 'lisp) 2066 (concat "(" magic ")")
2019 (insert " (lisp)")) 2067 (concat "[" magic "]")))
2020 ((eq form 'mismatch) 2068 children)
2021 (insert " (mismatch)"))) 2069 (insert " "))
2022 (put-text-property start (point) 'face 'custom-state)) 2070 (widget-put widget :children children))))
2023 (insert "\n"))
2024 (when (and (eq category 'group)
2025 (not (and (eq custom-buffer-style 'links)
2026 (> (widget-get parent :custom-level) 1))))
2027 (insert-char ?\ (* custom-buffer-indent
2028 (widget-get parent :custom-level))))
2029 (when custom-magic-show-button
2030 (when custom-magic-show
2031 (let ((indent (widget-get parent :indent)))
2032 (when indent
2033 (insert-char ? indent))))
2034 (push (widget-create-child-and-convert
2035 widget 'choice-item
2036 :mouse-down-action 'widget-magic-mouse-down-action
2037 :button-face face
2038 :button-prefix ""
2039 :button-suffix ""
2040 :help-echo "Change the state."
2041 :format (if hidden "%t" "%[%t%]")
2042 :tag (if (memq form '(lisp mismatch))
2043 (concat "(" magic ")")
2044 (concat "[" magic "]")))
2045 children)
2046 (insert " "))
2047 (widget-put widget :children children)))
2048 2071
2049(defun custom-magic-reset (widget) 2072(defun custom-magic-reset (widget)
2050 "Redraw the :custom-magic property of WIDGET." 2073 "Redraw the :custom-magic property of WIDGET."
@@ -2206,12 +2229,9 @@ and `face'."
2206(defun custom-show (widget value) 2229(defun custom-show (widget value)
2207 "Non-nil if WIDGET should be shown with VALUE by default." 2230 "Non-nil if WIDGET should be shown with VALUE by default."
2208 (let ((show (widget-get widget :custom-show))) 2231 (let ((show (widget-get widget :custom-show)))
2209 (cond ((null show) 2232 (if (functionp show)
2210 nil) 2233 (funcall show widget value)
2211 ((eq t show) 2234 show)))
2212 t)
2213 (t
2214 (funcall show widget value)))))
2215 2235
2216(defun custom-load-widget (widget) 2236(defun custom-load-widget (widget)
2217 "Load all dependencies for WIDGET." 2237 "Load all dependencies for WIDGET."
@@ -2289,8 +2309,7 @@ Insert PREFIX first if non-nil."
2289 (insert ", ")))) 2309 (insert ", "))))
2290 (widget-put widget :buttons buttons)))) 2310 (widget-put widget :buttons buttons))))
2291 2311
2292(defun custom-add-parent-links (widget &optional initial-string 2312(defun custom-add-parent-links (widget &optional initial-string doc-initial-string)
2293 doc-initial-string)
2294 "Add \"Parent groups: ...\" to WIDGET if the group has parents. 2313 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
2295The value is non-nil if any parents were found. 2314The value is non-nil if any parents were found.
2296If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." 2315If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
@@ -2309,36 +2328,6 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2309 symbol) 2328 symbol)
2310 buttons) 2329 buttons)
2311 (setq parents (cons symbol parents))))) 2330 (setq parents (cons symbol parents)))))
2312 (and (null (get name 'custom-links)) ;No links of its own.
2313 (= (length parents) 1) ;A single parent.
2314 (let* ((links (delq nil (mapcar (lambda (w)
2315 (unless (eq (widget-type w)
2316 'custom-group-link)
2317 w))
2318 (get (car parents) 'custom-links))))
2319 (many (> (length links) 2)))
2320 (when links
2321 (let ((pt (point))
2322 (left-margin (+ left-margin 2)))
2323 (insert "\n" (or doc-initial-string "Group documentation:") " ")
2324 (while links
2325 (push (widget-create-child-and-convert
2326 widget (car links)
2327 :button-face 'custom-link
2328 :mouse-face 'highlight
2329 :pressed-face 'highlight)
2330 buttons)
2331 (setq links (cdr links))
2332 (cond ((null links)
2333 (insert ".\n"))
2334 ((null (cdr links))
2335 (if many
2336 (insert ", and ")
2337 (insert " and ")))
2338 (t
2339 (insert ", "))))
2340 (fill-region-as-paragraph pt (point))
2341 (delete-to-left-margin (1+ pt) (+ pt 2))))))
2342 (if parents 2331 (if parents
2343 (insert "\n") 2332 (insert "\n")
2344 (delete-region start (point))) 2333 (delete-region start (point)))
@@ -2413,8 +2402,6 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2413 2402
2414;;; The `custom-variable' Widget. 2403;;; The `custom-variable' Widget.
2415 2404
2416;; When this was underlined blue, users confused it with a
2417;; Mosaic-style hyperlink...
2418(defface custom-variable-tag 2405(defface custom-variable-tag
2419 `((((class color) 2406 `((((class color)
2420 (background dark)) 2407 (background dark))
@@ -2459,7 +2446,11 @@ However, setting it through Custom sets the default value.")
2459 (documentation-property variable 'variable-documentation))) 2446 (documentation-property variable 'variable-documentation)))
2460 2447
2461(define-widget 'custom-variable 'custom 2448(define-widget 'custom-variable 'custom
2462 "Customize variable." 2449 "A widget for displaying a Custom variable.
2450
2451The following property has a special meaning for this widget:
2452:hidden-states - A list of widget states for which the widget's initial
2453 contents should be hidden."
2463 :format "%v" 2454 :format "%v"
2464 :help-echo "Set or reset this variable." 2455 :help-echo "Set or reset this variable."
2465 :documentation-property #'custom-variable-documentation 2456 :documentation-property #'custom-variable-documentation
@@ -2469,6 +2460,7 @@ However, setting it through Custom sets the default value.")
2469 :custom-form nil ; defaults to value of `custom-variable-default-form' 2460 :custom-form nil ; defaults to value of `custom-variable-default-form'
2470 :value-create 'custom-variable-value-create 2461 :value-create 'custom-variable-value-create
2471 :action 'custom-variable-action 2462 :action 'custom-variable-action
2463 :hidden-states '(standard)
2472 :custom-set 'custom-variable-set 2464 :custom-set 'custom-variable-set
2473 :custom-mark-to-save 'custom-variable-mark-to-save 2465 :custom-mark-to-save 'custom-variable-mark-to-save
2474 :custom-reset-current 'custom-redraw 2466 :custom-reset-current 'custom-redraw
@@ -2503,7 +2495,6 @@ try matching its doc string against `custom-guess-doc-alist'."
2503 (let* ((buttons (widget-get widget :buttons)) 2495 (let* ((buttons (widget-get widget :buttons))
2504 (children (widget-get widget :children)) 2496 (children (widget-get widget :children))
2505 (form (widget-get widget :custom-form)) 2497 (form (widget-get widget :custom-form))
2506 (state (widget-get widget :custom-state))
2507 (symbol (widget-get widget :value)) 2498 (symbol (widget-get widget :value))
2508 (tag (widget-get widget :tag)) 2499 (tag (widget-get widget :tag))
2509 (type (custom-variable-type symbol)) 2500 (type (custom-variable-type symbol))
@@ -2513,17 +2504,17 @@ try matching its doc string against `custom-guess-doc-alist'."
2513 (last (widget-get widget :custom-last)) 2504 (last (widget-get widget :custom-last))
2514 (value (if (default-boundp symbol) 2505 (value (if (default-boundp symbol)
2515 (funcall get symbol) 2506 (funcall get symbol)
2516 (widget-get conv :value)))) 2507 (widget-get conv :value)))
2517 ;; If the widget is new, the child determines whether it is hidden. 2508 (state (or (widget-get widget :custom-state)
2518 (cond (state) 2509 (if (memq (custom-variable-state symbol value)
2519 ((custom-show type value) 2510 (widget-get widget :hidden-states))
2520 (setq state 'unknown)) 2511 'hidden))))
2521 (t 2512
2522 (setq state 'hidden)))
2523 ;; If we don't know the state, see if we need to edit it in lisp form. 2513 ;; If we don't know the state, see if we need to edit it in lisp form.
2514 (unless state
2515 (setq state (if (custom-show type value) 'unknown 'hidden)))
2524 (when (eq state 'unknown) 2516 (when (eq state 'unknown)
2525 (unless (widget-apply conv :match value) 2517 (unless (widget-apply conv :match value)
2526 ;; (widget-apply (widget-convert type) :match value)
2527 (setq form 'mismatch))) 2518 (setq form 'mismatch)))
2528 ;; Now we can create the child widget. 2519 ;; Now we can create the child widget.
2529 (cond ((eq custom-buffer-style 'tree) 2520 (cond ((eq custom-buffer-style 'tree)
@@ -2536,21 +2527,36 @@ try matching its doc string against `custom-guess-doc-alist'."
2536 ((eq state 'hidden) 2527 ((eq state 'hidden)
2537 ;; Indicate hidden value. 2528 ;; Indicate hidden value.
2538 (push (widget-create-child-and-convert 2529 (push (widget-create-child-and-convert
2539 widget 'item 2530 widget 'custom-visibility
2540 :format "%{%t%}: "
2541 :sample-face 'custom-variable-tag
2542 :tag tag
2543 :parent widget)
2544 buttons)
2545 (push (widget-create-child-and-convert
2546 widget 'visibility
2547 :help-echo "Show the value of this option." 2531 :help-echo "Show the value of this option."
2532 :on-image "down"
2533 :on "Hide"
2534 :off-image "right"
2548 :off "Show Value" 2535 :off "Show Value"
2549 :action 'custom-toggle-parent 2536 :action 'custom-toggle-parent
2550 nil) 2537 nil)
2538 buttons)
2539 (insert " ")
2540 (push (widget-create-child-and-convert
2541 widget 'item
2542 :format "%{%t%} "
2543 :sample-face 'custom-variable-tag
2544 :tag tag
2545 :parent widget)
2551 buttons)) 2546 buttons))
2552 ((memq form '(lisp mismatch)) 2547 ((memq form '(lisp mismatch))
2553 ;; In lisp mode edit the saved value when possible. 2548 ;; In lisp mode edit the saved value when possible.
2549 (push (widget-create-child-and-convert
2550 widget 'custom-visibility
2551 :help-echo "Hide the value of this option."
2552 :on "Hide"
2553 :off "Show"
2554 :on-image "down"
2555 :off-image "right"
2556 :action 'custom-toggle-parent
2557 t)
2558 buttons)
2559 (insert " ")
2554 (let* ((value (cond ((get symbol 'saved-value) 2560 (let* ((value (cond ((get symbol 'saved-value)
2555 (car (get symbol 'saved-value))) 2561 (car (get symbol 'saved-value)))
2556 ((get symbol 'standard-value) 2562 ((get symbol 'standard-value)
@@ -2561,15 +2567,6 @@ try matching its doc string against `custom-guess-doc-alist'."
2561 (custom-quote (widget-get conv :value)))))) 2567 (custom-quote (widget-get conv :value))))))
2562 (insert (symbol-name symbol) ": ") 2568 (insert (symbol-name symbol) ": ")
2563 (push (widget-create-child-and-convert 2569 (push (widget-create-child-and-convert
2564 widget 'visibility
2565 :help-echo "Hide the value of this option."
2566 :on "Hide Value"
2567 :off "Show Value"
2568 :action 'custom-toggle-parent
2569 t)
2570 buttons)
2571 (insert " ")
2572 (push (widget-create-child-and-convert
2573 widget 'sexp 2570 widget 'sexp
2574 :button-face 'custom-variable-button-face 2571 :button-face 'custom-variable-button-face
2575 :format "%v" 2572 :format "%v"
@@ -2579,6 +2576,17 @@ try matching its doc string against `custom-guess-doc-alist'."
2579 children))) 2576 children)))
2580 (t 2577 (t
2581 ;; Edit mode. 2578 ;; Edit mode.
2579 (push (widget-create-child-and-convert
2580 widget 'custom-visibility
2581 :help-echo "Hide or show this option."
2582 :on "Hide"
2583 :off "Show"
2584 :on-image "down"
2585 :off-image "right"
2586 :action 'custom-toggle-parent
2587 t)
2588 buttons)
2589 (insert " ")
2582 (let* ((format (widget-get type :format)) 2590 (let* ((format (widget-get type :format))
2583 tag-format value-format) 2591 tag-format value-format)
2584 (unless (string-match ":" format) 2592 (unless (string-match ":" format)
@@ -2595,15 +2603,6 @@ try matching its doc string against `custom-guess-doc-alist'."
2595 :sample-face 'custom-variable-tag 2603 :sample-face 'custom-variable-tag
2596 tag) 2604 tag)
2597 buttons) 2605 buttons)
2598 (insert " ")
2599 (push (widget-create-child-and-convert
2600 widget 'visibility
2601 :help-echo "Hide the value of this option."
2602 :on "Hide Value"
2603 :off "Show Value"
2604 :action 'custom-toggle-parent
2605 t)
2606 buttons)
2607 (push (widget-create-child-and-convert 2606 (push (widget-create-child-and-convert
2608 widget type 2607 widget type
2609 :format value-format 2608 :format value-format
@@ -2635,7 +2634,7 @@ try matching its doc string against `custom-guess-doc-alist'."
2635 ;; Don't push it !!! Custom assumes that the first child is the 2634 ;; Don't push it !!! Custom assumes that the first child is the
2636 ;; value one. 2635 ;; value one.
2637 (setq children (append children (list comment-widget))))) 2636 (setq children (append children (list comment-widget)))))
2638 ;; Update the rest of the properties properties. 2637 ;; Update the rest of the properties.
2639 (widget-put widget :custom-form form) 2638 (widget-put widget :custom-form form)
2640 (widget-put widget :children children) 2639 (widget-put widget :children children)
2641 ;; Now update the state. 2640 ;; Now update the state.
@@ -2658,61 +2657,69 @@ try matching its doc string against `custom-guess-doc-alist'."
2658 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) 2657 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
2659 :mouse-down-action args)) 2658 :mouse-down-action args))
2660 2659
2661(defun custom-variable-state-set (widget) 2660(defun custom-variable-state (symbol val)
2662 "Set the state of WIDGET." 2661 "Return the state of SYMBOL if its value is VAL.
2663 (let* ((symbol (widget-value widget)) 2662If SYMBOL has a non-nil `custom-get' property, it overrides VAL.
2664 (get (or (get symbol 'custom-get) 'default-value)) 2663Possible return values are `standard', `saved', `set', `themed',
2664`changed', and `rogue'."
2665 (let* ((get (or (get symbol 'custom-get) 'default-value))
2665 (value (if (default-boundp symbol) 2666 (value (if (default-boundp symbol)
2666 (funcall get symbol) 2667 (funcall get symbol)
2667 (widget-get widget :value))) 2668 val))
2668 (comment (get symbol 'variable-comment)) 2669 (comment (get symbol 'variable-comment))
2669 tmp 2670 tmp
2670 temp 2671 temp)
2671 (state (cond ((progn (setq tmp (get symbol 'customized-value)) 2672 (cond ((progn (setq tmp (get symbol 'customized-value))
2672 (setq temp 2673 (setq temp
2673 (get symbol 'customized-variable-comment)) 2674 (get symbol 'customized-variable-comment))
2674 (or tmp temp)) 2675 (or tmp temp))
2675 (if (condition-case nil 2676 (if (condition-case nil
2676 (and (equal value (eval (car tmp))) 2677 (and (equal value (eval (car tmp)))
2677 (equal comment temp)) 2678 (equal comment temp))
2678 (error nil)) 2679 (error nil))
2679 'set 2680 'set
2680 'changed)) 2681 'changed))
2681 ((progn (setq tmp (get symbol 'theme-value)) 2682 ((progn (setq tmp (get symbol 'theme-value))
2682 (setq temp (get symbol 'saved-variable-comment)) 2683 (setq temp (get symbol 'saved-variable-comment))
2683 (or tmp temp)) 2684 (or tmp temp))
2684 (if (condition-case nil 2685 (if (condition-case nil
2685 (and (equal comment temp) 2686 (and (equal comment temp)
2686 (equal value 2687 (equal value
2687 (eval 2688 (eval
2688 (car (custom-variable-theme-value 2689 (car (custom-variable-theme-value
2689 symbol))))) 2690 symbol)))))
2690 (error nil)) 2691 (error nil))
2691 (cond 2692 (cond
2692 ((eq (caar tmp) 'user) 'saved) 2693 ((eq (caar tmp) 'user) 'saved)
2693 ((eq (caar tmp) 'changed) 2694 ((eq (caar tmp) 'changed)
2694 (if (condition-case nil 2695 (if (condition-case nil
2695 (and (null comment) 2696 (and (null comment)
2696 (equal value 2697 (equal value
2697 (eval 2698 (eval
2698 (car (get symbol 'standard-value))))) 2699 (car (get symbol 'standard-value)))))
2699 (error nil)) 2700 (error nil))
2700 ;; The value was originally set outside 2701 ;; The value was originally set outside
2701 ;; custom, but it was set to the standard 2702 ;; custom, but it was set to the standard
2702 ;; value (probably an autoloaded defcustom). 2703 ;; value (probably an autoloaded defcustom).
2703 'standard 2704 'standard
2704 'changed)) 2705 'changed))
2705 (t 'themed)) 2706 (t 'themed))
2706 'changed)) 2707 'changed))
2707 ((setq tmp (get symbol 'standard-value)) 2708 ((setq tmp (get symbol 'standard-value))
2708 (if (condition-case nil 2709 (if (condition-case nil
2709 (and (equal value (eval (car tmp))) 2710 (and (equal value (eval (car tmp)))
2710 (equal comment nil)) 2711 (equal comment nil))
2711 (error nil)) 2712 (error nil))
2712 'standard 2713 'standard
2713 'changed)) 2714 'changed))
2714 (t 'rogue)))) 2715 (t 'rogue))))
2715 (widget-put widget :custom-state state))) 2716
2717(defun custom-variable-state-set (widget &optional state)
2718 "Set the state of WIDGET to STATE.
2719If STATE is nil, the value is computed by `custom-variable-state'."
2720 (widget-put widget :custom-state
2721 (or state (custom-variable-state (widget-value widget)
2722 (widget-get widget :value)))))
2716 2723
2717(defun custom-variable-standard-value (widget) 2724(defun custom-variable-standard-value (widget)
2718 (get (widget-value widget) 'standard-value)) 2725 (get (widget-value widget) 'standard-value))
@@ -2998,7 +3005,9 @@ to switch between two values."
2998 :button-face 'custom-visibility 3005 :button-face 'custom-visibility
2999 :pressed-face 'custom-visibility 3006 :pressed-face 'custom-visibility
3000 :mouse-face 'highlight 3007 :mouse-face 'highlight
3001 :pressed-face 'highlight) 3008 :pressed-face 'highlight
3009 :on-image nil
3010 :off-image nil)
3002 3011
3003(defface custom-visibility 3012(defface custom-visibility
3004 '((t :height 0.8 :inherit link)) 3013 '((t :height 0.8 :inherit link))
@@ -3345,6 +3354,18 @@ SPEC must be a full face spec."
3345 (insert " " tag "\n") 3354 (insert " " tag "\n")
3346 (widget-put widget :buttons buttons)) 3355 (widget-put widget :buttons buttons))
3347 (t 3356 (t
3357 ;; Visibility.
3358 (push (widget-create-child-and-convert
3359 widget 'custom-visibility
3360 :help-echo "Hide or show this face."
3361 :on "Hide"
3362 :off "Show"
3363 :on-image "down"
3364 :off-image "right"
3365 :action 'custom-toggle-parent
3366 (not (eq state 'hidden)))
3367 buttons)
3368 (insert " ")
3348 ;; Create tag. 3369 ;; Create tag.
3349 (insert tag) 3370 (insert tag)
3350 (widget-specify-sample widget begin (point)) 3371 (widget-specify-sample widget begin (point))
@@ -3359,16 +3380,6 @@ SPEC must be a full face spec."
3359 :sample-face symbol 3380 :sample-face symbol
3360 :tag "sample") 3381 :tag "sample")
3361 buttons) 3382 buttons)
3362 ;; Visibility.
3363 (insert " ")
3364 (push (widget-create-child-and-convert
3365 widget 'visibility
3366 :help-echo "Hide or show this face."
3367 :on "Hide Face"
3368 :off "Show Face"
3369 :action 'custom-toggle-parent
3370 (not (eq state 'hidden)))
3371 buttons)
3372 ;; Magic. 3383 ;; Magic.
3373 (insert "\n") 3384 (insert "\n")
3374 (let ((magic (widget-create-child-and-convert 3385 (let ((magic (widget-create-child-and-convert
@@ -3920,8 +3931,11 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
3920 (insert " " tag "\n") 3931 (insert " " tag "\n")
3921 (widget-put widget :buttons buttons) 3932 (widget-put widget :buttons buttons)
3922 (message "Creating group...") 3933 (message "Creating group...")
3923 (let* ((members (custom-sort-items members 3934 (let* ((members (custom-sort-items
3924 custom-browse-sort-alphabetically 3935 members
3936 ;; Never sort the top-level custom group.
3937 (unless (eq symbol 'emacs)
3938 custom-browse-sort-alphabetically)
3925 custom-browse-order-groups)) 3939 custom-browse-order-groups))
3926 (prefixes (widget-get widget :custom-prefixes)) 3940 (prefixes (widget-get widget :custom-prefixes))
3927 (custom-prefix-list (custom-prefix-add symbol prefixes)) 3941 (custom-prefix-list (custom-prefix-add symbol prefixes))
@@ -3979,17 +3993,21 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
3979 3993
3980 ;; Nested style. 3994 ;; Nested style.
3981 (t ;Visible. 3995 (t ;Visible.
3996 ;; Draw a horizontal line (this works for both graphical
3997 ;; and text displays):
3998 (let ((p (point)))
3999 (insert "\n")
4000 (put-text-property p (1+ p) 'face '(:underline t))
4001 (overlay-put (make-overlay p (1+ p))
4002 'before-string
4003 (propertize "\n" 'face '(:underline t)
4004 'display '(space :align-to 999))))
4005
3982 ;; Add parent groups references above the group. 4006 ;; Add parent groups references above the group.
3983 (if t ;;; This should test that the buffer 4007 (when (eq level 1)
3984 ;;; was made to display a group. 4008 (if (custom-add-parent-links widget "Parent groups:")
3985 (when (eq level 1) 4009 (insert "\n")))
3986 (if (custom-add-parent-links widget
3987 "Parent groups:"
3988 "Parent group documentation:")
3989 (insert "\n"))))
3990 ;; Create level indicator.
3991 (insert-char ?\ (* custom-buffer-indent (1- level))) 4010 (insert-char ?\ (* custom-buffer-indent (1- level)))
3992 (insert "/- ")
3993 ;; Create tag. 4011 ;; Create tag.
3994 (let ((start (point))) 4012 (let ((start (point)))
3995 (insert tag " group: ") 4013 (insert tag " group: ")
@@ -4009,12 +4027,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
4009 (not (eq state 'hidden))) 4027 (not (eq state 'hidden)))
4010 buttons) 4028 buttons)
4011 (insert " ")) 4029 (insert " "))
4012 ;; Create more dashes. 4030 (insert "\n")
4013 ;; Use 76 instead of 75 to compensate for the temporary "<"
4014 ;; added by `widget-insert'.
4015 (insert-char ?- (- 76 (current-column)
4016 (* custom-buffer-indent level)))
4017 (insert "\\\n")
4018 ;; Create magic button. 4031 ;; Create magic button.
4019 (let ((magic (widget-create-child-and-convert 4032 (let ((magic (widget-create-child-and-convert
4020 widget 'custom-magic 4033 widget 'custom-magic
@@ -4040,43 +4053,50 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
4040 ?\ )) 4053 ?\ ))
4041 ;; Members. 4054 ;; Members.
4042 (message "Creating group...") 4055 (message "Creating group...")
4043 (let* ((members (custom-sort-items members 4056 (let* ((members (custom-sort-items
4044 custom-buffer-sort-alphabetically 4057 members
4045 custom-buffer-order-groups)) 4058 ;; Never sort the top-level custom group.
4059 (unless (eq symbol 'emacs)
4060 custom-buffer-sort-alphabetically)
4061 custom-buffer-order-groups))
4046 (prefixes (widget-get widget :custom-prefixes)) 4062 (prefixes (widget-get widget :custom-prefixes))
4047 (custom-prefix-list (custom-prefix-add symbol prefixes)) 4063 (custom-prefix-list (custom-prefix-add symbol prefixes))
4048 (length (length members)) 4064 (len (length members))
4049 (count 0) 4065 (count 0)
4050 (children (mapcar (lambda (entry) 4066 (reporter (make-progress-reporter
4051 (widget-insert "\n") 4067 "Creating group entries..." 0 len))
4052 (message "\ 4068 children)
4053Creating group members... %2d%%" 4069 (setq children
4054 (/ (* 100.0 count) length)) 4070 (mapcar
4055 (setq count (1+ count)) 4071 (lambda (entry)
4056 (prog1 4072 (widget-insert "\n")
4057 (widget-create-child-and-convert 4073 (progress-reporter-update reporter (setq count (1+ count)))
4058 widget (nth 1 entry) 4074 (let ((sym (nth 0 entry))
4059 :group widget 4075 (type (nth 1 entry))
4060 :tag (custom-unlispify-tag-name 4076 hidden-p)
4061 (nth 0 entry)) 4077 (prog1
4062 :custom-prefixes custom-prefix-list 4078 (widget-create-child-and-convert
4063 :custom-level (1+ level) 4079 widget type
4064 :value (nth 0 entry)) 4080 :group widget
4065 (unless (eq (preceding-char) ?\n) 4081 :tag (custom-unlispify-tag-name sym)
4066 (widget-insert "\n")))) 4082 :custom-prefixes custom-prefix-list
4067 members))) 4083 :custom-level (1+ level)
4068 (message "Creating group magic...") 4084 :value sym)
4085 (unless (eq (preceding-char) ?\n)
4086 (widget-insert "\n")))))
4087 members))
4069 (mapc 'custom-magic-reset children) 4088 (mapc 'custom-magic-reset children)
4070 (message "Creating group state...")
4071 (widget-put widget :children children) 4089 (widget-put widget :children children)
4072 (custom-group-state-update widget) 4090 (custom-group-state-update widget)
4073 (message "Creating group... done")) 4091 (progress-reporter-done reporter))
4074 ;; End line 4092 ;; End line
4075 (insert "\n") 4093 (let ((p (point)))
4076 (insert-char ?\ (* custom-buffer-indent (1- level))) 4094 (insert "\n")
4077 (insert "\\- " (widget-get widget :tag) " group end ") 4095 (put-text-property p (1+ p) 'face '(:underline t))
4078 (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level))) 4096 (overlay-put (make-overlay p (1+ p))
4079 (insert "/\n"))))) 4097 'before-string
4098 (propertize "\n" 'face '(:underline t)
4099 'display '(space :align-to 999))))))))
4080 4100
4081(defvar custom-group-menu 4101(defvar custom-group-menu
4082 `(("Set for Current Session" custom-group-set 4102 `(("Set for Current Session" custom-group-set
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 27f8318f91c..75ea98ba911 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -1287,7 +1287,9 @@ a diff with \\[diff-reverse-direction].
1287 (set (make-local-variable 'add-log-current-defun-function) 1287 (set (make-local-variable 'add-log-current-defun-function)
1288 'diff-current-defun) 1288 'diff-current-defun)
1289 (set (make-local-variable 'add-log-buffer-file-name-function) 1289 (set (make-local-variable 'add-log-buffer-file-name-function)
1290 (lambda () (diff-find-file-name nil 'noprompt)))) 1290 (lambda () (diff-find-file-name nil 'noprompt)))
1291 (unless (buffer-file-name)
1292 (hack-dir-local-variables-non-file-buffer)))
1291 1293
1292;;;###autoload 1294;;;###autoload
1293(define-minor-mode diff-minor-mode 1295(define-minor-mode diff-minor-mode
diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el
index 45c3840bdd2..175999b6e37 100644
--- a/lisp/emulation/pc-select.el
+++ b/lisp/emulation/pc-select.el
@@ -82,8 +82,7 @@
82(defgroup pc-select nil 82(defgroup pc-select nil
83 "Emulate pc bindings." 83 "Emulate pc bindings."
84 :prefix "pc-select" 84 :prefix "pc-select"
85 :group 'editing-basics 85 :group 'emulations)
86 :group 'convenience)
87 86
88(defcustom pc-select-override-scroll-error t 87(defcustom pc-select-override-scroll-error t
89 "*Non-nil means don't generate error on scrolling past edge of buffer. 88 "*Non-nil means don't generate error on scrolling past edge of buffer.
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 3cdf2ff3ffa..ddbdd3541ad 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -34,7 +34,7 @@
34(defgroup epg () 34(defgroup epg ()
35 "The EasyPG library." 35 "The EasyPG library."
36 :version "23.1" 36 :version "23.1"
37 :group 'emacs) 37 :group 'data)
38 38
39(defcustom epg-gpg-program "gpg" 39(defcustom epg-gpg-program "gpg"
40 "The `gpg' executable." 40 "The `gpg' executable."
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index c192b3400b4..18fc5f188a9 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,7 @@
12010-03-10 Chong Yidong <cyd@stupidchicken.com>
2
3 * Branch for 23.2.
4
12010-02-07 Vivek Dasmohapatra <vivek@etla.org> 52010-02-07 Vivek Dasmohapatra <vivek@etla.org>
2 6
3 * erc-services.el (erc-nickserv-alist): Fix defcustom type (Bug#5520). 7 * erc-services.el (erc-nickserv-alist): Fix defcustom type (Bug#5520).
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 6f9e6799763..b7c9f359095 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -479,12 +479,20 @@ These special properties include `invisible', `intangible' and `read-only'."
479 nil 479 nil
480 col))) 480 col)))
481 481
482(defun list-colors-display (&optional list buffer-name) 482
483(defun list-colors-display (&optional list buffer-name callback)
483 "Display names of defined colors, and show what they look like. 484 "Display names of defined colors, and show what they look like.
484If the optional argument LIST is non-nil, it should be a list of 485If the optional argument LIST is non-nil, it should be a list of
485colors to display. Otherwise, this command computes a list of 486colors to display. Otherwise, this command computes a list of
486colors that the current display can handle. If the optional 487colors that the current display can handle.
487argument BUFFER-NAME is nil, it defaults to *Colors*." 488
489If the optional argument BUFFER-NAME is nil, it defaults to
490*Colors*.
491
492If the optional argument CALLBACK is non-nil, it should be a
493function to call each time the user types RET or clicks on a
494color. The function should accept a single argument, the color
495name."
488 (interactive) 496 (interactive)
489 (when (and (null list) (> (display-color-cells) 0)) 497 (when (and (null list) (> (display-color-cells) 0))
490 (setq list (list-colors-duplicates (defined-colors))) 498 (setq list (list-colors-duplicates (defined-colors)))
@@ -493,49 +501,57 @@ argument BUFFER-NAME is nil, it defaults to *Colors*."
493 (let ((lc (nthcdr (1- (display-color-cells)) list))) 501 (let ((lc (nthcdr (1- (display-color-cells)) list)))
494 (if lc 502 (if lc
495 (setcdr lc nil))))) 503 (setcdr lc nil)))))
496 (with-help-window (or buffer-name "*Colors*") 504 (let ((buf (get-buffer-create "*Colors*")))
497 (with-current-buffer standard-output 505 (with-current-buffer buf
506 (erase-buffer)
498 (setq truncate-lines t) 507 (setq truncate-lines t)
499 (if temp-buffer-show-function 508 (list-colors-print list callback)
500 (list-colors-print list) 509 (set-buffer-modified-p nil))
501 ;; Call list-colors-print from temp-buffer-show-hook 510 (pop-to-buffer buf))
502 ;; to get the right value of window-width in list-colors-print 511 (if callback
503 ;; after the buffer is displayed. 512 (message "Click on a color to select it.")))
504 (add-hook 'temp-buffer-show-hook 513
505 (lambda () 514(defun list-colors-print (list &optional callback)
506 (set-buffer-modified-p 515 (let ((callback-fn
507 (prog1 (buffer-modified-p) 516 (if callback
508 (list-colors-print list)))) 517 `(lambda (button)
509 nil t))))) 518 (funcall ,callback (button-get button 'color-name))))))
510 519 (dolist (color list)
511(defun list-colors-print (list) 520 (if (consp color)
512 (dolist (color list) 521 (if (cdr color)
513 (if (consp color) 522 (setq color (sort color (lambda (a b)
514 (if (cdr color) 523 (string< (downcase a)
515 (setq color (sort color (lambda (a b) 524 (downcase b))))))
516 (string< (downcase a) 525 (setq color (list color)))
517 (downcase b)))))) 526 (let* ((opoint (point))
518 (setq color (list color))) 527 (color-values (color-values (car color)))
519 (put-text-property 528 (light-p (>= (apply 'max color-values)
520 (prog1 (point) 529 (* (car (color-values "white")) .5))))
521 (insert (car color)) 530 (insert (car color))
522 (indent-to 22)) 531 (indent-to 22)
523 (point) 532 (put-text-property opoint (point) 'face `(:background ,(car color)))
524 'face (list ':background (car color))) 533 (put-text-property
525 (put-text-property 534 (prog1 (point)
526 (prog1 (point) 535 (insert " " (if (cdr color)
527 (insert " " (if (cdr color) 536 (mapconcat 'identity (cdr color) ", ")
528 (mapconcat 'identity (cdr color) ", ") 537 (car color))))
529 (car color)))) 538 (point)
530 (point) 539 'face (list :foreground (car color)))
531 'face (list ':foreground (car color))) 540 (indent-to (max (- (window-width) 8) 44))
532 (indent-to (max (- (window-width) 8) 44)) 541 (insert (apply 'format "#%02x%02x%02x"
533 (insert (apply 'format "#%02x%02x%02x" 542 (mapcar (lambda (c) (lsh c -8))
534 (mapcar (lambda (c) (lsh c -8)) 543 color-values)))
535 (color-values (car color))))) 544 (when callback
536 545 (make-text-button
537 (insert "\n")) 546 opoint (point)
538 (goto-char (point-min))) 547 'follow-link t
548 'mouse-face (list :background (car color)
549 :foreground (if light-p "black" "white"))
550 'color-name (car color)
551 'action callback-fn)))
552 (insert "\n"))
553 (goto-char (point-min))))
554
539 555
540(defun list-colors-duplicates (&optional list) 556(defun list-colors-duplicates (&optional list)
541 "Return a list of colors with grouped duplicate colors. 557 "Return a list of colors with grouped duplicate colors.
diff --git a/lisp/files.el b/lisp/files.el
index f0a8d72d3f0..07442d4ba14 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2269,7 +2269,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
2269 ("\\.dtd\\'" . sgml-mode) 2269 ("\\.dtd\\'" . sgml-mode)
2270 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) 2270 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
2271 ("\\.js\\'" . js-mode) ; javascript-mode would be better 2271 ("\\.js\\'" . js-mode) ; javascript-mode would be better
2272 ("\\.[ds]?v\\'" . verilog-mode) 2272 ("\\.[ds]?vh?\\'" . verilog-mode)
2273 ;; .emacs or .gnus or .viper following a directory delimiter in 2273 ;; .emacs or .gnus or .viper following a directory delimiter in
2274 ;; Unix, MSDOG or VMS syntax. 2274 ;; Unix, MSDOG or VMS syntax.
2275 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) 2275 ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
@@ -3112,14 +3112,17 @@ is specified, returning t if it is specified."
3112 ;; Otherwise, set the variables. 3112 ;; Otherwise, set the variables.
3113 (enable-local-variables 3113 (enable-local-variables
3114 (hack-local-variables-filter result nil) 3114 (hack-local-variables-filter result nil)
3115 (when file-local-variables-alist 3115 (hack-local-variables-apply)))))
3116 ;; Any 'evals must run in the Right sequence. 3116
3117 (setq file-local-variables-alist 3117(defun hack-local-variables-apply ()
3118 (nreverse file-local-variables-alist)) 3118 (when file-local-variables-alist
3119 (run-hooks 'before-hack-local-variables-hook) 3119 ;; Any 'evals must run in the Right sequence.
3120 (dolist (elt file-local-variables-alist) 3120 (setq file-local-variables-alist
3121 (hack-one-local-variable (car elt) (cdr elt)))) 3121 (nreverse file-local-variables-alist))
3122 (run-hooks 'hack-local-variables-hook))))) 3122 (run-hooks 'before-hack-local-variables-hook)
3123 (dolist (elt file-local-variables-alist)
3124 (hack-one-local-variable (car elt) (cdr elt))))
3125 (run-hooks 'hack-local-variables-hook))
3123 3126
3124(defun safe-local-variable-p (sym val) 3127(defun safe-local-variable-p (sym val)
3125 "Non-nil if SYM is safe as a file-local variable with value VAL. 3128 "Non-nil if SYM is safe as a file-local variable with value VAL.
@@ -3413,15 +3416,14 @@ is found. Returns the new class name."
3413Store the directory-local variables in `dir-local-variables-alist' 3416Store the directory-local variables in `dir-local-variables-alist'
3414and `file-local-variables-alist', without applying them." 3417and `file-local-variables-alist', without applying them."
3415 (when (and enable-local-variables 3418 (when (and enable-local-variables
3416 (buffer-file-name) 3419 (not (file-remote-p (or (buffer-file-name) default-directory))))
3417 (not (file-remote-p (buffer-file-name))))
3418 ;; Find the variables file. 3420 ;; Find the variables file.
3419 (let ((variables-file (dir-locals-find-file (buffer-file-name))) 3421 (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory)))
3420 (class nil) 3422 (class nil)
3421 (dir-name nil)) 3423 (dir-name nil))
3422 (cond 3424 (cond
3423 ((stringp variables-file) 3425 ((stringp variables-file)
3424 (setq dir-name (file-name-directory (buffer-file-name))) 3426 (setq dir-name (if (buffer-file-name) (file-name-directory (buffer-file-name)) default-directory))
3425 (setq class (dir-locals-read-from-file variables-file))) 3427 (setq class (dir-locals-read-from-file variables-file)))
3426 ((consp variables-file) 3428 ((consp variables-file)
3427 (setq dir-name (nth 0 variables-file)) 3429 (setq dir-name (nth 0 variables-file))
@@ -3438,6 +3440,10 @@ and `file-local-variables-alist', without applying them."
3438 (push elt dir-local-variables-alist)) 3440 (push elt dir-local-variables-alist))
3439 (hack-local-variables-filter variables dir-name))))))) 3441 (hack-local-variables-filter variables dir-name)))))))
3440 3442
3443(defun hack-dir-local-variables-non-file-buffer ()
3444 (hack-dir-local-variables)
3445 (hack-local-variables-apply))
3446
3441 3447
3442(defcustom change-major-mode-with-file-name t 3448(defcustom change-major-mode-with-file-name t
3443 "Non-nil means \\[write-file] should set the major mode from the file name. 3449 "Non-nil means \\[write-file] should set the major mode from the file name.
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 1ce4f25af70..755ff696453 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -72,7 +72,7 @@
72(defgroup hl-line nil 72(defgroup hl-line nil
73 "Highlight the current line." 73 "Highlight the current line."
74 :version "21.1" 74 :version "21.1"
75 :group 'editing) 75 :group 'convenience)
76 76
77(defface hl-line 77(defface hl-line
78 '((t :inherit highlight)) 78 '((t :inherit highlight))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 5b785f0031e..6169fa4cb71 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -466,7 +466,7 @@ was inserted."
466 (buffer-substring-no-properties (point-min) (point-max))) 466 (buffer-substring-no-properties (point-min) (point-max)))
467 filename)) 467 filename))
468 (type (image-type file-or-data nil data-p)) 468 (type (image-type file-or-data nil data-p))
469 (image (create-image file-or-data type data-p)) 469 (image (create-animated-image file-or-data type data-p))
470 (props 470 (props
471 `(display ,image 471 `(display ,image
472 intangible ,image 472 intangible ,image
diff --git a/lisp/image.el b/lisp/image.el
index 944c6135e23..83ab6288e9a 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1,7 +1,7 @@
1;;; image.el --- image API 1;;; image.el --- image API
2 2
3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: multimedia 7;; Keywords: multimedia
@@ -584,7 +584,111 @@ Example:
584 (declare (doc-string 3)) 584 (declare (doc-string 3))
585 `(defvar ,symbol (find-image ',specs) ,doc)) 585 `(defvar ,symbol (find-image ',specs) ,doc))
586 586
587
588;;; Animated image API
587 589
590(defcustom image-animate-max-time 30
591 "Time in seconds to animate images."
592 :type 'integer
593 :version "24.1"
594 :group 'image)
595
596(defconst image-animated-types '(gif)
597 "List of supported animated image types.")
598
599;;;###autoload
600(defun create-animated-image (file-or-data &optional type data-p &rest props)
601 "Create an animated image.
602FILE-OR-DATA is an image file name or image data.
603Optional TYPE is a symbol describing the image type. If TYPE is omitted
604or nil, try to determine the image type from its first few bytes
605of image data. If that doesn't work, and FILE-OR-DATA is a file name,
606use its file extension as image type.
607Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
608Optional PROPS are additional image attributes to assign to the image,
609like, e.g. `:mask MASK'.
610Value is the image created, or nil if images of type TYPE are not supported.
611
612Images should not be larger than specified by `max-image-size'."
613 (setq type (image-type file-or-data type data-p))
614 (when (image-type-available-p type)
615 (let* ((animate (memq type image-animated-types))
616 (image
617 (append (list 'image :type type (if data-p :data :file) file-or-data)
618 (if animate '(:index 0 :mask heuristic))
619 props)))
620 (if animate
621 (image-animate-start image))
622 image)))
623
624(defun image-animate-timer (image)
625 "Return the animation timer for image IMAGE."
626 ;; See cancel-function-timers
627 (let ((tail timer-list) timer)
628 (while tail
629 (setq timer (car tail)
630 tail (cdr tail))
631 (if (and (eq (aref timer 5) #'image-animate-timeout)
632 (consp (aref timer 6))
633 (eq (car (aref timer 6)) image))
634 (setq tail nil)
635 (setq timer nil)))
636 timer))
637
638(defun image-animate-start (image &optional max-time)
639 "Start animation of image IMAGE.
640Optional second arg MAX-TIME is number of seconds to animate image,
641or t to animate infinitely."
642 (let ((anim (image-animated-p image))
643 timer tmo)
644 (when anim
645 (if (setq timer (image-animate-timer image))
646 (setcar (nthcdr 3 (aref timer 6)) max-time)
647 (setq tmo (* (cdr anim) 0.01))
648 (setq max-time (or max-time image-animate-max-time))
649 (run-with-timer tmo nil #'image-animate-timeout
650 image 1 (car anim)
651 (if (numberp max-time)
652 (- max-time tmo)
653 max-time))))))
654
655(defun image-animate-stop (image)
656 "Stop animation of image."
657 (let ((timer (image-animate-timer image)))
658 (when timer
659 (cancel-timer timer))))
660
661(defun image-animate-timeout (image ino count time-left)
662 (if (>= ino count)
663 (setq ino 0))
664 (plist-put (cdr image) :index ino)
665 (force-window-update)
666 (let ((anim (image-animated-p image)) tmo)
667 (when anim
668 (setq tmo (* (cdr anim) 0.01))
669 (unless (and (= ino 0) (numberp time-left) (< time-left tmo))
670 (run-with-timer tmo nil #'image-animate-timeout
671 image (1+ ino) count
672 (if (numberp time-left)
673 (- time-left tmo)
674 time-left))))))
675
676(defun image-animated-p (image)
677 "Return non-nil if image is animated.
678Actually, return value is a cons (IMAGES . DELAY) where IMAGES
679is the number of sub-images in the animated image, and DELAY
680is the delay in 100ths of a second until the next sub-image
681shall be displayed."
682 (cond
683 ((eq (plist-get (cdr image) :type) 'gif)
684 (let* ((extdata (image-extension-data image))
685 (images (plist-get extdata 'count))
686 (anim (plist-get extdata #xF9)))
687 (and (integerp images) (> images 1)
688 (stringp anim) (>= (length anim) 4)
689 (cons images (+ (aref anim 1) (* (aref anim 2) 256))))))))
690
691
588(provide 'image) 692(provide 'image)
589 693
590;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3 694;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index ac69cf5c7fa..2431c9d9e99 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -50,6 +50,14 @@ and Italian.")))
50 :charset-list '(iso-8859-6) 50 :charset-list '(iso-8859-6)
51 :mime-charset 'iso-8859-6) 51 :mime-charset 'iso-8859-6)
52 52
53(define-coding-system 'windows-1256
54 "windows-1256 (Arabic) encoding (MIME: WINDOWS-1256)"
55 :coding-type 'charset
56 :mnemonic ?A
57 :charset-list '(windows-1256)
58 :mime-charset 'windows-1256)
59(define-coding-system-alias 'cp1256 'windows-1256)
60
53(provide 'misc-lang) 61(provide 'misc-lang)
54 62
55;; arch-tag: 6953585c-1a1a-4c09-be82-a2518afb6074 63;; arch-tag: 6953585c-1a1a-4c09-be82-a2518afb6074
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index 10c6d480d23..e26521642da 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -368,7 +368,8 @@ commands (under C-x v for VC, for example).
368\\{log-edit-mode-map}" 368\\{log-edit-mode-map}"
369 (set (make-local-variable 'font-lock-defaults) 369 (set (make-local-variable 'font-lock-defaults)
370 '(log-edit-font-lock-keywords t)) 370 '(log-edit-font-lock-keywords t))
371 (make-local-variable 'log-edit-comment-ring-index)) 371 (make-local-variable 'log-edit-comment-ring-index)
372 (hack-dir-local-variables-non-file-buffer))
372 373
373(defun log-edit-hide-buf (&optional buf where) 374(defun log-edit-hide-buf (&optional buf where)
374 (when (setq buf (get-buffer (or buf log-edit-files-buf))) 375 (when (setq buf (get-buffer (or buf log-edit-files-buf)))
diff --git a/lisp/log-view.el b/lisp/log-view.el
index 6fbe8429671..5c454ead5fc 100644
--- a/lisp/log-view.el
+++ b/lisp/log-view.el
@@ -255,7 +255,8 @@ The match group number 1 should match the revision number itself.")
255 'log-view-beginning-of-defun) 255 'log-view-beginning-of-defun)
256 (set (make-local-variable 'end-of-defun-function) 256 (set (make-local-variable 'end-of-defun-function)
257 'log-view-end-of-defun) 257 'log-view-end-of-defun)
258 (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap)) 258 (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap)
259 (hack-dir-local-variables-non-file-buffer))
259 260
260;;;; 261;;;;
261;;;; Navigation 262;;;; Navigation
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
index 64c7c57f8db..47326b636a1 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/mail/metamail.el
@@ -40,7 +40,6 @@
40(defgroup metamail nil 40(defgroup metamail nil
41 "Metamail interface for Emacs." 41 "Metamail interface for Emacs."
42 :group 'mail 42 :group 'mail
43 :group 'hypermedia
44 :group 'processes) 43 :group 'processes)
45 44
46(defcustom metamail-program-name "metamail" 45(defcustom metamail-program-name "metamail"
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index e1e6932a560..2bdf16eff96 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -290,32 +290,36 @@
290 (replace-match "\\1 " t)) 290 (replace-match "\\1 " t))
291 291
292 (goto-char (point-min)) 292 (goto-char (point-min))
293 (let ((list ()) 293 ;; Give `rfc822-address-start' a non-nil initial value to
294 tem 294 ;; prevent `rfc822-bad-address' from raising a
295 ;; This is for rfc822-bad-address. Give it a non-nil 295 ;; `wrong-type-argument' error.
296 ;; initial value to prevent rfc822-bad-address from 296 (let* ((rfc822-address-start (point))
297 ;; raising a wrong-type-argument error 297 list tem
298 (rfc822-address-start (point))) 298 (err
299 (catch 'address ; this is for rfc822-bad-address 299 (catch 'address
300 (rfc822-nuke-whitespace) 300 ;; Note that `rfc822-nuke-whitespace' and
301 (while (not (eobp)) 301 ;; `rfc822-looking-at' can throw.
302 (setq rfc822-address-start (point)) 302 (rfc822-nuke-whitespace)
303 (setq tem 303 (while (not (eobp))
304 (cond ((rfc822-looking-at ?\,) 304 (setq rfc822-address-start (point))
305 nil) 305 (setq tem
306 ((looking-at "[][\000-\037@;:\\.>)]") 306 (cond ((rfc822-looking-at ?\,)
307 (forward-char) 307 nil)
308 (rfc822-bad-address 308 ((looking-at "[][\000-\037@;:\\.>)]")
309 (format "Strange character \\%c found" 309 (forward-char)
310 (preceding-char)))) 310 (catch 'address ; For rfc822-bad-address
311 (t 311 (rfc822-bad-address
312 (rfc822-addresses-1 t)))) 312 (format "Strange character \\%c found"
313 (cond ((null tem)) 313 (preceding-char)))))
314 ((stringp tem) 314 (t
315 (setq list (cons tem list))) 315 (rfc822-addresses-1 t))))
316 (t 316 (cond ((null tem))
317 (setq list (nconc (nreverse tem) list))))) 317 ((stringp tem)
318 (nreverse list)))) 318 (setq list (cons tem list)))
319 (t
320 (setq list (nconc (nreverse tem) list)))))
321 nil)))
322 (nreverse (append (if err (list err)) list))))
319 (and buf (kill-buffer buf)))))) 323 (and buf (kill-buffer buf))))))
320 324
321(provide 'rfc822) 325(provide 'rfc822)
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 83d5e391ffd..4405249d981 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,7 @@
12010-03-10 Chong Yidong <cyd@stupidchicken.com>
2
3 * Branch for 23.2.
4
12009-12-01 Bill Wohler <wohler@newt.com> 52009-12-01 Bill Wohler <wohler@newt.com>
2 6
3 * mh-search.el (mh-mairix-execute-search): Use mh vfolder_format. 7 * mh-search.el (mh-mairix-execute-search): Use mh vfolder_format.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 6e468386749..336ffdadd09 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -676,6 +676,7 @@
676 "Accessing remote files and directories using FTP 676 "Accessing remote files and directories using FTP
677 made as simple and transparent as possible." 677 made as simple and transparent as possible."
678 :group 'files 678 :group 'files
679 :group 'comm
679 :prefix "ange-ftp-") 680 :prefix "ange-ftp-")
680 681
681(defcustom ange-ftp-name-format 682(defcustom ange-ftp-name-format
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 3a5fa8c30a6..261b765eaeb 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -215,7 +215,8 @@
215 "Use a web browser to look at a URL." 215 "Use a web browser to look at a URL."
216 :prefix "browse-url-" 216 :prefix "browse-url-"
217 :link '(emacs-commentary-link "browse-url") 217 :link '(emacs-commentary-link "browse-url")
218 :group 'hypermedia) 218 :group 'external
219 :group 'comm)
219 220
220;;;###autoload 221;;;###autoload
221(defcustom browse-url-browser-function 222(defcustom browse-url-browser-function
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index fd8c1061bcb..182758aaffb 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -76,7 +76,7 @@
76(defgroup goto-address nil 76(defgroup goto-address nil
77 "Click to browse URL or to send to e-mail address." 77 "Click to browse URL or to send to e-mail address."
78 :group 'mouse 78 :group 'mouse
79 :group 'hypermedia) 79 :group 'comm)
80 80
81 81
82;; I don't expect users to want fontify'ing without highlighting. 82;; I don't expect users to want fontify'ing without highlighting.
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index e388f698100..9cbb919abcc 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -3,7 +3,7 @@
3;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> 5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104 6;; Keywords: HMAC, RFC-2104
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
9 9
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 86d149ffaae..9bda79d36f0 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -3,7 +3,7 @@
3;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2001, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 4
5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> 5;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
6;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 6;; Keywords: HMAC, RFC-2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
9 9
diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
index d36569b5c23..92dbb4fef3a 100644
--- a/lisp/net/tramp-imap.el
+++ b/lisp/net/tramp-imap.el
@@ -168,7 +168,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
168(defgroup tramp-imap nil 168(defgroup tramp-imap nil
169 "Tramp over IMAP configuration." 169 "Tramp over IMAP configuration."
170 :version "23.2" 170 :version "23.2"
171 :group 'applications) 171 :group 'tramp)
172 172
173(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker" 173(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker"
174 "The subject marker that Tramp-IMAP will use." 174 "The subject marker that Tramp-IMAP will use."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c029f073724..8a3ec552d4d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -176,6 +176,7 @@
176(defgroup tramp nil 176(defgroup tramp nil
177 "Edit remote files with a combination of rsh and rcp or similar programs." 177 "Edit remote files with a combination of rsh and rcp or similar programs."
178 :group 'files 178 :group 'files
179 :group 'comm
179 :version "22.1") 180 :version "22.1")
180 181
181;; Maybe we need once a real Tramp mode, with key bindings etc. 182;; Maybe we need once a real Tramp mode, with key bindings etc.
diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el
index 35df085bc57..03c188006d0 100644
--- a/lisp/net/xesam.el
+++ b/lisp/net/xesam.el
@@ -151,7 +151,7 @@
151(defgroup xesam nil 151(defgroup xesam nil
152 "Xesam compatible interface to search engines." 152 "Xesam compatible interface to search engines."
153 :group 'extensions 153 :group 'extensions
154 :group 'hypermedia 154 :group 'comm
155 :version "23.1") 155 :version "23.1")
156 156
157(defcustom xesam-query-type 'user-query 157(defcustom xesam-query-type 'user-query
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 8919d920c9d..5eb9840a4ca 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -45,8 +45,7 @@
45 45
46(defgroup nxml nil 46(defgroup nxml nil
47 "New XML editing mode." 47 "New XML editing mode."
48 :group 'languages 48 :group 'languages)
49 :group 'wp)
50 49
51(defgroup nxml-faces nil 50(defgroup nxml-faces nil
52 "Faces for XML syntax highlighting." 51 "Faces for XML syntax highlighting."
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 7ce303b5add..b70fb150735 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,11 @@
12010-03-12 Chong Yidong <cyd@stupidchicken.com>
2
3 * org.el (org): Remove from hypermedia group.
4
52010-03-10 Chong Yidong <cyd@stupidchicken.com>
6
7 * Branch for 23.2.
8
12010-02-15 Chong Yidong <cyd@stupidchicken.com> 92010-02-15 Chong Yidong <cyd@stupidchicken.com>
2 10
3 * org-freemind.el (org-freemind-from-org-mode-node) 11 * org-freemind.el (org-freemind-from-org-mode-node)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index a404551f3cb..54025f4d83c 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -134,7 +134,6 @@ With prefix arg HERE, insert it at point."
134 "Outline-based notes management and organizer." 134 "Outline-based notes management and organizer."
135 :tag "Org" 135 :tag "Org"
136 :group 'outlines 136 :group 'outlines
137 :group 'hypermedia
138 :group 'calendar) 137 :group 'calendar)
139 138
140(defcustom org-mode-hook nil 139(defcustom org-mode-hook nil
diff --git a/lisp/outline.el b/lisp/outline.el
index b5d3d798714..5b10de231f2 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -41,7 +41,7 @@
41(defgroup outlines nil 41(defgroup outlines nil
42 "Support for hierarchical outlining." 42 "Support for hierarchical outlining."
43 :prefix "outline-" 43 :prefix "outline-"
44 :group 'editing) 44 :group 'wp)
45 45
46(defcustom outline-regexp "[*\^L]+" 46(defcustom outline-regexp "[*\^L]+"
47 "Regular expression to match the beginning of a heading. 47 "Regular expression to match the beginning of a heading.
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 0efac03f7d5..7c7397a52bc 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1497,7 +1497,7 @@ Please send all bug fixes and enhancements to
1497 "Support for printing and PostScript." 1497 "Support for printing and PostScript."
1498 :tag "PostScript" 1498 :tag "PostScript"
1499 :version "20" 1499 :version "20"
1500 :group 'emacs) 1500 :group 'external)
1501 1501
1502(defgroup ps-print nil 1502(defgroup ps-print nil
1503 "PostScript generator for Emacs." 1503 "PostScript generator for Emacs."
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 9838ade89f1..ff5c8807de5 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -49,7 +49,7 @@
49 49
50(defgroup reveal nil 50(defgroup reveal nil
51 "Reveal hidden text on the fly." 51 "Reveal hidden text on the fly."
52 :group 'editing) 52 :group 'convenience)
53 53
54(defcustom reveal-around-mark t 54(defcustom reveal-around-mark t
55 "Reveal text around the mark, if active." 55 "Reveal text around the mark, if active."
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 2673ee15457..e4ed2c8a051 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -34,7 +34,7 @@
34(defgroup picture nil 34(defgroup picture nil
35 "Picture mode --- editing using quarter-plane screen model." 35 "Picture mode --- editing using quarter-plane screen model."
36 :prefix "picture-" 36 :prefix "picture-"
37 :group 'editing) 37 :group 'wp)
38 38
39(defcustom picture-rectangle-ctl ?+ 39(defcustom picture-rectangle-ctl ?+
40 "*Character `picture-draw-rectangle' uses for top left corners." 40 "*Character `picture-draw-rectangle' uses for top left corners."
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 44933bff327..3e092374207 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -640,14 +640,10 @@
640;;; 640;;;
641 641
642(defgroup table nil 642(defgroup table nil
643 "Text based table manipulation utilities. 643 "Text based table manipulation utilities."
644See `table-insert' for examples about how to use."
645 :tag "Table" 644 :tag "Table"
646 :prefix "table-" 645 :prefix "table-"
647 :group 'editing
648 :group 'wp 646 :group 'wp
649 :group 'paragraphs
650 :group 'fill
651 :version "22.1") 647 :version "22.1")
652 648
653(defgroup table-hooks nil 649(defgroup table-hooks nil
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 75897a2cf07..51040824b20 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -32,7 +32,7 @@
32 "Normal hook run when entering Text mode and many related modes." 32 "Normal hook run when entering Text mode and many related modes."
33 :type 'hook 33 :type 'hook
34 :options '(turn-on-auto-fill turn-on-flyspell) 34 :options '(turn-on-auto-fill turn-on-flyspell)
35 :group 'data) 35 :group 'wp)
36 36
37(defvar text-mode-variant nil 37(defvar text-mode-variant nil
38 "Non-nil if this buffer's major mode is a variant of Text mode. 38 "Non-nil if this buffer's major mode is a variant of Text mode.
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index ddf15e243c4..27093042efe 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -89,7 +89,7 @@
89 89
90(defgroup uniquify nil 90(defgroup uniquify nil
91 "Unique buffer names dependent on file name." 91 "Unique buffer names dependent on file name."
92 :group 'applications) 92 :group 'files)
93 93
94 94
95(defcustom uniquify-buffer-name-style nil 95(defcustom uniquify-buffer-name-style nil
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 2a8c6ebe25b..7309402a848 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,11 @@
12010-03-12 Chong Yidong <cyd@stupidchicken.com>
2
3 * url-vars.el (url): Put in comm group.
4
52010-03-10 Chong Yidong <cyd@stupidchicken.com>
6
7 * Branch for 23.2.
8
12010-01-23 Chong Yidong <cyd@stupidchicken.com> 92010-01-23 Chong Yidong <cyd@stupidchicken.com>
2 10
3 * url-util.el: Require url-vars (Bug#5459). 11 * url-util.el: Require url-vars (Bug#5459).
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 2062f482ede..1b9fd7b76cc 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -30,7 +30,7 @@
30(defgroup url nil 30(defgroup url nil
31 "Uniform Resource Locator tool." 31 "Uniform Resource Locator tool."
32 :version "22.1" 32 :version "22.1"
33 :group 'hypermedia) 33 :group 'comm)
34 34
35(defgroup url-file nil 35(defgroup url-file nil
36 "URL storage." 36 "URL storage."
diff --git a/lisp/vc-annotate.el b/lisp/vc-annotate.el
index 71839443553..1878fe8740f 100644
--- a/lisp/vc-annotate.el
+++ b/lisp/vc-annotate.el
@@ -162,7 +162,8 @@ menu items."
162 (remove-from-invisibility-spec 'foo) 162 (remove-from-invisibility-spec 'foo)
163 (set (make-local-variable 'truncate-lines) t) 163 (set (make-local-variable 'truncate-lines) t)
164 (set (make-local-variable 'font-lock-defaults) 164 (set (make-local-variable 'font-lock-defaults)
165 '(vc-annotate-font-lock-keywords t))) 165 '(vc-annotate-font-lock-keywords t))
166 (hack-dir-local-variables-non-file-buffer))
166 167
167(defun vc-annotate-toggle-annotation-visibility () 168(defun vc-annotate-toggle-annotation-visibility ()
168 "Toggle whether or not the annotation is visible." 169 "Toggle whether or not the annotation is visible."
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index b0dbb8ec192..75845f0aa2c 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -758,9 +758,11 @@ stream. Standard error output is discarded."
758 758
759 (define-key map [down-mouse-3] 'vc-bzr-shelve-menu) 759 (define-key map [down-mouse-3] 'vc-bzr-shelve-menu)
760 (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point) 760 (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point)
761 ;; (define-key map "=" 'vc-bzr-shelve-show-at-point) 761 (define-key map "=" 'vc-bzr-shelve-show-at-point)
762 ;; (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) 762 (define-key map "\C-m" 'vc-bzr-shelve-show-at-point)
763 (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point)
763 (define-key map "P" 'vc-bzr-shelve-apply-at-point) 764 (define-key map "P" 'vc-bzr-shelve-apply-at-point)
765 (define-key map "S" 'vc-bzr-shelve-snapshot)
764 map)) 766 map))
765 767
766(defvar vc-bzr-shelve-menu-map 768(defvar vc-bzr-shelve-menu-map
@@ -768,16 +770,22 @@ stream. Standard error output is discarded."
768 (define-key map [de] 770 (define-key map [de]
769 '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point 771 '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point
770 :help "Delete the current shelf")) 772 :help "Delete the current shelf"))
773 (define-key map [ap]
774 '(menu-item "Apply and keep shelf" vc-bzr-shelve-apply-and-keep-at-point
775 :help "Apply the current shelf and keep it"))
771 (define-key map [po] 776 (define-key map [po]
772 '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point 777 '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point
773 :help "Apply the current shelf and remove it")) 778 :help "Apply the current shelf and remove it"))
774 ;; (define-key map [sh] 779 (define-key map [sh]
775 ;; '(menu-item "Show shelve" vc-bzr-shelve-show-at-point 780 '(menu-item "Show shelve" vc-bzr-shelve-show-at-point
776 ;; :help "Show the contents of the current shelve")) 781 :help "Show the contents of the current shelve"))
777 map)) 782 map))
778 783
779(defvar vc-bzr-extra-menu-map 784(defvar vc-bzr-extra-menu-map
780 (let ((map (make-sparse-keymap))) 785 (let ((map (make-sparse-keymap)))
786 (define-key map [bzr-sn]
787 '(menu-item "Shelve a snapshot" vc-bzr-shelve-snapshot
788 :help "Shelve the current state of the tree and keep the current state"))
781 (define-key map [bzr-sh] 789 (define-key map [bzr-sh]
782 '(menu-item "Shelve..." vc-bzr-shelve 790 '(menu-item "Shelve..." vc-bzr-shelve
783 :help "Shelve changes")) 791 :help "Shelve changes"))
@@ -864,16 +872,16 @@ stream. Standard error output is discarded."
864 (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) 872 (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
865 (vc-resynch-buffer root t t)))) 873 (vc-resynch-buffer root t t))))
866 874
867;; (defun vc-bzr-shelve-show (name) 875(defun vc-bzr-shelve-show (name)
868;; "Show the contents of shelve NAME." 876 "Show the contents of shelve NAME."
869;; (interactive "sShelve name: ") 877 (interactive "sShelve name: ")
870;; (vc-setup-buffer "*vc-bzr-shelve*") 878 (vc-setup-buffer "*vc-bzr-shelve*")
871;; ;; FIXME: how can you show the contents of a shelf? 879 ;; FIXME: how can you show the contents of a shelf?
872;; (vc-bzr-command "shelve" "*vc-bzr-shelve*" 'async nil name) 880 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 'async nil "--preview" name)
873;; (set-buffer "*vc-bzr-shelve*") 881 (set-buffer "*vc-bzr-shelve*")
874;; (diff-mode) 882 (diff-mode)
875;; (setq buffer-read-only t) 883 (setq buffer-read-only t)
876;; (pop-to-buffer (current-buffer))) 884 (pop-to-buffer (current-buffer)))
877 885
878(defun vc-bzr-shelve-apply (name) 886(defun vc-bzr-shelve-apply (name)
879 "Apply shelve NAME and remove it afterwards." 887 "Apply shelve NAME and remove it afterwards."
@@ -881,6 +889,23 @@ stream. Standard error output is discarded."
881 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name) 889 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name)
882 (vc-resynch-buffer (vc-bzr-root default-directory) t t)) 890 (vc-resynch-buffer (vc-bzr-root default-directory) t t))
883 891
892(defun vc-bzr-shelve-apply-and-keep (name)
893 "Apply shelve NAME and keep it afterwards."
894 (interactive "sApply (and keep) shelf: ")
895 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep" name)
896 (vc-resynch-buffer (vc-bzr-root default-directory) t t))
897
898(defun vc-bzr-shelve-snapshot ()
899 "Create a stash with the current tree state."
900 (interactive)
901 (vc-bzr-command "shelve" nil 0 nil "--all" "-m"
902 (let ((ct (current-time)))
903 (concat
904 (format-time-string "Snapshot on %Y-%m-%d" ct)
905 (format-time-string " at %H:%M" ct))))
906 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep")
907 (vc-resynch-buffer (vc-bzr-root default-directory) t t))
908
884(defun vc-bzr-shelve-list () 909(defun vc-bzr-shelve-list ()
885 (with-temp-buffer 910 (with-temp-buffer
886 (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q") 911 (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q")
@@ -905,14 +930,18 @@ stream. Standard error output is discarded."
905 (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve) 930 (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
906 (vc-dir-refresh)))) 931 (vc-dir-refresh))))
907 932
908;; (defun vc-bzr-shelve-show-at-point () 933(defun vc-bzr-shelve-show-at-point ()
909;; (interactive) 934 (interactive)
910;; (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point)))) 935 (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point))))
911 936
912(defun vc-bzr-shelve-apply-at-point () 937(defun vc-bzr-shelve-apply-at-point ()
913 (interactive) 938 (interactive)
914 (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point)))) 939 (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point))))
915 940
941(defun vc-bzr-shelve-apply-and-keep-at-point ()
942 (interactive)
943 (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point))))
944
916(defun vc-bzr-shelve-menu (e) 945(defun vc-bzr-shelve-menu (e)
917 (interactive "e") 946 (interactive "e")
918 (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e))) 947 (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e)))
diff --git a/lisp/vc-dir.el b/lisp/vc-dir.el
index 2f661e8becf..a0350eb3013 100644
--- a/lisp/vc-dir.el
+++ b/lisp/vc-dir.el
@@ -938,6 +938,7 @@ the *vc-dir* buffer.
938 ;; Make sure that if the directory buffer is killed, the update 938 ;; Make sure that if the directory buffer is killed, the update
939 ;; process running in the background is also killed. 939 ;; process running in the background is also killed.
940 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t) 940 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
941 (hack-dir-local-variables-non-file-buffer)
941 (vc-dir-refresh))) 942 (vc-dir-refresh)))
942 943
943(defun vc-dir-headers (backend dir) 944(defun vc-dir-headers (backend dir)
diff --git a/lisp/vc-git.el b/lisp/vc-git.el
index d645a4c05ba..eab3b650fa4 100644
--- a/lisp/vc-git.el
+++ b/lisp/vc-git.el
@@ -587,7 +587,7 @@ or an empty string if none."
587 '("log" "--no-color") 587 '("log" "--no-color")
588 (when shortlog 588 (when shortlog
589 '("--graph" "--decorate" "--date=short" 589 '("--graph" "--decorate" "--date=short"
590 "--pretty=format:%d%h %ad %s" "--abbrev-commit")) 590 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit"))
591 (when limit (list "-n" (format "%s" limit))) 591 (when limit (list "-n" (format "%s" limit)))
592 (when start-revision (list start-revision)) 592 (when start-revision (list start-revision))
593 '("--"))))))) 593 '("--")))))))
@@ -673,7 +673,8 @@ or BRANCH^ (where \"^\" can be repeated)."
673 (with-temp-buffer 673 (with-temp-buffer
674 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") 674 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
675 (goto-char (point-min)) 675 (goto-char (point-min))
676 (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t) 676 (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
677 nil t)
677 (push (match-string 2) table))) 678 (push (match-string 2) table)))
678 table)) 679 table))
679 680
@@ -703,7 +704,8 @@ or BRANCH^ (where \"^\" can be repeated)."
703 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?") 704 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
704 (let ((revision (match-string-no-properties 1))) 705 (let ((revision (match-string-no-properties 1)))
705 (if (match-beginning 2) 706 (if (match-beginning 2)
706 (cons revision (expand-file-name (match-string-no-properties 3))) 707 (cons revision (expand-file-name (match-string-no-properties 3)
708 (vc-git-root default-directory)))
707 revision))))) 709 revision)))))
708 710
709;;; TAG SYSTEM 711;;; TAG SYSTEM
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 3573a86ad49..9e8fbf431f1 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -325,7 +325,7 @@
325(defgroup vcursor nil 325(defgroup vcursor nil
326 "Manipulate an alternative (\"virtual\") cursor." 326 "Manipulate an alternative (\"virtual\") cursor."
327 :prefix "vcursor-" 327 :prefix "vcursor-"
328 :group 'editing) 328 :group 'convenience)
329 329
330(defface vcursor 330(defface vcursor
331 '((((class color)) (:foreground "blue" :background "cyan" :underline t)) 331 '((((class color)) (:foreground "blue" :background "cyan" :underline t))
diff --git a/lisp/version.el b/lisp/version.el
index 905733a56b3..5cd0cc8d634 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -32,7 +32,7 @@
32(defconst emacs-copyright "Copyright (C) 2010 Free Software Foundation, Inc." "\ 32(defconst emacs-copyright "Copyright (C) 2010 Free Software Foundation, Inc." "\
33Short copyright string for this version of Emacs.") 33Short copyright string for this version of Emacs.")
34 34
35(defconst emacs-version "23.1.93" "\ 35(defconst emacs-version "24.0.50" "\
36Version numbers of this version of Emacs.") 36Version numbers of this version of Emacs.")
37 37
38(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\ 38(defconst emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-number (match-string 0 emacs-version))) "\
diff --git a/lisp/view.el b/lisp/view.el
index 219af1b6e1e..63db3452a87 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -48,8 +48,7 @@
48 "Peruse file or buffer without editing." 48 "Peruse file or buffer without editing."
49 :link '(function-link view-mode) 49 :link '(function-link view-mode)
50 :link '(custom-manual "(emacs)Misc File Ops") 50 :link '(custom-manual "(emacs)Misc File Ops")
51 :group 'wp 51 :group 'wp)
52 :group 'editing)
53 52
54(defcustom view-highlight-face 'highlight 53(defcustom view-highlight-face 'highlight
55 "The face used for highlighting the match found by View mode search." 54 "The face used for highlighting the match found by View mode search."
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 183698a28f3..79ce9a330d4 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -378,8 +378,7 @@
378 "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)." 378 "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
379 :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el") 379 :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el")
380 :version "23.1" 380 :version "23.1"
381 :group 'wp 381 :group 'convenience)
382 :group 'data)
383 382
384 383
385(defcustom whitespace-style 384(defcustom whitespace-style
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index a087f17a900..6296a965df9 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -78,8 +78,7 @@
78 :link '(custom-manual "(widget)Top") 78 :link '(custom-manual "(widget)Top")
79 :link '(emacs-library-link :tag "Lisp File" "widget.el") 79 :link '(emacs-library-link :tag "Lisp File" "widget.el")
80 :prefix "widget-" 80 :prefix "widget-"
81 :group 'extensions 81 :group 'extensions)
82 :group 'hypermedia)
83 82
84(defgroup widget-documentation nil 83(defgroup widget-documentation nil
85 "Options controlling the display of documentation strings." 84 "Options controlling the display of documentation strings."
@@ -639,8 +638,7 @@ extension (xpm, xbm, gif, jpg, or png) located in
639 (dolist (elt widget-image-conversion) 638 (dolist (elt widget-image-conversion)
640 (dolist (ext (cdr elt)) 639 (dolist (ext (cdr elt))
641 (push (list :type (car elt) :file (concat image ext)) specs))) 640 (push (list :type (car elt) :file (concat image ext)) specs)))
642 (setq specs (nreverse specs)) 641 (find-image (nreverse specs))))
643 (find-image specs)))
644 (t 642 (t
645 ;; Oh well. 643 ;; Oh well.
646 nil))) 644 nil)))
@@ -657,7 +655,7 @@ IMAGE should either be an image or an image file name sans extension
657 655
658Optional arguments DOWN and INACTIVE are used instead of IMAGE when the 656Optional arguments DOWN and INACTIVE are used instead of IMAGE when the
659button is pressed or inactive, respectively. These are currently ignored." 657button is pressed or inactive, respectively. These are currently ignored."
660 (if (and (display-graphic-p) 658 (if (and (featurep 'image)
661 (setq image (widget-image-find image))) 659 (setq image (widget-image-find image)))
662 (progn (widget-put widget :suppress-face t) 660 (progn (widget-put widget :suppress-face t)
663 (insert-image image tag)) 661 (insert-image image tag))
@@ -1874,6 +1872,7 @@ by some other text in the `:format' string (if specified)."
1874 :valid-regexp "" 1872 :valid-regexp ""
1875 :error "Field's value doesn't match allowed forms" 1873 :error "Field's value doesn't match allowed forms"
1876 :value-create 'widget-field-value-create 1874 :value-create 'widget-field-value-create
1875 :value-set 'widget-field-value-set
1877 :value-delete 'widget-field-value-delete 1876 :value-delete 'widget-field-value-delete
1878 :value-get 'widget-field-value-get 1877 :value-get 'widget-field-value-get
1879 :match 'widget-field-match) 1878 :match 'widget-field-match)
@@ -1912,6 +1911,18 @@ the earlier input."
1912 (widget-apply widget :value-get)) 1911 (widget-apply widget :value-get))
1913 widget)) 1912 widget))
1914 1913
1914(defun widget-field-value-set (widget value)
1915 "Set an editable text field WIDGET to VALUE"
1916 (let ((from (widget-field-start widget))
1917 (to (widget-field-text-end widget))
1918 (buffer (widget-field-buffer widget))
1919 (size (widget-get widget :size)))
1920 (when (and from to (buffer-live-p buffer))
1921 (with-current-buffer buffer
1922 (goto-char from)
1923 (delete-char (- to from))
1924 (insert value)))))
1925
1915(defun widget-field-value-create (widget) 1926(defun widget-field-value-create (widget)
1916 "Create an editable text field." 1927 "Create an editable text field."
1917 (let ((size (widget-get widget :size)) 1928 (let ((size (widget-get widget :size))
@@ -1949,7 +1960,6 @@ the earlier input."
1949 (let ((from (widget-field-start widget)) 1960 (let ((from (widget-field-start widget))
1950 (to (widget-field-text-end widget)) 1961 (to (widget-field-text-end widget))
1951 (buffer (widget-field-buffer widget)) 1962 (buffer (widget-field-buffer widget))
1952 (size (widget-get widget :size))
1953 (secret (widget-get widget :secret)) 1963 (secret (widget-get widget :secret))
1954 (old (current-buffer))) 1964 (old (current-buffer)))
1955 (if (and from to) 1965 (if (and from to)
@@ -2806,11 +2816,19 @@ Return an alist of (TYPE MATCH)."
2806;;; The `visibility' Widget. 2816;;; The `visibility' Widget.
2807 2817
2808(define-widget 'visibility 'item 2818(define-widget 'visibility 'item
2809 "An indicator and manipulator for hidden items." 2819 "An indicator and manipulator for hidden items.
2820
2821The following properties have special meanings for this widget:
2822:on-image Image filename or spec to display when the item is visible.
2823:on Text shown if the \"on\" image is nil or cannot be displayed.
2824:off-image Image filename or spec to display when the item is hidden.
2825:off Text shown if the \"off\" image is nil cannot be displayed."
2810 :format "%[%v%]" 2826 :format "%[%v%]"
2811 :button-prefix "" 2827 :button-prefix ""
2812 :button-suffix "" 2828 :button-suffix ""
2829 :on-image "down"
2813 :on "Hide" 2830 :on "Hide"
2831 :off-image "right"
2814 :off "Show" 2832 :off "Show"
2815 :value-create 'widget-visibility-value-create 2833 :value-create 'widget-visibility-value-create
2816 :action 'widget-toggle-action 2834 :action 'widget-toggle-action
@@ -2818,21 +2836,17 @@ Return an alist of (TYPE MATCH)."
2818 2836
2819(defun widget-visibility-value-create (widget) 2837(defun widget-visibility-value-create (widget)
2820 ;; Insert text representing the `on' and `off' states. 2838 ;; Insert text representing the `on' and `off' states.
2821 (let ((on (widget-get widget :on)) 2839 (let* ((val (widget-value widget))
2822 (off (widget-get widget :off))) 2840 (text (widget-get widget (if val :on :off)))
2823 (if on 2841 (img (widget-image-find
2824 (setq on (concat widget-push-button-prefix 2842 (widget-get widget (if val :on-image :off-image)))))
2825 on 2843 (widget-image-insert widget
2826 widget-push-button-suffix)) 2844 (if text
2827 (setq on "")) 2845 (concat widget-push-button-prefix text
2828 (if off 2846 widget-push-button-suffix)
2829 (setq off (concat widget-push-button-prefix 2847 "")
2830 off 2848 (if img
2831 widget-push-button-suffix)) 2849 (append img '(:ascent center))))))
2832 (setq off ""))
2833 (if (widget-value widget)
2834 (widget-image-insert widget on "down" "down-pushed")
2835 (widget-image-insert widget off "right" "right-pushed"))))
2836 2850
2837;;; The `documentation-link' Widget. 2851;;; The `documentation-link' Widget.
2838;; 2852;;
@@ -2935,7 +2949,7 @@ link for that string."
2935 (widget-create-child-and-convert 2949 (widget-create-child-and-convert
2936 widget (widget-get widget :visibility-widget) 2950 widget (widget-get widget :visibility-widget)
2937 :help-echo "Show or hide rest of the documentation." 2951 :help-echo "Show or hide rest of the documentation."
2938 :on "Hide Rest" 2952 :on "Hide"
2939 :off "More" 2953 :off "More"
2940 :always-active t 2954 :always-active t
2941 :action 'widget-parent-action 2955 :action 'widget-parent-action
@@ -3692,6 +3706,7 @@ example:
3692(define-widget 'color 'editable-field 3706(define-widget 'color 'editable-field
3693 "Choose a color name (with sample)." 3707 "Choose a color name (with sample)."
3694 :format "%{%t%}: %v (%{sample%})\n" 3708 :format "%{%t%}: %v (%{sample%})\n"
3709 :value-create 'widget-color-value-create
3695 :size 10 3710 :size 10
3696 :tag "Color" 3711 :tag "Color"
3697 :value "black" 3712 :value "black"
@@ -3700,6 +3715,27 @@ example:
3700 :notify 'widget-color-notify 3715 :notify 'widget-color-notify
3701 :action 'widget-color-action) 3716 :action 'widget-color-action)
3702 3717
3718(defun widget-color-value-create (widget)
3719 (widget-field-value-create widget)
3720 (widget-insert " ")
3721 (widget-create-child-and-convert
3722 widget 'push-button
3723 :tag "Choose" :action 'widget-color--choose-action)
3724 (widget-insert " "))
3725
3726(defun widget-color--choose-action (widget &optional event)
3727 (list-colors-display
3728 nil nil
3729 `(lambda (color)
3730 (when (buffer-live-p ,(current-buffer))
3731 (widget-value-set ',(widget-get widget :parent) color)
3732 (let* ((buf (get-buffer "*Colors*"))
3733 (win (get-buffer-window buf 0)))
3734 (bury-buffer buf)
3735 (and win (> (length (window-list)) 1)
3736 (delete-window win)))
3737 (pop-to-buffer ,(current-buffer))))))
3738
3703(defun widget-color-complete (widget) 3739(defun widget-color-complete (widget)
3704 "Complete the color in WIDGET." 3740 "Complete the color in WIDGET."
3705 (require 'facemenu) ; for facemenu-color-alist 3741 (require 'facemenu) ; for facemenu-color-alist