[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r113017: lisp/gnus/mm-decode.el (mm-convert-shr-link
From: |
Katsumi Yamaoka |
Subject: |
[Emacs-diffs] trunk r113017: lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so that Gnus commands work |
Date: |
Mon, 17 Jun 2013 10:52:04 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 113017
revision-id: address@hidden
parent: address@hidden
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Mon 2013-06-17 10:51:54 +0000
message:
lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so
that Gnus commands work
lisp/gnus/shr.el (shr-render-td): Support horizontal alignment
Make eww use `add-face-text-property', too
lisp/gnus/shr.el (shr-make-overlay): Obsolete function
lisp/gnus/eww.el (eww-put-color): Removed
(eww-colorize-region): Use `add-face-text-property'
Get correct presedence for font data
lisp/gnus/shr.el (shr-add-font): Append face data, so that we get the correct
presedence: The innermost value (which is applied first) wins
modified:
lisp/gnus/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1433
lisp/gnus/eww.el eww.el-20130610114603-80ap3gwnw4x4m5ix-1
lisp/gnus/mm-decode.el
mmdecode.el-20091113204419-o5vbwnq5f7feedwu-1971
lisp/gnus/shr.el shr.el-20101002102929-yfzewk55rsg0mn93-1
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2013-06-17 09:19:50 +0000
+++ b/lisp/gnus/ChangeLog 2013-06-17 10:51:54 +0000
@@ -1,5 +1,17 @@
2013-06-17 Lars Magne Ingebrigtsen <address@hidden>
+ * mm-decode.el (mm-convert-shr-links): Override the shr local map, so
+ that Gnus commands work.
+
+ * shr.el (shr-render-td): Support horizontal alignment.
+
+ * eww.el (eww-put-color): Removed.
+ (eww-colorize-region): Use `add-face-text-property'.
+
+ * shr.el (shr-add-font): Append face data, so that we get the correct
+ presedence: The innermost value (which is applied first) wins.
+ (shr-make-overlay): Obsolete function.
+
* mm-decode.el (mm-convert-shr-links): New function to convert
new-style shr URL links into widgets.
(mm-shr): Use it.
=== modified file 'lisp/gnus/eww.el'
--- a/lisp/gnus/eww.el 2013-06-17 09:19:50 +0000
+++ b/lisp/gnus/eww.el 2013-06-17 10:51:54 +0000
@@ -172,12 +172,11 @@
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
- (eww-put-color start end :foreground (cadr new-colors)))
+ (add-face-text-property start end
+ (list :foreground (cadr new-colors))))
(when bg
- (eww-put-color start end :background (car new-colors)))))))
-
-(defun eww-put-color (start end type color)
- (shr-put-color-1 start end type color))
+ (add-face-text-property start end
+ (list :background (car new-colors))))))))
(defun eww-display-raw (charset)
(let ((data (buffer-substring (point) (point-max))))
=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el 2013-06-17 09:36:28 +0000
+++ b/lisp/gnus/mm-decode.el 2013-06-17 10:51:54 +0000
@@ -1831,6 +1831,7 @@
:help-echo (get-text-property start 'help-echo)
:keymap shr-map
(get-text-property start 'shr-url))
+ (put-text-property start end 'local-map nil)
(setq start end)))))
(defun mm-handle-filename (handle)
=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el 2013-06-17 09:19:50 +0000
+++ b/lisp/gnus/shr.el 2013-06-17 10:51:54 +0000
@@ -609,11 +609,6 @@
(dolist (type types)
(shr-add-font (or shr-start (point)) (point) type))))
-(defun shr-make-overlay (beg end &optional buffer front-advance rear-advance)
- (let ((overlay (make-overlay beg end buffer front-advance rear-advance)))
- (overlay-put overlay 'evaporate t)
- overlay))
-
;; Add face to the region, but avoid putting the font properties on
;; blank text at the start of the line, and the newline at the end, to
;; avoid ugliness.
@@ -623,7 +618,7 @@
(while (< (point) end)
(when (bolp)
(skip-chars-forward " "))
- (add-face-text-property (point) (min (line-end-position) end) type)
+ (add-face-text-property (point) (min (line-end-position) end) type t)
(if (< (line-end-position) end)
(forward-line 1)
(goto-char end)))))
@@ -843,32 +838,11 @@
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
- (shr-put-color start end :foreground (cadr new-colors)))
+ (shr-add-font start end (list :foreground (cadr new-colors))))
(when bg
- (shr-put-color start end :background (car new-colors))))
+ (shr-add-font start end (list :background (car new-colors)))))
new-colors)))
-;; Put a color in the region, but avoid putting colors 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 (and (bolp)
- (not (eq type :background)))
- (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)))
- (when (and (eq type :background)
- (= shr-table-depth 0))
- (shr-expand-newlines start end color))))
-
(defun shr-expand-newlines (start end color)
(save-restriction
;; Skip past all white space at the start and ends.
@@ -919,24 +893,6 @@
'before-string)))))
(+ width previous-width))))
-(defun shr-put-color-1 (start end type color)
- (let* ((old-props (get-text-property start 'face))
- (do-put (and (listp old-props)
- (not (memq type old-props))))
- change)
- (while (< start end)
- (setq change (next-single-property-change start 'face nil end))
- (when do-put
- (add-face-text-property start change (list type color)))
- (setq old-props (get-text-property change 'face))
- (setq do-put (and (listp old-props)
- (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)
@@ -1381,7 +1337,8 @@
(insert (make-string (string-width (car lines)) ? )
shr-table-vertical-line)
(when (nth 4 column)
- (shr-put-color start (1- (point)) :background (nth 4 column))))
+ (shr-add-font start (1- (point))
+ (list :background (nth 4 column)))))
(forward-line 1)))))
(shr-insert-table-ruler widths)))
@@ -1492,11 +1449,23 @@
(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)))
+ (let ((align (cdr (assq :align cont)))
+ length)
+ (while (not (eobp))
+ (end-of-line)
+ (setq length (- width (current-column)))
+ (when (> length 0)
+ (cond
+ ((equal align "right")
+ (beginning-of-line)
+ (insert (make-string length ? )))
+ ((equal align "center")
+ (insert (make-string (/ length 2) ? ))
+ (beginning-of-line)
+ (insert (make-string (- length (/ length 2)) ? )))
+ (t
+ (insert (make-string length ? )))))
+ (forward-line 1))))
(when style
(setq actual-colors
(shr-colorize-region
@@ -1567,7 +1536,7 @@
;; Emacs less than 24.3
(unless (fboundp 'add-face-text-property)
- (defun add-face-text-property (beg end face)
+ (defun add-face-text-property (beg end face &optional appendp object)
"Combine FACE BEG and END."
(let ((b beg))
(while (< b end)
@@ -1578,9 +1547,13 @@
face)
((and (consp oldval)
(not (keywordp (car oldval))))
- (cons face oldval))
+ (if appendp
+ (nconc oldval (list face))
+ (cons face oldval)))
(t
- (list face oldval)))))))))
+ (if appendp
+ (list oldval face)
+ (list face oldval))))))))))
(provide 'shr)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r113017: lisp/gnus/mm-decode.el (mm-convert-shr-links): Override the shr local map, so that Gnus commands work,
Katsumi Yamaoka <=