Fix some custom types

[gnu-emacs] / lisp / net / shr.el

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 886308d55efa243448d7918c5da9b81c12670046..bc4542923607f41ce9c4f7ec35ba2e95af8909ba 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -59,7 +59,7 @@ fit these criteria."
   "Character used to draw horizontal table lines.
 If nil, don't draw horizontal table lines."
   :group 'shr
-  :type 'character)
+  :type '(choice (const nil) character))
 
 (defcustom shr-table-vertical-line ?\s
   "Character used to draw vertical table lines."
@@ -143,7 +143,9 @@ cid: URL as the argument.")
     (define-key map [tab] 'shr-next-link)
     (define-key map [backtab] 'shr-previous-link)
     (define-key map [follow-link] 'mouse-face)
+    (define-key map [mouse-2] 'shr-browse-url)
     (define-key map "I" 'shr-insert-image)
+    (define-key map "w" 'shr-copy-url)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
     (define-key map "o" 'shr-save-contents)
@@ -166,6 +168,17 @@ cid: URL as the argument.")
      (libxml-parse-html-region (point-min) (point-max))))
   (goto-char (point-min)))
 
+(defun shr-render-region (begin end &optional buffer)
+  "Display the HTML rendering of the region between BEGIN and END."
+  (interactive "r")
+  (unless (fboundp 'libxml-parse-html-region)
+    (error "This function requires Emacs to be compiled with libxml2"))
+  (with-current-buffer (or buffer (current-buffer))
+    (let ((dom (libxml-parse-html-region begin end)))
+      (delete-region begin end)
+      (goto-char begin)
+      (shr-insert-document dom))))
+
 (defun shr-visit-file (file)
   "Parse FILE as an HTML document, and render it in a new buffer."
   (interactive "fHTML file name: ")
@@ -645,10 +658,17 @@ size, and full-buffer size."
            (forward-line 1)
          (goto-char end))))))
 
-(defun shr-browse-url (&optional external)
+(defun shr-mouse-browse-url (ev)
+  "Browse the URL under the mouse cursor."
+  (interactive "e")
+  (mouse-set-point ev)
+  (shr-browse-url))
+
+(defun shr-browse-url (&optional external mouse-event)
   "Browse the URL under point.
 If EXTERNAL, browse the URL using `shr-external-browser'."
-  (interactive "P")
+  (interactive (list current-prefix-arg last-nonmenu-event))
+  (mouse-set-point mouse-event)
   (let ((url (get-text-property (point) 'shr-url)))
     (cond
      ((not url)
@@ -751,6 +771,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
   "Rescale DATA, if too big, to fit the current buffer.
 If FORCE, rescale the image anyway."
   (if (or (not (fboundp 'imagemagick-types))
+         (eq (image-type-from-data data) 'gif)
          (not (get-buffer-window (current-buffer))))
       (create-image data nil t :ascent 100)
     (let ((edges (window-inside-pixel-edges
@@ -812,6 +833,8 @@ START, and END.  Note that START and END should be markers."
    start (point)
    (list 'shr-url url
         'help-echo (if title (format "%s (%s)" url title) url)
+        'follow-link t
+        'mouse-face 'highlight
         'keymap shr-map)))
 
 (defun shr-encode-url (url)
@@ -1462,10 +1485,14 @@ ones, in case fg and bg are nil."
              (setq width
                    (if column
                        (aref widths width-column)
-                     0))
+                     10))
              (when (and fill
                         (setq colspan (cdr (assq :colspan (cdr column)))))
-               (setq colspan (string-to-number colspan))
+               (setq colspan (min (string-to-number colspan)
+                                  ;; The colspan may be wrong, so
+                                  ;; truncate it to the length of the
+                                  ;; remaining columns.
+                                  (- (length widths) i)))
                (dotimes (j (1- colspan))
                  (if (> (+ i 1 j) (1- (length widths)))
                      (setq width (aref widths (1- (length widths))))
@@ -1606,27 +1633,6 @@ ones, in case fg and bg are nil."
                              (shr-count (cdr row) 'th))))))
     max))
 
-;; Emacs less than 24.3
-(unless (fboundp 'add-face-text-property)
-  (defun add-face-text-property (beg end face &optional appendp object)
-    "Combine FACE BEG and END."
-    (let ((b beg))
-      (while (< b end)
-       (let ((oldval (get-text-property b 'face)))
-         (put-text-property
-          b (setq b (next-single-property-change b 'face nil end))
-          'face (cond ((null oldval)
-                       face)
-                      ((and (consp oldval)
-                            (not (keywordp (car oldval))))
-                       (if appendp
-                           (nconc oldval (list face))
-                         (cons face oldval)))
-                      (t
-                       (if appendp
-                           (list oldval face)
-                         (list face oldval))))))))))
-
 (provide 'shr)
 
 ;; Local Variables: