aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog51
-rw-r--r--lisp/comint.el2
-rw-r--r--lisp/cus-edit.el17
-rw-r--r--lisp/cus-start.el4
-rw-r--r--lisp/custom.el29
-rw-r--r--lisp/emacs-lisp/easy-mmode.el10
-rw-r--r--lisp/gnus/ChangeLog40
-rw-r--r--lisp/gnus/gnus-sum.el9
-rw-r--r--lisp/gnus/nnimap.el23
-rw-r--r--lisp/gnus/shr-color.el9
-rw-r--r--lisp/gnus/shr.el22
-rw-r--r--lisp/image.el7
-rw-r--r--lisp/notifications.el7
-rw-r--r--lisp/progmodes/cc-engine.el4
-rw-r--r--lisp/progmodes/cc-mode.el3
-rw-r--r--lisp/simple.el81
-rw-r--r--lisp/url/ChangeLog16
-rw-r--r--lisp/url/url-cache.el28
-rw-r--r--lisp/url/url-queue.el45
-rw-r--r--lisp/url/url.el7
-rw-r--r--lisp/wid-edit.el11
21 files changed, 336 insertions, 89 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fdf25af86ee..0a65a759b7f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,51 @@
12012-02-07 Alan Mackenzie <acm@muc.de>
2
3 * progmodes/cc-engine.el (c-forward-objc-directive): Prevent
4 looping in "#pragma mark @implementation".
5
62012-02-07 Michael Albinus <michael.albinus@gmx.de>
7
8 * notifications.el (notifications-on-closed-signal): Make `reason'
9 optional. (Bug#10744)
10
112012-02-07 Glenn Morris <rgm@gnu.org>
12
13 * emacs-lisp/easy-mmode.el (define-minor-mode):
14 Doc fixes for the macro and the mode it defines.
15
16 * image.el (imagemagick-types-inhibit): Doc fix.
17
18 * cus-start.el (imagemagick-render-type): Add it.
19
202012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
21
22 * progmodes/cc-mode.el
23 (c-standard-font-lock-fontify-region-function): Set the default at
24 load time, too, so that `font-lock-fontify-buffer' can be called
25 without setting up the entire mode first. This fixes a bug in
26 `mm-inline-text' with C MIME parts.
27
282012-02-06 Chong Yidong <cyd@gnu.org>
29
30 * simple.el (list-processes--refresh): Delete exited processes
31 (Bug#8094).
32
33 * comint.el (comint-next-prompt): next-single-char-property-change
34 and prev-single-char-property-change never return nil (Bug#8657).
35
36 * custom.el (defcustom): Doc fix (Bug#9711).
37
382012-02-05 Chong Yidong <cyd@gnu.org>
39
40 * cus-edit.el (custom-variable-reset-backup): Quote the value
41 before storing it in the customized-value property (Bug#6712).
42 (custom-display): Add a customization type tag.
43 (custom-buffer-create-internal): Improve tooltip message.
44
45 * wid-edit.el (widget-field-value-get): New optional arg to
46 suppress trailing whitespace truncation.
47 (character): Use it (Bug#2689).
48
12012-02-05 Andreas Schwab <schwab@linux-m68k.org> 492012-02-05 Andreas Schwab <schwab@linux-m68k.org>
2 50
3 * progmodes/gud.el (gud-pv): Use pv instead of pv1. 51 * progmodes/gud.el (gud-pv): Use pv instead of pv1.
@@ -5,6 +53,9 @@
5 53
62012-02-05 Chong Yidong <cyd@gnu.org> 542012-02-05 Chong Yidong <cyd@gnu.org>
7 55
56 * cus-edit.el (custom-variable-value-create): For mismatched
57 types, show the current value (Bug#7600).
58
8 * custom.el (defcustom): Doc fix. 59 * custom.el (defcustom): Doc fix.
9 60
102012-02-05 Glenn Morris <rgm@gnu.org> 612012-02-05 Glenn Morris <rgm@gnu.org>
diff --git a/lisp/comint.el b/lisp/comint.el
index 2d0ae6920f9..975291471df 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2513,7 +2513,7 @@ text matching `comint-prompt-regexp'."
2513 (if (> n 0) 2513 (if (> n 0)
2514 (next-single-char-property-change pos 'field) 2514 (next-single-char-property-change pos 'field)
2515 (previous-single-char-property-change pos 'field))) 2515 (previous-single-char-property-change pos 'field)))
2516 (cond ((or (null pos) (= pos prev-pos)) 2516 (cond ((= pos prev-pos)
2517 ;; Ran off the end of the buffer. 2517 ;; Ran off the end of the buffer.
2518 (when (> n 0) 2518 (when (> n 0)
2519 ;; There's always an input field at the end of the 2519 ;; There's always an input field at the end of the
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 0d7b0733b64..4ed72be06fb 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1624,7 +1624,9 @@ Otherwise use brackets."
1624 ;; Insert the search field. 1624 ;; Insert the search field.
1625 (when custom-search-field 1625 (when custom-search-field
1626 (widget-insert "\n") 1626 (widget-insert "\n")
1627 (let* ((echo "Search for custom items") 1627 (let* ((echo "Search for custom items.
1628You can enter one or more words separated by spaces,
1629or a regular expression.")
1628 (search-widget 1630 (search-widget
1629 (widget-create 1631 (widget-create
1630 'editable-field 1632 'editable-field
@@ -2599,7 +2601,6 @@ try matching its doc string against `custom-guess-doc-alist'."
2599 :parent widget) 2601 :parent widget)
2600 buttons)) 2602 buttons))
2601 ((memq form '(lisp mismatch)) 2603 ((memq form '(lisp mismatch))
2602 ;; In lisp mode edit the saved value when possible.
2603 (push (widget-create-child-and-convert 2604 (push (widget-create-child-and-convert
2604 widget 'custom-visibility 2605 widget 'custom-visibility
2605 :help-echo "Hide the value of this option." 2606 :help-echo "Hide the value of this option."
@@ -2611,11 +2612,10 @@ try matching its doc string against `custom-guess-doc-alist'."
2611 t) 2612 t)
2612 buttons) 2613 buttons)
2613 (insert " ") 2614 (insert " ")
2614 (let* ((value (cond ((get symbol 'saved-value) 2615 ;; This used to try presenting the saved value or the
2615 (car (get symbol 'saved-value))) 2616 ;; standard value, but it seems more intuitive to present
2616 ((get symbol 'standard-value) 2617 ;; the current value (Bug#7600).
2617 (car (get symbol 'standard-value))) 2618 (let* ((value (cond ((default-boundp symbol)
2618 ((default-boundp symbol)
2619 (custom-quote (funcall get symbol))) 2619 (custom-quote (funcall get symbol)))
2620 (t 2620 (t
2621 (custom-quote (widget-get conv :value)))))) 2621 (custom-quote (widget-get conv :value))))))
@@ -3073,7 +3073,7 @@ to switch between two values."
3073 (funcall set symbol (car value)) 3073 (funcall set symbol (car value))
3074 (error nil))) 3074 (error nil)))
3075 (error "No backup value for %s" symbol)) 3075 (error "No backup value for %s" symbol))
3076 (put symbol 'customized-value (list (car value))) 3076 (put symbol 'customized-value (list (custom-quote (car value))))
3077 (put symbol 'variable-comment comment) 3077 (put symbol 'variable-comment comment)
3078 (put symbol 'customized-variable-comment comment) 3078 (put symbol 'customized-variable-comment comment)
3079 (custom-variable-state-set widget) 3079 (custom-variable-state-set widget)
@@ -3251,6 +3251,7 @@ Also change :reverse-video to :inverse-video."
3251 :args '((const :tag "all" t) 3251 :args '((const :tag "all" t)
3252 (const :tag "defaults" default) 3252 (const :tag "defaults" default)
3253 (checklist 3253 (checklist
3254 :tag "specific display"
3254 :offset 0 3255 :offset 0
3255 :extra-offset 9 3256 :extra-offset 9
3256 :args ((group :sibling-args (:help-echo "\ 3257 :args ((group :sibling-args (:help-echo "\
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 2cee72d717e..a5032cf99e7 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -237,6 +237,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
237 :set custom-set-minor-mode) 237 :set custom-set-minor-mode)
238 ;; fringe.c 238 ;; fringe.c
239 (overflow-newline-into-fringe fringe boolean) 239 (overflow-newline-into-fringe fringe boolean)
240 ;; image.c
241 (imagemagick-render-type image integer "24.1")
240 ;; indent.c 242 ;; indent.c
241 (indent-tabs-mode indent boolean) 243 (indent-tabs-mode indent boolean)
242 ;; keyboard.c 244 ;; keyboard.c
@@ -504,6 +506,8 @@ since it could result in memory overflow and make Emacs crash."
504 (fboundp 'x-selection-exists-p)) 506 (fboundp 'x-selection-exists-p))
505 ((string-match "fringe" (symbol-name symbol)) 507 ((string-match "fringe" (symbol-name symbol))
506 (fboundp 'define-fringe-bitmap)) 508 (fboundp 'define-fringe-bitmap))
509 ((string-match "\\`imagemagick" (symbol-name symbol))
510 (fboundp 'imagemagick-types))
507 ((equal "font-use-system-font" (symbol-name symbol)) 511 ((equal "font-use-system-font" (symbol-name symbol))
508 (featurep 'system-font-setting)) 512 (featurep 'system-font-setting))
509 ;; Conditioned on x-create-frame, because that's 513 ;; Conditioned on x-create-frame, because that's
diff --git a/lisp/custom.el b/lisp/custom.el
index 962336978b1..2d880d23955 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -198,12 +198,16 @@ set to nil, as the value is no longer rogue."
198 (run-hooks 'custom-define-hook) 198 (run-hooks 'custom-define-hook)
199 symbol) 199 symbol)
200 200
201(defmacro defcustom (symbol value doc &rest args) 201(defmacro defcustom (symbol standard doc &rest args)
202 "Declare SYMBOL as a customizable variable that defaults to VALUE. 202 "Declare SYMBOL as a customizable variable.
203SYMBOL is the variable name; it should not be quoted.
204STANDARD is an expression specifying the variable's standard
205value. It should not be quoted. It is evaluated once by
206`defcustom', and the value is assigned to SYMBOL if the variable
207is unbound. The expression itself is also stored, so that
208Customize can re-evaluate it later to get the standard value.
203DOC is the variable documentation. 209DOC is the variable documentation.
204 210
205Neither SYMBOL nor VALUE need to be quoted.
206If SYMBOL is not already bound, initialize it to VALUE.
207The remaining arguments should have the form 211The remaining arguments should have the form
208 212
209 [KEYWORD VALUE]... 213 [KEYWORD VALUE]...
@@ -320,14 +324,15 @@ for more information."
320 `(custom-declare-variable 324 `(custom-declare-variable
321 ',symbol 325 ',symbol
322 ,(if lexical-binding ;FIXME: This is not reliable, but is all we have. 326 ,(if lexical-binding ;FIXME: This is not reliable, but is all we have.
323 ;; The `default' arg should be an expression that evaluates to 327 ;; The STANDARD arg should be an expression that evaluates to
324 ;; the value to use. The use of `eval' for it is spread over 328 ;; the standard value. The use of `eval' for it is spread
325 ;; many different places and hence difficult to eliminate, yet 329 ;; over many different places and hence difficult to
326 ;; we want to make sure that the `value' expression is checked by the 330 ;; eliminate, yet we want to make sure that the `standard'
327 ;; byte-compiler, and that lexical-binding is obeyed, so quote the 331 ;; expression is checked by the byte-compiler, and that
328 ;; expression with `lambda' rather than with `quote'. 332 ;; lexical-binding is obeyed, so quote the expression with
329 `(list (lambda () ,value)) 333 ;; `lambda' rather than with `quote'.
330 `',value) 334 `(list (lambda () ,standard))
335 `',standard)
331 ,doc 336 ,doc
332 ,@args)) 337 ,@args))
333 338
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index d871f6f1212..dbacba6cd29 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -90,6 +90,14 @@ This defines the toggle command MODE and (by default) a control variable
90MODE (you can override this with the :variable keyword, see below). 90MODE (you can override this with the :variable keyword, see below).
91DOC is the documentation for the mode toggle command. 91DOC is the documentation for the mode toggle command.
92 92
93The defined mode command takes one optional (prefix) argument.
94Interactively with no prefix argument it toggles the mode.
95With a prefix argument, it enables the mode if the argument is
96positive and otherwise disables it. When called from Lisp, it
97enables the mode if the argument is omitted or nil, and toggles
98the mode if the argument is `toggle'. If DOC is nil this
99function adds a basic doc-string stating these facts.
100
93Optional INIT-VALUE is the initial value of the mode's variable. 101Optional INIT-VALUE is the initial value of the mode's variable.
94Optional LIGHTER is displayed in the modeline when the mode is on. 102Optional LIGHTER is displayed in the modeline when the mode is on.
95Optional KEYMAP is the default keymap bound to the mode keymap. 103Optional KEYMAP is the default keymap bound to the mode keymap.
@@ -242,7 +250,7 @@ or call the function `%s'."))))
242 (format (concat "Toggle %s on or off. 250 (format (concat "Toggle %s on or off.
243With a prefix argument ARG, enable %s if ARG is 251With a prefix argument ARG, enable %s if ARG is
244positive, and disable it otherwise. If called from Lisp, enable 252positive, and disable it otherwise. If called from Lisp, enable
245the mode if ARG is omitted or nil. 253the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
246\\{%s}") pretty-name pretty-name keymap-sym)) 254\\{%s}") pretty-name pretty-name keymap-sym))
247 ;; Use `toggle' rather than (if ,mode 0 1) so that using 255 ;; Use `toggle' rather than (if ,mode 0 1) so that using
248 ;; repeat-command still does the toggling correctly. 256 ;; repeat-command still does the toggling correctly.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 740a2340243..7c83b9d99de 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,43 @@
12012-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-sum.el (gnus-summary-show-thread): Revert last two changes.
4
52012-02-07 Lars Ingebrigtsen <larsi@gnus.org>
6
7 * nnimap.el (nnimap-transform-headers): Remove unused variable.
8 (nnimap-transform-headers): Fix parsing BODYSTRUCTURE elements that
9 have newlines within the strings, and where the UID comes after the
10 BODYSTRUCTURE element (bug#10537).
11
12 * shr-color.el (shr-color-set-minimum-interval): Renamed to add prefix
13 (bug#10732).
14
15 * shr.el (shr-insert-document): Add doc string.
16 (shr-visit-file): Ditto.
17 (shr-remove-trailing-whitespace): New function.
18 (shr-insert-document): Use it to clean up trailing whitespace as the
19 final step (bug#10714).
20
212012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
22
23 * gnus-sum.el (gnus-summary-exit-no-update): Really deaden the summary
24 buffer if `gnus-kill-summary-on-exit' is nil.
25
262012-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
27
28 * gnus-sum.el (gnus-summary-show-thread):
29 next-single-char-property-change may return nil in XEmacs.
30
312012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
32
33 * gnus-sum.el (gnus-handle-ephemeral-exit): Allow exiting from Gnus
34 when just reading a single group from "without" Gnus.
35
362012-02-06 Chong Yidong <cyd@gnu.org>
37
38 * gnus-sum.el (gnus-summary-show-thread):
39 next-single-char-property-change never returns nil (Bug#8657).
40
12012-02-05 Lars Ingebrigtsen <larsi@gnus.org> 412012-02-05 Lars Ingebrigtsen <larsi@gnus.org>
2 42
3 * nnimap.el (nnimap-open-server): Allow switching the nnoo server 43 * nnimap.el (nnimap-open-server): Allow switching the nnoo server
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index d0a582e2712..296f25a09f9 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7328,9 +7328,11 @@ If FORCE (the prefix), also save the .newsrc file(s)."
7328 (gnus-kill-buffer gnus-original-article-buffer) 7328 (gnus-kill-buffer gnus-original-article-buffer)
7329 (setq gnus-article-current nil)) 7329 (setq gnus-article-current nil))
7330 ;; Return to the group buffer. 7330 ;; Return to the group buffer.
7331 (gnus-configure-windows 'group 'force)
7332 (if (not gnus-kill-summary-on-exit) 7331 (if (not gnus-kill-summary-on-exit)
7333 (gnus-deaden-summary) 7332 (progn
7333 (gnus-deaden-summary)
7334 (gnus-configure-windows 'group 'force))
7335 (gnus-configure-windows 'group 'force)
7334 (gnus-close-group group) 7336 (gnus-close-group group)
7335 (gnus-kill-buffer gnus-summary-buffer)) 7337 (gnus-kill-buffer gnus-summary-buffer))
7336 (unless gnus-single-article-buffer 7338 (unless gnus-single-article-buffer
@@ -7352,7 +7354,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
7352(defun gnus-handle-ephemeral-exit (quit-config) 7354(defun gnus-handle-ephemeral-exit (quit-config)
7353 "Handle movement when leaving an ephemeral group. 7355 "Handle movement when leaving an ephemeral group.
7354The state which existed when entering the ephemeral is reset." 7356The state which existed when entering the ephemeral is reset."
7355 (if (not (buffer-name (car quit-config))) 7357 (if (not (buffer-live-p (car quit-config)))
7356 (gnus-configure-windows 'group 'force) 7358 (gnus-configure-windows 'group 'force)
7357 (set-buffer (car quit-config)) 7359 (set-buffer (car quit-config))
7358 (unless (eq (cdr quit-config) 'group) 7360 (unless (eq (cdr quit-config) 'group)
@@ -11579,6 +11581,7 @@ Returns nil if no thread was there to be shown."
11579 (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point))))) 11581 (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
11580 (eoi (when end 11582 (eoi (when end
11581 (if (fboundp 'next-single-char-property-change) 11583 (if (fboundp 'next-single-char-property-change)
11584 ;; Note: XEmacs version of n-s-c-p-c may return nil
11582 (or (next-single-char-property-change end 'invisible) 11585 (or (next-single-char-property-change end 'invisible)
11583 (point-max)) 11586 (point-max))
11584 (while (progn 11587 (while (progn
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 09cf554312b..4c75f721ff6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -189,25 +189,32 @@ textual parts.")
189 189
190(defun nnimap-transform-headers () 190(defun nnimap-transform-headers ()
191 (goto-char (point-min)) 191 (goto-char (point-min))
192 (let (article bytes lines size string) 192 (let (article lines size string)
193 (block nil 193 (block nil
194 (while (not (eobp)) 194 (while (not (eobp))
195 (while (not (looking-at "\\* [0-9]+ FETCH.+?UID \\([0-9]+\\)")) 195 (while (not (looking-at "\\* [0-9]+ FETCH"))
196 (delete-region (point) (progn (forward-line 1) (point))) 196 (delete-region (point) (progn (forward-line 1) (point)))
197 (when (eobp) 197 (when (eobp)
198 (return))) 198 (return)))
199 (setq article (match-string 1)) 199 (goto-char (match-end 0))
200 ;; Unfold quoted {number} strings. 200 ;; Unfold quoted {number} strings.
201 (while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r?\n" 201 (while (re-search-forward
202 (1+ (line-end-position)) t) 202 "[^]][ (]{\\([0-9]+\\)}\r?\n"
203 (save-excursion
204 (or (re-search-forward "\\* [0-9]+ FETCH" nil t)
205 (point-max)))
206 t)
203 (setq size (string-to-number (match-string 1))) 207 (setq size (string-to-number (match-string 1)))
204 (delete-region (+ (match-beginning 0) 2) (point)) 208 (delete-region (+ (match-beginning 0) 2) (point))
205 (setq string (buffer-substring (point) (+ (point) size))) 209 (setq string (buffer-substring (point) (+ (point) size)))
206 (delete-region (point) (+ (point) size)) 210 (delete-region (point) (+ (point) size))
207 (insert (format "%S" string))) 211 (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string))))
208 (setq bytes (nnimap-get-length)
209 lines nil)
210 (beginning-of-line) 212 (beginning-of-line)
213 (setq article
214 (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
215 t)
216 (match-string 1)))
217 (setq lines nil)
211 (setq size 218 (setq size
212 (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)" 219 (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
213 (line-end-position) 220 (line-end-position)
diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el
index e23ab57965e..7011034d242 100644
--- a/lisp/gnus/shr-color.el
+++ b/lisp/gnus/shr-color.el
@@ -267,7 +267,8 @@ Like rgb() or hsl()."
267 (t 267 (t
268 nil)))) 268 nil))))
269 269
270(defun set-minimum-interval (val1 val2 min max interval &optional fixed) 270(defun shr-color-set-minimum-interval (val1 val2 min max interval
271 &optional fixed)
271 "Set minimum interval between VAL1 and VAL2 to INTERVAL. 272 "Set minimum interval between VAL1 and VAL2 to INTERVAL.
272The values are bound by MIN and MAX. 273The values are bound by MIN and MAX.
273If FIXED is t, then VAL1 will not be touched." 274If FIXED is t, then VAL1 will not be touched."
@@ -341,9 +342,9 @@ color will be adapted to be visible on BG."
341 (>= luminance-distance shr-color-visible-luminance-min)) 342 (>= luminance-distance shr-color-visible-luminance-min))
342 (list bg fg) 343 (list bg fg)
343 ;; Not visible, try to change luminance to make them visible 344 ;; Not visible, try to change luminance to make them visible
344 (let ((Ls (set-minimum-interval (car bg-lab) (car fg-lab) 0 100 345 (let ((Ls (shr-color-set-minimum-interval
345 shr-color-visible-luminance-min 346 (car bg-lab) (car fg-lab) 0 100
346 fixed-background))) 347 shr-color-visible-luminance-min fixed-background)))
347 (unless fixed-background 348 (unless fixed-background
348 (setcar bg-lab (car Ls))) 349 (setcar bg-lab (car Ls)))
349 (setcar fg-lab (cadr Ls)) 350 (setcar fg-lab (cadr Ls))
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index acce7660263..deaef1d3f25 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -128,6 +128,7 @@ cid: URL as the argument.")
128;; Public functions and commands. 128;; Public functions and commands.
129 129
130(defun shr-visit-file (file) 130(defun shr-visit-file (file)
131 "Parse FILE as an HTML document, and render it in a new buffer."
131 (interactive "fHTML file name: ") 132 (interactive "fHTML file name: ")
132 (pop-to-buffer "*html*") 133 (pop-to-buffer "*html*")
133 (erase-buffer) 134 (erase-buffer)
@@ -139,12 +140,29 @@ cid: URL as the argument.")
139 140
140;;;###autoload 141;;;###autoload
141(defun shr-insert-document (dom) 142(defun shr-insert-document (dom)
143 "Render the parsed document DOM into the current buffer.
144DOM should be a parse tree as generated by
145`libxml-parse-html-region' or similar."
142 (setq shr-content-cache nil) 146 (setq shr-content-cache nil)
143 (let ((shr-state nil) 147 (let ((start (point))
148 (shr-state nil)
144 (shr-start nil) 149 (shr-start nil)
145 (shr-base nil) 150 (shr-base nil)
146 (shr-width (or shr-width (window-width)))) 151 (shr-width (or shr-width (window-width))))
147 (shr-descend (shr-transform-dom dom)))) 152 (shr-descend (shr-transform-dom dom))
153 (shr-remove-trailing-whitespace start (point))))
154
155(defun shr-remove-trailing-whitespace (start end)
156 (save-restriction
157 (narrow-to-region start end)
158 (delete-trailing-whitespace)
159 (goto-char start)
160 (while (not (eobp))
161 (end-of-line)
162 (dolist (overlay (overlays-at (point)))
163 (when (overlay-get overlay 'before-string)
164 (overlay-put overlay 'before-string nil)))
165 (forward-line 1))))
148 166
149(defun shr-copy-url () 167(defun shr-copy-url ()
150 "Copy the URL under point to the kill ring. 168 "Copy the URL under point to the kill ring.
diff --git a/lisp/image.el b/lisp/image.el
index c4b51716dad..8c52db149a0 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -686,13 +686,16 @@ The minimum delay between successive frames is 0.01s."
686 '(C HTML HTM TXT PDF) 686 '(C HTML HTM TXT PDF)
687 "ImageMagick types that Emacs should not use ImageMagick to handle. 687 "ImageMagick types that Emacs should not use ImageMagick to handle.
688This should be a list of symbols, each of which has the same 688This should be a list of symbols, each of which has the same
689names as one of the format tags used internally by ImageMagick; 689name as one of the format tags used internally by ImageMagick;
690see `imagemagick-types'. Entries in this list are excluded from 690see `imagemagick-types'. Entries in this list are excluded from
691being registered by `imagemagick-register-types'. 691being registered by `imagemagick-register-types', so if you change
692this variable you must do so before you call that function.
692 693
693If Emacs is compiled without ImageMagick, this variable has no effect." 694If Emacs is compiled without ImageMagick, this variable has no effect."
694 :type '(choice (const :tag "Let ImageMagick handle all types it can" nil) 695 :type '(choice (const :tag "Let ImageMagick handle all types it can" nil)
695 (repeat symbol)) 696 (repeat symbol))
697 ;; Ideally, would have a :set function that checks if we already did
698 ;; imagemagick-register-types, and if so undoes it, then redoes it.
696 :version "24.1" 699 :version "24.1"
697 :group 'image) 700 :group 'image)
698 701
diff --git a/lisp/notifications.el b/lisp/notifications.el
index c3b6c759506..9f7576b3f5d 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -107,9 +107,12 @@
107 notifications-action-signal 107 notifications-action-signal
108 'notifications-on-action-signal)) 108 'notifications-on-action-signal))
109 109
110(defun notifications-on-closed-signal (id reason) 110(defun notifications-on-closed-signal (id &optional reason)
111 "Dispatch signals to callback functions from `notifications-on-closed-map'." 111 "Dispatch signals to callback functions from `notifications-on-closed-map'."
112 (let ((entry (assoc id notifications-on-close-map))) 112 ;; notification-daemon prior 0.4.0 does not send a reason. So we
113 ;; make it optional, and assume `undefined' as default.
114 (let ((entry (assoc id notifications-on-close-map))
115 (reason (or reason 4)))
113 (when entry 116 (when entry
114 (funcall (cadr entry) 117 (funcall (cadr entry)
115 id (cadr (assoc reason notifications-closed-reason))) 118 id (cadr (assoc reason notifications-closed-reason)))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 52f18a89849..47ceec309f4 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -7396,6 +7396,7 @@ comment at the start of cc-engine.el for more info."
7396 (let ((start (point)) 7396 (let ((start (point))
7397 start-char 7397 start-char
7398 (c-promote-possible-types t) 7398 (c-promote-possible-types t)
7399 lim
7399 ;; Turn off recognition of angle bracket arglists while parsing 7400 ;; Turn off recognition of angle bracket arglists while parsing
7400 ;; types here since the protocol reference list might then be 7401 ;; types here since the protocol reference list might then be
7401 ;; considered part of the preceding name or superclass-name. 7402 ;; considered part of the preceding name or superclass-name.
@@ -7423,6 +7424,7 @@ comment at the start of cc-engine.el for more info."
7423; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's 7424; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's
7424; at EOB. 7425; at EOB.
7425 (goto-char (match-end 0)) 7426 (goto-char (match-end 0))
7427 (setq lim (point))
7426 (c-skip-ws-forward) 7428 (c-skip-ws-forward)
7427 (c-forward-type)) 7429 (c-forward-type))
7428 7430
@@ -7447,7 +7449,7 @@ comment at the start of cc-engine.el for more info."
7447 t)))) 7449 t))))
7448 7450
7449 (progn 7451 (progn
7450 (c-backward-syntactic-ws) 7452 (c-backward-syntactic-ws lim)
7451 (c-clear-c-type-property start (1- (point)) 'c-decl-end) 7453 (c-clear-c-type-property start (1- (point)) 'c-decl-end)
7452 (c-put-c-type-property (1- (point)) 'c-decl-end) 7454 (c-put-c-type-property (1- (point)) 'c-decl-end)
7453 t) 7455 t)
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 0c86b68f1d9..374c9b434d1 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1155,7 +1155,8 @@ Note that the style variables are always made local to the buffer."
1155 ;; `c-set-fl-decl-start' for the detailed functionality. 1155 ;; `c-set-fl-decl-start' for the detailed functionality.
1156 (cons (c-set-fl-decl-start beg) end)) 1156 (cons (c-set-fl-decl-start beg) end))
1157 1157
1158(defvar c-standard-font-lock-fontify-region-function nil 1158(defvar c-standard-font-lock-fontify-region-function
1159 (default-value 'font-lock-fontify-region-function)
1159 "Standard value of `font-lock-fontify-region-function'") 1160 "Standard value of `font-lock-fontify-region-function'")
1160 1161
1161(defun c-font-lock-fontify-region (beg end &optional verbose) 1162(defun c-font-lock-fontify-region (beg end &optional verbose)
diff --git a/lisp/simple.el b/lisp/simple.el
index 8bd32a8db8d..610d4a3be42 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2713,47 +2713,50 @@ support pty association, if PROGRAM is nil."
2713 (tabulated-list-init-header)) 2713 (tabulated-list-init-header))
2714 2714
2715(defun list-processes--refresh () 2715(defun list-processes--refresh ()
2716 "Recompute the list of processes for the Process List buffer." 2716 "Recompute the list of processes for the Process List buffer.
2717Also, delete any process that is exited or signaled."
2717 (setq tabulated-list-entries nil) 2718 (setq tabulated-list-entries nil)
2718 (dolist (p (process-list)) 2719 (dolist (p (process-list))
2719 (when (or (not process-menu-query-only) 2720 (cond ((memq (process-status p) '(exit signal closed))
2720 (process-query-on-exit-flag p)) 2721 (delete-process p))
2721 (let* ((buf (process-buffer p)) 2722 ((or (not process-menu-query-only)
2722 (type (process-type p)) 2723 (process-query-on-exit-flag p))
2723 (name (process-name p)) 2724 (let* ((buf (process-buffer p))
2724 (status (symbol-name (process-status p))) 2725 (type (process-type p))
2725 (buf-label (if (buffer-live-p buf) 2726 (name (process-name p))
2726 `(,(buffer-name buf) 2727 (status (symbol-name (process-status p)))
2727 face link 2728 (buf-label (if (buffer-live-p buf)
2728 help-echo ,(concat "Visit buffer `" 2729 `(,(buffer-name buf)
2729 (buffer-name buf) "'") 2730 face link
2730 follow-link t 2731 help-echo ,(concat "Visit buffer `"
2731 process-buffer ,buf 2732 (buffer-name buf) "'")
2732 action process-menu-visit-buffer) 2733 follow-link t
2733 "--")) 2734 process-buffer ,buf
2734 (tty (or (process-tty-name p) "--")) 2735 action process-menu-visit-buffer)
2735 (cmd 2736 "--"))
2736 (if (memq type '(network serial)) 2737 (tty (or (process-tty-name p) "--"))
2737 (let ((contact (process-contact p t))) 2738 (cmd
2738 (if (eq type 'network) 2739 (if (memq type '(network serial))
2739 (format "(%s %s)" 2740 (let ((contact (process-contact p t)))
2740 (if (plist-get contact :type) 2741 (if (eq type 'network)
2741 "datagram" 2742 (format "(%s %s)"
2742 "network") 2743 (if (plist-get contact :type)
2743 (if (plist-get contact :server) 2744 "datagram"
2744 (format "server on %s" 2745 "network")
2745 (plist-get contact :server)) 2746 (if (plist-get contact :server)
2746 (format "connection to %s" 2747 (format "server on %s"
2747 (plist-get contact :host)))) 2748 (plist-get contact :server))
2748 (format "(serial port %s%s)" 2749 (format "connection to %s"
2749 (or (plist-get contact :port) "?") 2750 (plist-get contact :host))))
2750 (let ((speed (plist-get contact :speed))) 2751 (format "(serial port %s%s)"
2751 (if speed 2752 (or (plist-get contact :port) "?")
2752 (format " at %s b/s" speed) 2753 (let ((speed (plist-get contact :speed)))
2753 ""))))) 2754 (if speed
2754 (mapconcat 'identity (process-command p) " ")))) 2755 (format " at %s b/s" speed)
2755 (push (list p (vector name status buf-label tty cmd)) 2756 "")))))
2756 tabulated-list-entries))))) 2757 (mapconcat 'identity (process-command p) " "))))
2758 (push (list p (vector name status buf-label tty cmd))
2759 tabulated-list-entries))))))
2757 2760
2758(defun process-menu-visit-buffer (button) 2761(defun process-menu-visit-buffer (button)
2759 (display-buffer (button-get button 'process-buffer))) 2762 (display-buffer (button-get button 'process-buffer)))
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 7c92fc33490..f4cca618b49 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,19 @@
12012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
2
3 * url-cache.el (url-cache-prune-cache): New function.
4 (url-cache-prune-cache): Check that the directory exists before
5 trying to delete it.
6
7 * url.el (url-retrieve-number-of-calls): New variable.
8 (url-retrieve-internal): Use it to expire the cache once in a
9 while.
10
11 * url-queue.el (url-queue-setup-runners): New function that uses
12 `run-with-idle-timer' for extra asynchronicity.
13 (url-queue-remove-jobs-from-host): New function.
14 (url-queue-callback-function): Remove jobs from the same host if
15 connection failed.
16
12012-01-12 Glenn Morris <rgm@gnu.org> 172012-01-12 Glenn Morris <rgm@gnu.org>
2 18
3 * url-auth.el (url-basic-auth, url-digest-auth): 19 * url-auth.el (url-basic-auth, url-digest-auth):
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 20602a2f8ef..6559de4deb7 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -209,6 +209,34 @@ If `url-standalone-mode' is non-nil, cached items never expire."
209 (seconds-to-time (or expire-time url-cache-expire-time))) 209 (seconds-to-time (or expire-time url-cache-expire-time)))
210 (current-time)))))) 210 (current-time))))))
211 211
212(defun url-cache-prune-cache (&optional directory)
213 "Remove all expired files from the cache.
214`url-cache-expire-time' says how old a file has to be to be
215considered \"expired\"."
216 (let ((current-time (current-time))
217 (total-files 0)
218 (deleted-files 0))
219 (setq directory (or directory url-cache-directory))
220 (when (file-exists-p directory)
221 (dolist (file (directory-files directory t))
222 (unless (member (file-name-nondirectory file) '("." ".."))
223 (setq total-files (1+ total-files))
224 (cond
225 ((file-directory-p file)
226 (when (url-cache-prune-cache file)
227 (setq deleted-files (1+ deleted-files))))
228 ((time-less-p
229 (time-add
230 (nth 5 (file-attributes file))
231 (seconds-to-time url-cache-expire-time))
232 current-time)
233 (delete-file file)
234 (setq deleted-files (1+ deleted-files))))))
235 (if (< deleted-files total-files)
236 nil
237 (delete-directory directory)
238 t))))
239
212(provide 'url-cache) 240(provide 'url-cache)
213 241
214;;; url-cache.el ends here 242;;; url-cache.el ends here
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 534c94b4d52..976a26635cd 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -30,6 +30,7 @@
30 30
31(eval-when-compile (require 'cl)) 31(eval-when-compile (require 'cl))
32(require 'browse-url) 32(require 'browse-url)
33(require 'url-parse)
33 34
34(defcustom url-queue-parallel-processes 6 35(defcustom url-queue-parallel-processes 6
35 "The number of concurrent processes." 36 "The number of concurrent processes."
@@ -49,7 +50,7 @@
49 50
50(defstruct url-queue 51(defstruct url-queue
51 url callback cbargs silentp 52 url callback cbargs silentp
52 buffer start-time) 53 buffer start-time pre-triggered)
53 54
54;;;###autoload 55;;;###autoload
55(defun url-queue-retrieve (url callback &optional cbargs silent) 56(defun url-queue-retrieve (url callback &optional cbargs silent)
@@ -63,7 +64,30 @@ controls the level of parallelism via the
63 :callback callback 64 :callback callback
64 :cbargs cbargs 65 :cbargs cbargs
65 :silentp silent)))) 66 :silentp silent))))
66 (url-queue-run-queue)) 67 (url-queue-setup-runners))
68
69;; To ensure asynch behaviour, we start the required number of queue
70;; runners from `run-with-idle-timer'. So we're basically going
71;; through the queue in two ways: 1) synchronously when a program
72;; calls `url-queue-retrieve' (which will then start the required
73;; number of queue runners), and 2) at the exit of each job, which
74;; will then not start any further threads, but just reuse the
75;; previous "slot".
76
77(defun url-queue-setup-runners ()
78 (let ((running 0)
79 waiting)
80 (dolist (entry url-queue)
81 (cond
82 ((or (url-queue-start-time entry)
83 (url-queue-pre-triggered entry))
84 (incf running))
85 ((not waiting)
86 (setq waiting entry))))
87 (when (and waiting
88 (< running url-queue-parallel-processes))
89 (setf (url-queue-pre-triggered waiting) t)
90 (run-with-idle-timer 0.01 nil 'url-queue-run-queue))))
67 91
68(defun url-queue-run-queue () 92(defun url-queue-run-queue ()
69 (url-queue-prune-old-entries) 93 (url-queue-prune-old-entries)
@@ -81,10 +105,27 @@ controls the level of parallelism via the
81 (url-queue-start-retrieve waiting)))) 105 (url-queue-start-retrieve waiting))))
82 106
83(defun url-queue-callback-function (status job) 107(defun url-queue-callback-function (status job)
108 (when (and (eq (car status) :error)
109 (eq (cadr (cadr status)) 'connection-failed))
110 ;; If we get a connection error, then flush all other jobs from
111 ;; the host from the queue. This particularly makes sense if the
112 ;; error really is a DNS resolver issue, which happens
113 ;; synchronously and totally halts Emacs.
114 (url-queue-remove-jobs-from-host
115 (plist-get (nthcdr 3 (cadr status)) :host)))
84 (setq url-queue (delq job url-queue)) 116 (setq url-queue (delq job url-queue))
85 (url-queue-run-queue) 117 (url-queue-run-queue)
86 (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) 118 (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
87 119
120(defun url-queue-remove-jobs-from-host (host)
121 (let ((jobs nil))
122 (dolist (job url-queue)
123 (when (equal (url-host (url-generic-parse-url (url-queue-url job)))
124 host)
125 (push job jobs)))
126 (dolist (job jobs)
127 (setq url-queue (delq job url-queue)))))
128
88(defun url-queue-start-retrieve (job) 129(defun url-queue-start-retrieve (job)
89 (setf (url-queue-buffer job) 130 (setf (url-queue-buffer job)
90 (ignore-errors 131 (ignore-errors
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 883e1a0c765..03b66b15232 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -119,6 +119,9 @@ Sometimes while retrieving a URL, the URL library needs to use another buffer
119than the one returned initially by `url-retrieve'. In this case, it sets this 119than the one returned initially by `url-retrieve'. In this case, it sets this
120variable in the original buffer as a forwarding pointer.") 120variable in the original buffer as a forwarding pointer.")
121 121
122(defvar url-retrieve-number-of-calls 0)
123(autoload 'url-cache-prune-cache "url-cache")
124
122;;;###autoload 125;;;###autoload
123(defun url-retrieve (url callback &optional cbargs silent) 126(defun url-retrieve (url callback &optional cbargs silent)
124 "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. 127 "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
@@ -174,6 +177,10 @@ If SILENT, don't message progress reports and the like."
174 (unless (url-type url) 177 (unless (url-type url)
175 (error "Bad url: %s" (url-recreate-url url))) 178 (error "Bad url: %s" (url-recreate-url url)))
176 (setf (url-silent url) silent) 179 (setf (url-silent url) silent)
180 ;; Once in a while, remove old entries from the URL cache.
181 (when (zerop (% url-retrieve-number-of-calls 1000))
182 (url-cache-prune-cache))
183 (setq url-retrieve-number-of-calls (1+ url-retrieve-number-of-calls))
177 (let ((loader (url-scheme-get-property (url-type url) 'loader)) 184 (let ((loader (url-scheme-get-property (url-type url) 'loader))
178 (url-using-proxy (if (url-host url) 185 (url-using-proxy (if (url-host url)
179 (url-find-proxy-for-url url (url-host url)))) 186 (url-find-proxy-for-url url (url-host url))))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 27922327f44..61bb4db558c 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1987,10 +1987,14 @@ the earlier input."
1987 (when (overlayp overlay) 1987 (when (overlayp overlay)
1988 (delete-overlay overlay)))) 1988 (delete-overlay overlay))))
1989 1989
1990(defun widget-field-value-get (widget) 1990(defun widget-field-value-get (widget &optional no-truncate)
1991 "Return current text in editing field." 1991 "Return current text in editing field.
1992Normally, trailing spaces within the editing field are truncated.
1993But if NO-TRUNCATE is non-nil, include them."
1992 (let ((from (widget-field-start widget)) 1994 (let ((from (widget-field-start widget))
1993 (to (widget-field-text-end widget)) 1995 (to (if no-truncate
1996 (widget-field-end widget)
1997 (widget-field-text-end widget)))
1994 (buffer (widget-field-buffer widget)) 1998 (buffer (widget-field-buffer widget))
1995 (secret (widget-get widget :secret)) 1999 (secret (widget-get widget :secret))
1996 (old (current-buffer))) 2000 (old (current-buffer)))
@@ -3407,6 +3411,7 @@ To use this type, you must define :match or :match-alternatives."
3407 :format "%{%t%}: %v\n" 3411 :format "%{%t%}: %v\n"
3408 :valid-regexp "\\`.\\'" 3412 :valid-regexp "\\`.\\'"
3409 :error "This field should contain a single character" 3413 :error "This field should contain a single character"
3414 :value-get (lambda (w) (widget-field-value-get w t))
3410 :value-to-internal (lambda (_widget value) 3415 :value-to-internal (lambda (_widget value)
3411 (if (stringp value) 3416 (if (stringp value)
3412 value 3417 value