(gnus-group-completing-read): Remove all newlines from group names. They mess up...

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index e360eab..6646cec 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -98,6 +98,7 @@ cid: URL as the argument.")
     (define-key map "I" 'shr-insert-image)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
+    (define-key map "o" 'shr-save-contents)
     (define-key map "\r" 'shr-browse-url)
     map))
 
@@ -241,8 +242,8 @@ redirects somewhere else."
                  (insert "\n"))
          (put-text-property (1- (point)) (point) 'shr-break t)
          ;; No space is needed at the beginning of a line.
-         (if (eq (following-char) ? )
-             (delete-char 1)))
+         (when (eq (following-char) ? )
+           (delete-char 1)))
        (when (> shr-indentation 0)
          (shr-indent))
        (end-of-line))
@@ -271,15 +272,23 @@ redirects somewhere else."
          ;; Don't put kinsoku-bol characters at the beginning of a line,
          ;; or kinsoku-eol characters at the end of a line,
          (let ((count 4))
-           (if shr-kinsoku-shorten
+           (if (or shr-kinsoku-shorten
+                   (and (aref (char-category-set (preceding-char)) ?<)
+                        (progn
+                          (setq count (1- count))
+                          (backward-char 1)
+                          t)))
                (while (and
-                       (> count 0)
+                       (>= (setq count (1- count)) 0)
+                       (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
                        (or (aref (char-category-set (preceding-char)) ?<)
                            (aref (char-category-set (following-char)) ?>)))
                  (backward-char 1))
-             (while (and (> count 0)
+             (while (and (>= (setq count (1- count)) 0)
                          (aref (char-category-set (following-char)) ?>))
                (forward-char 1)))
+           (when (eq (following-char) ? )
+             (forward-char 1))
            t)))))
 
 (defun shr-ensure-newline ()
@@ -309,9 +318,20 @@ redirects somewhere else."
     (dolist (type types)
       (shr-add-font (or shr-start (point)) (point) type))))
 
+;; Add an overlay in 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.
 (defun shr-add-font (start end type)
-  (let ((overlay (make-overlay start end)))
-    (overlay-put overlay 'face type)))
+  (save-excursion
+    (goto-char start)
+    (while (< (point) end)
+      (when (bolp)
+       (skip-chars-forward " "))
+      (let ((overlay (make-overlay (point) (min (line-end-position) end))))
+       (overlay-put overlay 'face type))
+      (if (< (line-end-position) end)
+         (forward-line 1)
+       (goto-char end)))))
 
 (defun shr-browse-url ()
   "Browse the URL under point."
@@ -321,6 +341,23 @@ redirects somewhere else."
        (message "No link under point")
       (browse-url url))))
 
+(defun shr-save-contents (directory)
+  "Save the contents from URL in a file."
+  (interactive "DSave contents of URL to directory: ")
+  (let ((url (get-text-property (point) 'shr-url)))
+    (if (not url)
+       (message "No link under point")
+      (url-retrieve (shr-encode-url url)
+                   'shr-store-contents (list url directory)))))
+
+(defun shr-store-contents (status url directory)
+  (unless (plist-get status :error)
+    (when (or (search-forward "\n\n" nil t)
+             (search-forward "\r\n\r\n" nil t))
+      (write-region (point) (point-max)
+                   (expand-file-name (file-name-nondirectory url)
+                                     directory)))))
+
 (defun shr-image-fetched (status buffer start end)
   (when (and (buffer-name buffer)
             (not (plist-get status :error)))
@@ -450,7 +487,8 @@ Return a string with image data."
   (browse-url-url-encode-chars url "[)$ ]"))
 
 (defun shr-tag-img (cont)
-  (when cont
+  (when (and cont
+            (cdr (assq :src cont)))
     (when (and (> (current-column) 0)
               (not (eq shr-state 'image)))
       (insert "\n"))
@@ -567,8 +605,7 @@ Return a string with image data."
 ;; main buffer).  Now we know how much space each TD really takes, so
 ;; we then render everything again with the new widths, and finally
 ;; insert all these boxes into the main buffer.
-(defun shr-tag-table (cont)
-  (shr-ensure-paragraph)
+(defun shr-tag-table-1 (cont)
   (setq cont (or (cdr (assq 'tbody cont))
                 cont))
   (let* ((shr-inhibit-images t)
@@ -596,6 +633,54 @@ Return a string with image data."
   (dolist (elem (shr-find-elements cont 'img))
     (shr-tag-img (cdr elem))))
 
+(defun shr-tag-table (cont)
+  (shr-ensure-paragraph)
+  (let* ((caption (cdr (assq 'caption cont)))
+        (header (cdr (assq 'thead cont)))
+        (body (or (cdr (assq 'tbody cont)) cont))
+        (footer (cdr (assq 'tfoot cont)))
+        (nheader (if header (shr-max-columns header)))
+        (nbody (if body (shr-max-columns body)))
+        (nfooter (if footer (shr-max-columns footer))))
+    (shr-tag-table-1
+     (nconc
+      (if caption `((tr (td ,@caption))))
+      (if header
+         (if footer
+             ;; hader + body + footer
+             (if (= nheader nbody)
+                 (if (= nbody nfooter)
+                     `((tr (td (table (tbody ,@header ,@body ,@footer)))))
+                   (nconc `((tr (td (table (tbody ,@header ,@body)))))
+                          (if (= nfooter 1)
+                              footer
+                            `((tr (td (table (tbody ,@footer))))))))
+               (nconc `((tr (td (table (tbody ,@header)))))
+                      (if (= nbody nfooter)
+                          `((tr (td (table (tbody ,@body ,@footer)))))
+                        (nconc `((tr (td (table (tbody ,@body)))))
+                               (if (= nfooter 1)
+                                   footer
+                                 `((tr (td (table (tbody ,@footer))))))))))
+           ;; header + body
+           (if (= nheader nbody)
+               `((tr (td (table (tbody ,@header ,@body)))))
+             (if (= nheader 1)
+                 `(,@header (tr (td (table (tbody ,@body)))))
+               `((tr (td (table (tbody ,@header))))
+                 (tr (td (table (tbody ,@body))))))))
+       (if footer
+           ;; body + footer
+           (if (= nbody nfooter)
+               `((tr (td (table (tbody ,@body ,@footer)))))
+             (nconc `((tr (td (table (tbody ,@body)))))
+                    (if (= nfooter 1)
+                        footer
+                      `((tr (td (table (tbody ,@footer))))))))
+         (if caption
+             `((tr (td (table (tbody ,@body)))))
+           body)))))))
+
 (defun shr-find-elements (cont type)
   (let (result)
     (dolist (elem cont)