X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=7e51abb564e1ac30ffff9a20f31eb6b96130de10;hp=618d8e410cbb86e3a4256cb97911e42f7e506fdf;hb=06e3d74faa6b1196f0a7b877acc1bb6b6c1563a8;hpb=ff68cca86ada04bcf29226994ed98fdb083c6270

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 618d8e410..7e51abb56 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -4823,6 +4823,22 @@ General format specifiers can also be used.  See Info node
 		(vector (caddr c) (car c) :active t))
 	      gnus-mime-button-commands)))
 
+(defvar gnus-url-button-commands
+  '((gnus-article-copy-string "u" "Copy URL to kill ring")))
+
+(defvar gnus-url-button-map
+  (let ((map (make-sparse-keymap)))
+    (dolist (c gnus-url-button-commands)
+      (define-key map (cadr c) (car c)))
+    map))
+
+(easy-menu-define
+  gnus-url-button-menu gnus-url-button-map "URL button menu."
+  `("Url Button"
+    ,@(mapcar (lambda (c)
+		(vector (caddr c) (car c) :active t))
+	      gnus-url-button-commands)))
+
 (defmacro gnus-bind-safe-url-regexp (&rest body)
   "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
   `(let ((mm-w3m-safe-url-regexp
@@ -5549,7 +5565,9 @@ N is the numerical prefix."
     1))
 
 (defun gnus-article-view-part (&optional n)
-  "View MIME part N, which is the numerical prefix."
+  "View MIME part N, which is the numerical prefix.
+If the part is already shown, hide the part.  If N is nil, view
+all parts."
   (interactive "P")
   (with-current-buffer gnus-article-buffer
     (or (numberp n) (setq n (gnus-article-mime-match-handle-first
@@ -6283,18 +6301,22 @@ Argument LINES specifies lines to be scrolled up."
     (gnus-article-next-page-1 lines)
     nil))
 
-(defmacro gnus-article-beginning-of-window ()
+(defun gnus-article-beginning-of-window ()
   "Move point to the beginning of the window.
 In Emacs, the point is placed at the line number which `scroll-margin'
 specifies."
   (if (featurep 'xemacs)
-      '(move-to-window-line 0)
-    '(move-to-window-line
-      (min (max 0 scroll-margin)
-	   (max 1 (- (window-height)
-		     (if mode-line-format 1 0)
-		     (if header-line-format 1 0)
-		     2))))))
+      (move-to-window-line 0)
+    ;; There is an obscure bug in Emacs that makes it impossible to
+    ;; scroll past big pictures in the article buffer.  Try to fix
+    ;; this by adding a sanity check by counting the lines visible.
+    (when (> (count-lines (window-start) (window-end)) 30)
+      (move-to-window-line
+       (min (max 0 scroll-margin)
+	    (max 1 (- (window-height)
+		      (if mode-line-format 1 0)
+		      (if header-line-format 1 0)
+		      2)))))))
 
 (defun gnus-article-next-page-1 (lines)
   (unless (featurep 'xemacs)
@@ -6384,7 +6406,7 @@ not have a face in `gnus-article-boring-faces'."
 (defun gnus-article-describe-briefly ()
   "Describe article mode commands briefly."
   (interactive)
-  (gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page	 \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
+  (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page	 \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
 
 (defun gnus-article-check-buffer ()
   "Beep if not in an article buffer."
@@ -7807,7 +7829,11 @@ specified by `gnus-button-alist'."
 	      (unless (and (eq (car entry) 'gnus-button-url-regexp)
 			   (gnus-article-extend-url-button from start end))
 		(gnus-article-add-button start end
-					 'gnus-button-push from)))))))))
+					 'gnus-button-push from)
+		(gnus-put-text-property
+		 start end
+		 'gnus-string (buffer-substring-no-properties
+			       start end))))))))))
 
 (defun gnus-article-extend-url-button (beg start end)
   "Extend url button if url is folded into two or more lines.
@@ -7899,7 +7925,7 @@ url is put as the `gnus-button-url' overlay property on the button."
 
 ;;; External functions:
 
-(defun gnus-article-add-button (from to fun &optional data)
+(defun gnus-article-add-button (from to fun &optional data text)
   "Create a button between FROM and TO with callback FUN and data DATA."
   (when gnus-article-button-face
     (gnus-overlay-put (gnus-make-overlay from to nil t)
@@ -7911,8 +7937,21 @@ url is put as the `gnus-button-url' overlay property on the button."
 	  (list 'gnus-callback fun)
 	  (and data (list 'gnus-data data))))
   (widget-convert-button 'link from to :action 'gnus-widget-press-button
+			 :help-echo (or text "Follow the link")
+			 :keymap gnus-url-button-map
 			 :button-keymap gnus-widget-button-keymap))
 
+(defun gnus-article-copy-string ()
+  "Copy the string in the button to the kill ring."
+  (interactive)
+  (gnus-article-check-buffer)
+  (let ((data (get-text-property (point) 'gnus-string)))
+    (when data
+      (with-temp-buffer
+	(insert data)
+	(copy-region-as-kill (point-min) (point-max))
+	(message "Copied %s" data)))))
+
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()
@@ -8725,5 +8764,4 @@ For example:
 
 (run-hooks 'gnus-art-load-hook)
 
-;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
 ;;; gnus-art.el ends here