Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102590. ------------------------------------------------------------ revno: 102590 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Mon 2010-12-06 03:59:56 +0000 message: nnir.el (nnir-request-move-article): Remove obsolete code. shr.el (shr-find-fill-point): Don't regard apostrophe as kinsoku-bol. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-05 23:29:50 +0000 +++ lisp/gnus/ChangeLog 2010-12-06 03:59:56 +0000 @@ -1,3 +1,11 @@ +2010-12-06 Katsumi Yamaoka + + * shr.el (shr-find-fill-point): Don't regard apostrophe as kinsoku-bol. + +2010-12-06 Andrew Cohen + + * nnir.el (nnir-request-move-article): Remove obsolete code. + 2010-12-05 Katsumi Yamaoka * gnus-util.el (gnus-macroexpand-all): Use eval-and-compile. === modified file 'lisp/gnus/nnir.el' --- lisp/gnus/nnir.el 2010-12-05 22:17:34 +0000 +++ lisp/gnus/nnir.el 2010-12-06 03:59:56 +0000 @@ -676,10 +676,7 @@ (to-newsgroup (nth 1 accept-form)) (to-method (gnus-find-method-for-group to-newsgroup)) (from-method (gnus-find-method-for-group artfullgroup)) - (move-is-internal (gnus-server-equal from-method to-method)) - (artsubject (mail-header-subject - (gnus-data-header - (assoc article (gnus-data-list nil)))))) + (move-is-internal (gnus-server-equal from-method to-method))) (unless (gnus-check-backend-function 'request-move-article artfullgroup) (error "The group %s does not support article moving" artfullgroup)) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-12-05 22:17:34 +0000 +++ lisp/gnus/shr.el 2010-12-06 03:59:56 +0000 @@ -301,12 +301,12 @@ (eq (following-char) ? ) (shr-char-breakable-p (preceding-char)) (shr-char-breakable-p (following-char)) - (and (eq (preceding-char) ?') - (not (memq (char-after (- (point) 2)) - (list nil ?\n ? )))) - ;; There're some kinsoku CJK chars that aren't breakable. - (and (shr-char-kinsoku-bol-p (preceding-char)) - (not (shr-char-kinsoku-bol-p (following-char)))) + (if (eq (preceding-char) ?') + (not (memq (char-after (- (point) 2)) + (list nil ?\n ? ))) + ;; There're some kinsoku CJK chars that aren't breakable. + (and (shr-char-kinsoku-bol-p (preceding-char)) + (not (shr-char-kinsoku-bol-p (following-char))))) (shr-char-kinsoku-eol-p (following-char)))) (backward-char 1)) (if (and (not (or failed (eolp))) ------------------------------------------------------------ revno: 102589 committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-12-05 23:29:50 +0000 message: gnus-util.el (gnus-macroexpand-all): Use eval-and-compile. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-05 22:17:34 +0000 +++ lisp/gnus/ChangeLog 2010-12-05 23:29:50 +0000 @@ -1,3 +1,7 @@ +2010-12-05 Katsumi Yamaoka + + * gnus-util.el (gnus-macroexpand-all): Use eval-and-compile. + 2010-12-05 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-respool-article): The completion function === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2010-12-05 22:17:34 +0000 +++ lisp/gnus/gnus-util.el 2010-12-05 23:29:50 +0000 @@ -2037,25 +2037,26 @@ (save-match-data (string-match regexp string start)))) -(if (fboundp 'macroexpand-all) - (defalias 'gnus-macroexpand-all 'macroexpand-all) - (defun gnus-macroexpand-all (form &optional environment) - "Return result of expanding macros at all levels in FORM. +(eval-and-compile + (if (fboundp 'macroexpand-all) + (defalias 'gnus-macroexpand-all 'macroexpand-all) + (defun gnus-macroexpand-all (form &optional environment) + "Return result of expanding macros at all levels in FORM. If no macros are expanded, FORM is returned unchanged. The second optional arg ENVIRONMENT specifies an environment of macro definitions to shadow the loaded ones for use in file byte-compilation." - (if (consp form) - (let ((idx 1) - (len (length (setq form (copy-sequence form)))) - expanded) - (while (< idx len) - (setcar (nthcdr idx form) (gnus-macroexpand-all (nth idx form) - environment)) - (setq idx (1+ idx))) - (if (eq (setq expanded (macroexpand form environment)) form) - form - (gnus-macroexpand-all expanded environment))) - form))) + (if (consp form) + (let ((idx 1) + (len (length (setq form (copy-sequence form)))) + expanded) + (while (< idx len) + (setcar (nthcdr idx form) (gnus-macroexpand-all (nth idx form) + environment)) + (setq idx (1+ idx))) + (if (eq (setq expanded (macroexpand form environment)) form) + form + (gnus-macroexpand-all expanded environment))) + form)))) (provide 'gnus-util) ------------------------------------------------------------ revno: 102588 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Sun 2010-12-05 22:17:34 +0000 message: Merge changes made in Gnus trunk. nnir.el (nnir-categorize): Replace mapcar with mapc. shr.el (shr-urlify): Display the title in tags. shr.el (shr-urlify): Show the URL before the title to avoid misleading URLs. gnus-sum.el (gnus-summary-show-article): Reverse the meanings of `C-u C-u g' and `C-u g' so that `C-u g' does what it traditionally did. gnus.texi (Paging the Article): Note the reverse meanings of `C-u C-u g'. gnus-html.el (gnus-html-put-image): Use widget instead of local maps so that TAB works. nnir.el (nnir-run-gmane): Use more careful test for gmane nntp server. nnimap.el (nnimap-process-expiry-targets): Avoid downloading articles unless necessary. gnus-util.el (gnus-output-to-mail): Require nnmail before using nnmail variables. shr.el (shr-stylesheet): New dynamic variable for cascading the styles. (shr-colorize-region): New function. (shr-insert-background-overlay): Remove. (shr-render-td): Background setting should be taken care of on a higher level. (shr-tag-body): Use post-hoc colorizations. (shr-descend): Only render color/background when they change. (shr-tag-body): Set up a style sheet based on bgcolor/fgcolor. (shr-put-color-1): Don't overwrite old colors. (shr-colorize-region): When the background color isn't explicit, use a fixed background. gnus.el (gnus-valid-select-methods): Allow nnimap to respool. nntp.el (nntp-snarf-error-message): nnheader-report takes a format string as the parameter. gnus-sum.el (gnus-summary-respool-article): The completion function expects a list instead of an alist. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-12-02 22:21:31 +0000 +++ doc/misc/ChangeLog 2010-12-05 22:17:34 +0000 @@ -1,3 +1,8 @@ +2010-12-04 Lars Magne Ingebrigtsen + + * gnus.texi (Paging the Article): Note the reverse meanings of `C-u C-u + g'. + 2010-12-02 Julien Danjou * gnus.texi (Archived Messages): Remove gnus-outgoing-message-group. === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-12-02 22:21:31 +0000 +++ doc/misc/gnus.texi 2010-12-05 22:17:34 +0000 @@ -6152,10 +6152,10 @@ @findex gnus-summary-show-article @vindex gnus-summary-show-article-charset-alist (Re)fetch the current article (@code{gnus-summary-show-article}). If -given a prefix, fetch the current article, but don't run any of the -article treatment functions. If given a prefix twice (i.e., @kbd{C-u -C-u g'}), show a completely ``raw'' article, just the way it came from -the server. +given a prefix, show a completely ``raw'' article, just the way it +came from the server. If given a prefix twice (i.e., @kbd{C-u C-u +g'}), fetch the current article, but don't run any of the article +treatment functions. @cindex charset, view article with different charset If given a numerical prefix, you can do semi-manual charset stuff. === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-03 22:06:51 +0000 +++ lisp/gnus/ChangeLog 2010-12-05 22:17:34 +0000 @@ -1,3 +1,57 @@ +2010-12-05 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-respool-article): The completion function + expects a list instead of an alist. + + * nntp.el (nntp-snarf-error-message): nnheader-report takes a format + string as the parameter. + + * gnus.el (gnus-valid-select-methods): Allow nnimap to respool. + + * shr.el (shr-stylesheet): New dynamic variable for cascading the + styles. + (shr-colorize-region): New function. + (shr-insert-background-overlay): Remove. + (shr-render-td): Background setting should be taken care of on a higher + level. + (shr-tag-body): Use post-hoc colorizations. + (shr-tag-body): Set up a style sheet based on bgcolor/fgcolor. + (shr-put-color-1): Don't overwrite old colors. + (shr-colorize-region): When the background color isn't explicit, use + a fixed background. + + * gnus-util.el (gnus-output-to-mail): Require nnmail before using + nnmail variables. + +2010-12-05 Bjørn Mork + + * nnimap.el (nnimap-process-expiry-targets): Avoid downloading articles + unless necessary. + +2010-12-05 Andrew Cohen + + * nnir.el (nnir-run-gmane): Use more careful test for gmane nntp + server. + +2010-12-04 Lars Magne Ingebrigtsen + + * gnus-html.el (gnus-html-put-image): Use widget instead of local maps + so that TAB works. + + * gnus-sum.el (gnus-summary-show-article): Reverse the meanings of `C-u + C-u g' and `C-u g' so that `C-u g' does what it traditionally did. + + * shr.el (shr-urlify): Show the URL before the title to avoid + misleading URLs. + +2010-12-04 Adam Sjøgren + + * shr.el (shr-urlify): Display the title in tags. + +2010-12-04 Andrew Cohen + + * nnir.el (nnir-categorize): Replace mapcar with mapc. + 2010-12-03 Andrew Cohen * nnir.el: Rearrange code to allow macros to be autoloaded by === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-11-19 05:11:59 +0000 +++ lisp/gnus/gnus-html.el 2010-12-05 22:17:34 +0000 @@ -199,8 +199,11 @@ (gnus-html-display-image url start end ,alt-text)) 'gnus-image (list url start end alt-text))) - (gnus-overlay-put (gnus-make-overlay start end) - 'local-map gnus-html-image-map) + (widget-convert-button + 'url-link start (point) + :help-echo alt-text + :keymap gnus-html-image-map + url) (if (string-match "\\`cid:" url) ;; URLs with cid: have their content stashed in other ;; parts of the MIME structure, so just insert them @@ -473,10 +476,11 @@ (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size)))) (delete-region start end) (gnus-put-image image alt-text 'external) - (gnus-put-text-property start (point) 'help-echo alt-text) - (gnus-overlay-put - (gnus-make-overlay start (point)) 'local-map - gnus-html-displayed-image-map) + (widget-convert-button + 'url-link start (point) + :help-echo alt-text + :keymap gnus-html-displayed-image-map + url) (gnus-put-text-property start (point) 'gnus-alt-text alt-text) (when url === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-11-07 00:22:06 +0000 +++ lisp/gnus/gnus-int.el 2010-12-05 22:17:34 +0000 @@ -259,20 +259,21 @@ (gnus-message 1 "Denied server %s" server) nil) ;; Open the server. - (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) + (let* ((open-server-function + (gnus-get-function gnus-command-method 'open-server)) (result - (condition-case err - (funcall open-server-function - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) - (error - (gnus-message 1 "Unable to open server %s due to: %s" - server (error-message-string err)) - nil) - (quit - (gnus-message 1 "Quit trying to open server %s" server) - nil))) - open-offline) + (condition-case err + (funcall open-server-function + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) + (error + (gnus-message 1 "Unable to open server %s due to: %s" + server (error-message-string err)) + nil) + (quit + (gnus-message 1 "Quit trying to open server %s" server) + nil))) + open-offline) ;; If this hasn't been opened before, we add it to the list. (unless elem (setq elem (list gnus-command-method nil) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-12-03 22:06:51 +0000 +++ lisp/gnus/gnus-sum.el 2010-12-05 22:17:34 +0000 @@ -9475,6 +9475,9 @@ ((or (equal arg '(16)) (eq arg t)) ;; C-u C-u g + (let ((gnus-inhibit-article-treatments t)) + (gnus-summary-select-article nil 'force))) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -9492,9 +9495,6 @@ ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) (setq gnus-article-mime-handles nil))) - (gnus-summary-select-article nil 'force))) - (t - (let ((gnus-inhibit-article-treatments t)) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -9934,7 +9934,7 @@ ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (when (eq action 'move) (save-excursion (gnus-summary-goto-subject article) @@ -10004,7 +10004,7 @@ latter case, they will be copied into the relevant groups." (interactive (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) + (let* ((methods (mapcar #'car (gnus-methods-using 'respool))) (methname (symbol-name (or gnus-summary-respool-default-method (car (gnus-find-method-for-group === modified file 'lisp/gnus/gnus-util.el' --- lisp/gnus/gnus-util.el 2010-12-03 08:01:00 +0000 +++ lisp/gnus/gnus-util.el 2010-12-05 22:17:34 +0000 @@ -902,6 +902,7 @@ (defun gnus-write-buffer (file) "Write the current buffer's contents to FILE." + (require 'nnmail) (let ((file-name-coding-system nnmail-pathname-coding-system)) ;; Make sure the directory exists. (gnus-make-directory (file-name-directory file)) @@ -1137,6 +1138,7 @@ FILENAME exists and is Babyl format." (require 'rmail) (require 'mm-util) + (require 'nnmail) ;; Some of this codes is borrowed from rmailout.el. (setq filename (expand-file-name filename)) ;; FIXME should we really be messing with this defcustom? @@ -1228,6 +1230,7 @@ (defun gnus-output-to-mail (filename &optional ask) "Append the current article to a mail file named FILENAME." + (require 'nnmail) (setq filename (expand-file-name filename)) (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *Gnus-output*"))) === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2010-12-02 22:21:31 +0000 +++ lisp/gnus/gnus.el 2010-12-05 22:17:34 +0000 @@ -1608,7 +1608,7 @@ ("nnweb" none) ("nnrss" none) ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address) + ("nnimap" post-mail address prompt-address physical-address respool) ("nnmaildir" mail respool address) ("nnnil" none)) "*An alist of valid select methods. === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-12-02 22:21:31 +0000 +++ lisp/gnus/nnimap.el 2010-12-05 22:17:34 +0000 @@ -793,22 +793,42 @@ (defun nnimap-process-expiry-targets (articles group server) (let ((deleted-articles nil)) - (dolist (article articles) - (let ((target nnmail-expiry-target)) - (with-temp-buffer - (mm-disable-multibyte) - (when (nnimap-request-article article group server (current-buffer)) - (nnheader-message 7 "Expiring article %s:%d" group article) - (when (functionp target) - (setq target (funcall target group))) - (when (and target - (not (eq target 'delete))) - (if (or (gnus-request-group target t) - (gnus-request-create-group target)) - (nnmail-expiry-target-group target group) - (setq target nil))) - (when target - (push article deleted-articles)))))) + (cond + ;; shortcut further processing if we're going to delete the articles + ((eq nnmail-expiry-target 'delete) + (setq deleted-articles articles) + t) + ;; or just move them to another folder on the same IMAP server + ((and (not (functionp nnmail-expiry-target)) + (gnus-server-equal (gnus-group-method nnmail-expiry-target) + (gnus-server-to-method + (format "nnimap:%s" server)))) + (and (nnimap-possibly-change-group group server) + (with-current-buffer (nnimap-buffer) + (nnheader-message 7 "Expiring articles from %s: %s" group articles) + (nnimap-command + "UID COPY %s %S" + (nnimap-article-ranges (gnus-compress-sequence articles)) + (utf7-encode (gnus-group-real-name nnmail-expiry-target) t)) + (setq deleted-articles articles))) + t) + (t + (dolist (article articles) + (let ((target nnmail-expiry-target)) + (with-temp-buffer + (mm-disable-multibyte) + (when (nnimap-request-article article group server (current-buffer)) + (nnheader-message 7 "Expiring article %s:%d" group article) + (when (functionp target) + (setq target (funcall target group))) + (when (and target + (not (eq target 'delete))) + (if (or (gnus-request-group target t) + (gnus-request-create-group target)) + (nnmail-expiry-target-group target group) + (setq target nil))) + (when target + (push article deleted-articles)))))))) ;; Change back to the current group again. (nnimap-possibly-change-group group server) (setq deleted-articles (nreverse deleted-articles)) === modified file 'lisp/gnus/nnir.el' --- lisp/gnus/nnir.el 2010-12-03 22:06:51 +0000 +++ lisp/gnus/nnir.el 2010-12-05 22:17:34 +0000 @@ -269,7 +269,7 @@ is `(valuefunc member)'." `(unless (null ,sequence) (let (value) - (mapcar + (mapc (lambda (member) (let ((y (,keyfunc member)) (x ,(if valuefunc @@ -1381,7 +1381,10 @@ ;; gmane interface (defun nnir-run-gmane (query srv &optional groups) "Run a search against a gmane back-end server." - (if (gnus-string-match-p "gmane.org$" srv) + (if (gnus-string-match-p + "gmane.org$" + (or (cadr (assoc 'nntp-address (cddr (gnus-server-to-method srv)))) + "")) (let* ((case-fold-search t) (qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) === modified file 'lisp/gnus/nntp.el' --- lisp/gnus/nntp.el 2010-12-02 22:21:31 +0000 +++ lisp/gnus/nntp.el 2010-12-05 22:17:34 +0000 @@ -398,7 +398,8 @@ (cond ((looking-at "480") (nntp-handle-authinfo process)) ((looking-at "482") - (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) + (nnheader-report 'nntp "%s" + (get 'nntp-authinfo-rejected 'error-message)) (signal 'nntp-authinfo-rejected nil)) ((looking-at "^.*\n") (delete-region (point) (progn (forward-line 1) (point))))) @@ -1411,7 +1412,7 @@ (let ((message (buffer-string))) (while (string-match "[\r\n]+" message) (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) + (nnheader-report 'nntp "%s" message) message)) (defun nntp-accept-process-output (process) === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-12-02 22:21:31 +0000 +++ lisp/gnus/shr.el 2010-12-05 22:17:34 +0000 @@ -94,6 +94,7 @@ (defvar shr-content-cache nil) (defvar shr-kinsoku-shorten nil) (defvar shr-table-depth 0) +(defvar shr-stylesheet nil) (defvar shr-map (let ((map (make-sparse-keymap))) @@ -191,18 +192,21 @@ (defun shr-descend (dom) (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)) (style (cdr (assq :style (cdr dom)))) + (shr-stylesheet shr-stylesheet) (start (point))) (when (and style (string-match "color" style)) - (setq style (shr-parse-style style))) + (setq shr-stylesheet (nconc (shr-parse-style style) + shr-stylesheet))) (if (fboundp function) (funcall function (cdr dom)) (shr-generic (cdr dom))) - (when (consp style) - (shr-insert-background-overlay (cdr (assq 'background-color style)) - start) - (shr-insert-foreground-overlay (cdr (assq 'color style)) - start (point))))) + (let ((color (cdr (assq 'color shr-stylesheet))) + (background (cdr (assq 'background-color + shr-stylesheet)))) + (when (and shr-stylesheet + (or color background)) + (shr-colorize-region start (point) color background))))) (defun shr-generic (cont) (dolist (sub cont) @@ -544,10 +548,10 @@ (autoload 'widget-convert-button "wid-edit") -(defun shr-urlify (start url) +(defun shr-urlify (start url &optional title) (widget-convert-button 'url-link start (point) - :help-echo url + :help-echo (if title (format "%s (%s)" url title) url) :keymap shr-map url) (put-text-property start (point) 'shr-url url)) @@ -581,41 +585,58 @@ (t (shr-color-visible bg fg))))))) -(defun shr-get-background (pos) - "Return background color at POS." - (dolist (overlay (overlays-in pos (1+ pos))) - (let ((background (plist-get (overlay-get overlay 'face) - :background))) - (when background - (return background))))) - -(defun shr-insert-foreground-overlay (fg start end) +(defun shr-colorize-region (start end fg &optional bg) (when fg - (let ((bg (shr-get-background start))) - (let ((new-colors (shr-color-check fg bg))) - (when new-colors - (overlay-put (make-overlay start end) 'face - (list :foreground (cadr new-colors)))))))) - -(defun shr-insert-background-overlay (bg start) - "Insert an overlay with background color BG at START. -The overlay has rear-advance set to t, so it will be used when -text will be inserted at start." - (when bg - (let ((new-colors (shr-color-check nil bg))) + (let ((new-colors (shr-color-check fg bg))) (when new-colors - (overlay-put (make-overlay start start nil nil t) 'face - (list :background (car new-colors))))))) + (shr-put-color start end :foreground (cadr new-colors)) + (when bg + (shr-put-color start end :background (car new-colors))))))) + +;; Put a color in the region, but avoid putting colors on on blank +;; text at the start of the line, and the newline at the end, to avoid +;; ugliness. Also, don't overwrite any existing color information, +;; since this can be called recursively, and we want the "inner" color +;; to win. +(defun shr-put-color (start end type color) + (save-excursion + (goto-char start) + (while (< (point) end) + (when (bolp) + (skip-chars-forward " ")) + (when (> (line-end-position) (point)) + (shr-put-color-1 (point) (min (line-end-position) end) type color)) + (if (< (line-end-position) end) + (forward-line 1) + (goto-char end))))) + +(defun shr-put-color-1 (start end type color) + (let* ((old-props (get-text-property start 'face)) + (do-put (not (memq type old-props))) + change) + (while (< start end) + (setq change (next-single-property-change start 'face nil end)) + (when do-put + (put-text-property start change 'face + (nconc (list type color) old-props))) + (setq old-props (get-text-property change 'face)) + (setq do-put (not (memq type old-props))) + (setq start change)) + (when (and do-put + (> end start)) + (put-text-property start end 'face + (nconc (list type color old-props)))))) ;;; Tag-specific rendering rules. (defun shr-tag-body (cont) - (let ((start (point)) - (fgcolor (cdr (assq :fgcolor cont))) - (bgcolor (cdr (assq :bgcolor cont)))) - (shr-insert-background-overlay bgcolor start) + (let* ((start (point)) + (fgcolor (cdr (assq :fgcolor cont))) + (bgcolor (cdr (assq :bgcolor cont))) + (shr-stylesheet (list (cons :color fgcolor) + (cons :background-color bgcolor)))) (shr-generic cont) - (shr-insert-foreground-overlay fgcolor start (point)))) + (shr-colorize-region start (point) fgcolor bgcolor))) (defun shr-tag-p (cont) (shr-ensure-paragraph) @@ -669,10 +690,11 @@ (defun shr-tag-a (cont) (let ((url (cdr (assq :href cont))) + (title (cdr (assq :title cont))) (start (point)) shr-start) (shr-generic cont) - (shr-urlify (or shr-start start) url))) + (shr-urlify (or shr-start start) url title))) (defun shr-tag-object (cont) (let ((start (point)) @@ -818,7 +840,7 @@ (let ((start (point)) (color (cdr (assq :color cont)))) (shr-generic cont) - (shr-insert-foreground-overlay color start (point)))) + (shr-colorize-region start (point) color))) ;;; Table rendering algorithm. @@ -870,7 +892,6 @@ (nheader (if header (shr-max-columns header))) (nbody (if body (shr-max-columns body))) (nfooter (if footer (shr-max-columns footer)))) - (shr-insert-background-overlay bgcolor (point)) (shr-tag-table-1 (nconc (if caption `((tr (td ,@caption)))) @@ -1013,48 +1034,44 @@ (nreverse trs))) (defun shr-render-td (cont width fill) - (let ((background (shr-get-background (point)))) - (with-temp-buffer - (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) - (if cache - (insert cache) - (shr-insert-background-overlay (or (cdr (assq :bgcolor cont)) - background) - (point)) - (let ((shr-width width) - (shr-indentation 0)) - (shr-generic cont)) - (delete-region - (point) - (+ (point) - (skip-chars-backward " \t\n"))) - (push (cons (cons width cont) (buffer-string)) - shr-content-cache))) - (goto-char (point-min)) - (let ((max 0)) - (while (not (eobp)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (when fill - (goto-char (point-min)) - ;; If the buffer is totally empty, then put a single blank - ;; line here. - (if (zerop (buffer-size)) - (insert (make-string width ? )) - ;; Otherwise, fill the buffer. - (while (not (eobp)) - (end-of-line) - (when (> (- width (current-column)) 0) - (insert (make-string (- width (current-column)) ? ))) - (forward-line 1)))) - (if fill - (list max - (count-lines (point-min) (point-max)) - (split-string (buffer-string) "\n") - (shr-collect-overlays)) - (list max - (shr-natural-width))))))) + (with-temp-buffer + (let ((cache (cdr (assoc (cons width cont) shr-content-cache)))) + (if cache + (insert cache) + (let ((shr-width width) + (shr-indentation 0)) + (shr-generic cont)) + (delete-region + (point) + (+ (point) + (skip-chars-backward " \t\n"))) + (push (cons (cons width cont) (buffer-string)) + shr-content-cache))) + (goto-char (point-min)) + (let ((max 0)) + (while (not (eobp)) + (end-of-line) + (setq max (max max (current-column))) + (forward-line 1)) + (when fill + (goto-char (point-min)) + ;; If the buffer is totally empty, then put a single blank + ;; line here. + (if (zerop (buffer-size)) + (insert (make-string width ? )) + ;; Otherwise, fill the buffer. + (while (not (eobp)) + (end-of-line) + (when (> (- width (current-column)) 0) + (insert (make-string (- width (current-column)) ? ))) + (forward-line 1)))) + (if fill + (list max + (count-lines (point-min) (point-max)) + (split-string (buffer-string) "\n") + (shr-collect-overlays)) + (list max + (shr-natural-width)))))) (defun shr-natural-width () (goto-char (point-min)) ------------------------------------------------------------ revno: 102587 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-12-04 20:23:22 -0500 message: * src/process.c: Remove checks for HAVE_SYS_IOCTL_H (Bug#7484). diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-12-04 19:50:39 +0000 +++ src/ChangeLog 2010-12-05 01:23:22 +0000 @@ -1,3 +1,7 @@ +2010-12-05 Chong Yidong + + * process.c: Remove checks for HAVE_SYS_IOCTL_H (Bug#7484). + 2010-12-04 Andreas Schwab * Makefile.in (M_FILE): Substitute @M_FILE@ instead of @machfile@. === modified file 'src/process.c' --- src/process.c 2010-11-18 16:57:00 +0000 +++ src/process.c 2010-12-05 01:23:22 +0000 @@ -3807,7 +3807,7 @@ } -#if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) +#if defined(HAVE_NET_IF_H) #ifdef SIOCGIFCONF DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0, @@ -4050,7 +4050,7 @@ return any ? res : Qnil; } #endif -#endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */ +#endif /* defined(HAVE_NET_IF_H) */ /* Turn off input and output for process PROC. */ @@ -7704,14 +7704,14 @@ defsubr (&Sset_network_process_option); defsubr (&Smake_network_process); defsubr (&Sformat_network_address); -#if defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) +#if defined(HAVE_NET_IF_H) #ifdef SIOCGIFCONF defsubr (&Snetwork_interface_list); #endif #if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS) defsubr (&Snetwork_interface_info); #endif -#endif /* defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H) */ +#endif /* defined(HAVE_NET_IF_H) */ #ifdef DATAGRAM_SOCKETS defsubr (&Sprocess_datagram_address); defsubr (&Sset_process_datagram_address);