Merge remote-tracking branch 'origin/no-gnus'
authorLars Ingebrigtsen <larsi@gnus.org>
Wed, 8 Feb 2012 00:09:38 +0000 (01:09 +0100)
committerLars Ingebrigtsen <larsi@gnus.org>
Wed, 8 Feb 2012 00:09:38 +0000 (01:09 +0100)
1  2 
lisp/ChangeLog
lisp/shr.el

diff --combined lisp/ChangeLog
@@@ -1,27 -1,9 +1,33 @@@
 +2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * gnus-compat.el: Make `help-function-arglist' be compatible on Emacs
 +      23.1.
 +
 +2012-02-07  Katsumi Yamaoka  <yamaoka@jpl.org>
 +
 +      * gnus-sum.el (gnus-summary-show-thread): Revert last two changes.
 +
 +2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * message.el (smtpmail-smtp-user): Silence compiler warning.
 +
 +2012-02-06  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * message.el (message-multi-smtp-send-mail): Also allow specifying the
 +      SMTP user name.
 +
 +2012-02-06  Katsumi Yamaoka  <yamaoka@jpl.org>
 +
 +      * gnus-sum.el (gnus-summary-show-thread):
 +      next-single-char-property-change may return nil in XEmacs.
 +      (gnus-summary-article-map): Fix typo.
 +
+ 2012-02-08  Lars Ingebrigtsen  <larsi@gnus.org>
+       * shr.el: Inhibit getting and sending cookies when fetching pictures.
+       * gnus-html.el (gnus-html-schedule-image-fetching): Ditto.
  2012-02-07  Lars Ingebrigtsen  <larsi@gnus.org>
  
        * shr.el (shr-remove-trailing-whitespace): Don't strip whitespace from
        * gnus-sum.el (gnus-summary-show-thread):
        next-single-char-property-change never returns nil (Bug#8657).
  
 +2012-02-02  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * message.el (message-multi-smtp-send-mail): New function.
 +      (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method
 +      header to implement multi-SMTP functionality.
 +
 +      * gnus-agent.el (gnus-agent-send-mail-function): Removed.
 +      (gnus-agentize): Don't set it.
 +      (gnus-agent-send-mail): Don't use it.
 +
 +      * gnus-sum.el (gnus-summary-widget-backward): New function and
 +      keystroke.
 +
 +      * gnus-compat.el: More the compat functions more compatible.
 +
 +      * shr.el (shr-put-image): Remove underlines from sliced images.
 +      (shr-zoom-image): Compute the region to be replaced more correctly.
 +
 +2012-02-02  Katsumi Yamaoka  <yamaoka@jpl.org>
 +
 +      * gnus-msg.el (gnus-gcc-self-resent-messages): New user option.
 +      (gnus-summary-resend-message-insert-gcc): New function.
 +      (gnus-summary-resend-message): Modify message-header-setup-hook and
 +      message-sent-hook to make it work for Gcc.
 +      (gnus-inews-do-gcc): Update the number of unread articles of groups
 +      that messages are Gcc'd to.
 +
 +      * message.el (message-resend): Run message-sent-hook to do Gcc.
 +
 +2012-02-01  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * lpath.el: Fix an XEmacs compilation warning.
 +
 +      * gnus-compat.el: Require `help-fns' to fix compilation error.
 +
 +      * gnus-registry.el (gnus-registry-fixup-registry): Move the message to
 +      a higher level to silence compilation.
 +
 +      * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
 +      parameter to allow controlling the scaling.
 +
 +      * shr.el (shr-zoom-image): New command and keystroke.
 +      (shr-put-image): Take a `size' flag to say how to scale the image.
 +
 +      * gnus-compat.el: Redefine `delete-directory' to provide recursive
 +      deletion unless already defined.
 +
 +      * gnus.el (gnus-compat): Require it.
 +
 +      * gnus-compat.el: New file.
 +
 +      * gnus-start.el (gnus-clean-old-newsrc): New function.
 +      (gnus-read-newsrc-file): Use it.
 +
 +      * mm-archive.el (mm-dissect-archive): Use it to get all file names.
 +      Use recursive deletion.
 +      (mm-dissect-archive): Add support for zip files.
 +
 +      * gnus-util.el (gnus-recursive-directory-files): New function.
 +
 +      * mm-archive.el (mm-archive-list-files): Inline text and image parts.
 +      (mm-archive-decoders): Add tgz support.
 +
 +      * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline.
 +      Otherwise inserting text into the Gnus buffer can look odd.
 +
 +      * gnus-art.el (gnus-mime-inline-part): Slight clean-up.
 +
 +      * mm-archive.el (mm-archive-decoders): Add support for tar.
 +
 +      * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus.
 +
 +      * nnmail.el (nnmail-extra-headers): Add Cc to the default.
 +
 +2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
 +
 +      * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
 +
 +      * mm-archive.el: New file.
 +
 +      * mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.
 +
 +      * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
 +
 +      * message.el (message-goto-*): Make all the `message-goto-*' commands
 +      push the mark before moving point.  This makes it easier to go back to
 +      where you came from after editing whatever you jumped to.
 +
 +2012-01-31  Lars Magne Ingebrigtsen  <lars@ingebrigtsen.no>
 +
 +      * gnus.el: Ma Gnus v0.1 is released.
 +
  2012-02-05  Lars Ingebrigtsen  <larsi@gnus.org>
  
        * nnimap.el (nnimap-open-server): Allow switching the nnoo server
        * gnus-agent.el (gnus-agent-expire-unagentized-dirs):
          Correct a comment (insert "not") and hide nominally-doubled "to".
  
 -2012-01-31  Lars Magne Ingebrigtsen  <lars@ingebrigtsen.no>
 +2012-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
  
 -      * gnus.el: No Gnus v0.19 is released.
 +      * gnus.el (gnus-version): Change name to "Ma Gnus".
  
  2012-01-30  Philipp Haselwarter  <philipp.haselwarter@gmx.de>  (tiny change)
  
diff --combined lisp/shr.el
@@@ -118,7 -118,6 +118,7 @@@ cid: URL as the argument."
    (let ((map (make-sparse-keymap)))
      (define-key map "a" 'shr-show-alt-text)
      (define-key map "i" 'shr-browse-image)
 +    (define-key map "z" 'shr-zoom-image)
      (define-key map "I" 'shr-insert-image)
      (define-key map "u" 'shr-copy-url)
      (define-key map "v" 'shr-browse-url)
@@@ -189,7 -188,8 +189,8 @@@ redirects somewhere else.
             (when (re-search-forward ".utm_.*" nil t)
               (replace-match "" t t))
             (message "Copied %s" (buffer-string))
-            (copy-region-as-kill (point-min) (point-max)))))))
+            (copy-region-as-kill (point-min) (point-max)))))
+        nil t))
       ;; Copy the URL to the kill ring.
       (t
        (with-temp-buffer
@@@ -232,42 -232,8 +233,42 @@@ the URL of the image to the kill buffe
        (message "Inserting %s..." url)
        (url-retrieve url 'shr-image-fetched
                    (list (current-buffer) (1- (point)) (point-marker))
-                   t))))
+                   t t))))
  
 +(defun shr-zoom-image ()
 +  "Toggle the image size.
 +The size will be rotated between the default size, the original
 +size, and full-buffer size."
 +  (interactive)
 +  (let ((url (get-text-property (point) 'image-url))
 +      (size (get-text-property (point) 'image-size))
 +      (buffer-read-only nil))
 +    (if (not url)
 +      (message "No image under point")
 +      ;; Delete the old picture.
 +      (while (get-text-property (point) 'image-url)
 +      (forward-char -1))
 +      (forward-char 1)
 +      (let ((start (point)))
 +      (while (get-text-property (point) 'image-url)
 +        (forward-char 1))
 +      (forward-char -1)
 +      (put-text-property start (point) 'display nil)
 +      (when (> (- (point) start) 2)
 +        (delete-region start (1- (point)))))
 +      (message "Inserting %s..." url)
 +      (url-retrieve url 'shr-image-fetched
 +                  (list (current-buffer) (1- (point)) (point-marker)
 +                        (list (cons 'size
 +                                    (cond ((or (eq size 'default)
 +                                               (null size))
 +                                           'original)
 +                                          ((eq size 'original)
 +                                           'full)
 +                                          ((eq size 'full)
 +                                           'default)))))
 +                  t))))
 +
  ;;; Utility functions.
  
  (defun shr-transform-dom (dom)
      (if (not url)
        (message "No link under point")
        (url-retrieve (shr-encode-url url)
-                   'shr-store-contents (list url directory)))))
+                   'shr-store-contents (list url directory)
+                   nil t))))
  
  (defun shr-store-contents (status url directory)
    (unless (plist-get status :error)
                    (expand-file-name (file-name-nondirectory url)
                                      directory)))))
  
 -(defun shr-image-fetched (status buffer start end)
 +(defun shr-image-fetched (status buffer start end &optional flags)
    (when (and (buffer-name buffer)
             (not (plist-get status :error)))
      (url-store-in-cache (current-buffer))
          (with-current-buffer buffer
          (save-excursion
            (let ((alt (buffer-substring start end))
 +                (properties (text-properties-at start))
                  (inhibit-read-only t))
              (delete-region start end)
              (goto-char start)
 -            (funcall shr-put-image-function data alt)))))))
 +            (funcall shr-put-image-function data alt flags)
 +            (while properties
 +              (let ((type (pop properties))
 +                    (value (pop properties)))
 +                (unless (memq type '(display image-size))
 +                  (put-text-property start (point) type value))))))))))
    (kill-buffer (current-buffer)))
  
 -(defun shr-put-image (data alt)
 +(defun shr-put-image (data alt &optional flags)
    "Put image DATA with a string ALT.  Return image."
    (if (display-graphic-p)
 -      (let ((image (ignore-errors
 -                     (shr-rescale-image data))))
 +      (let* ((size (cdr (assq 'size flags)))
 +           (start (point))
 +           (image (cond
 +                   ((eq size 'original)
 +                    (create-image data nil t :ascent 100))
 +                   ((eq size 'full)
 +                    (ignore-errors
 +                      (shr-rescale-image data t)))
 +                   (t
 +                    (ignore-errors
 +                      (shr-rescale-image data))))))
          (when image
          ;; When inserting big-ish pictures, put them at the
          ;; beginning of the line.
          (when (and (> (current-column) 0)
                     (> (car (image-size image t)) 400))
            (insert "\n"))
 -        (insert-image image (or alt "*"))
 +        (if (eq size 'original)
 +            (let ((overlays (overlays-at (point))))
 +              (insert-sliced-image image (or alt "*") nil 20 1)
 +              (dolist (overlay overlays)
 +                (overlay-put overlay 'face 'default)))
 +          (insert-image image (or alt "*")))
 +        (put-text-property start (point) 'image-size size)
          (when (image-animated-p image)
            (image-animate image nil 60)))
        image)
      (insert alt)))
  
 -(defun shr-rescale-image (data)
 +(defun shr-rescale-image (data &optional force)
 +  "Rescale DATA, if too big, to fit the current buffer.
 +If FORCE, rescale the image anyway."
    (let ((image (create-image data nil t :ascent 100)))
      (if (or (not (fboundp 'imagemagick-types))
            (not (get-buffer-window (current-buffer))))
             (window-height (truncate (* shr-max-image-proportion
                                         (- (nth 3 edges) (nth 1 edges)))))
             scaled-image)
 -      (when (> height window-height)
 +      (when (or force
 +                (> height window-height))
          (setq image (or (create-image data 'imagemagick t
                                        :height window-height
                                        :ascent 100)
@@@ -676,7 -619,7 +678,7 @@@ START, and END.  Note that START and EN
                   (delete-region (point) end))))
         (url-retrieve url 'shr-image-fetched
                       (list (current-buffer) start end)
-                      t)))))
+                      t t)))))
  
  (defun shr-heading (cont &rest types)
    (shr-ensure-paragraph)
@@@ -986,13 -929,10 +988,10 @@@ ones, in case fg and bg are nil.
            (let ((file (url-cache-create-filename (shr-encode-url url))))
              (when (file-exists-p file)
                (delete-file file))))
-         (funcall
-          (if (fboundp 'url-queue-retrieve)
-              'url-queue-retrieve
-            'url-retrieve)
+         (url-queue-retrieve
           (shr-encode-url url) 'shr-image-fetched
           (list (current-buffer) start (set-marker (make-marker) (1- (point))))
-          t)))
+          t t)))
        (when (zerop shr-table-depth) ;; We are not in a table.
          (put-text-property start (point) 'keymap shr-map)
          (put-text-property start (point) 'shr-alt alt)