changeset 81301:72447e6dd130

Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 227-228) - Update from CVS 2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-ems.el (gnus-x-splash): Make it work. * lisp/gnus/gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash from being used. * lisp/gnus/gnus-art.el (gnus-article-summary-command-nosave): Correct the order of the arguments passed to pop-to-buffer. (gnus-article-read-summary-keys): Ditto. 2007-06-06 Andreas Seltenreich <andreas@gate450.dyndns.org> * man/gnus.texi (Misc Group Stuff, Summary Buffer) (Server Commands, Article Keymap): Fix typo. s/function/command/. Revision: emacs@sv.gnu.org/emacs--devo--0--patch-792
author Miles Bader <miles@gnu.org>
date Mon, 11 Jun 2007 00:56:04 +0000
parents 961ae69bdad8
children fa22f045a60e cc587bfd19ca e9f94688a064
files lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-ems.el lisp/gnus/gnus-start.el man/ChangeLog man/gnus.texi
diffstat 6 files changed, 118 insertions(+), 48 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Mon Jun 11 00:23:06 2007 +0000
+++ b/lisp/gnus/ChangeLog	Mon Jun 11 00:56:04 2007 +0000
@@ -1,3 +1,14 @@
+2007-06-08  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-ems.el (gnus-x-splash): Make it work.
+
+	* gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash
+	from being used.
+
+	* gnus-art.el (gnus-article-summary-command-nosave): Correct the order
+	of the arguments passed to pop-to-buffer.
+	(gnus-article-read-summary-keys): Ditto.
+
 2007-06-07  Juanma Barranquero  <lekktu@gmail.com>
 
 	* gnus-art.el (gnus-split-methods): Fix typo in docstring.
--- a/lisp/gnus/gnus-art.el	Mon Jun 11 00:23:06 2007 +0000
+++ b/lisp/gnus/gnus-art.el	Mon Jun 11 00:56:04 2007 +0000
@@ -5607,7 +5607,7 @@
   "Execute the last keystroke in the summary buffer."
   (interactive)
   (let (func)
-    (pop-to-buffer gnus-article-current-summary 'norecord)
+    (pop-to-buffer gnus-article-current-summary nil 'norecord)
     (setq func (lookup-key (current-local-map) (this-command-keys)))
     (call-interactively func)))
 
@@ -5646,7 +5646,7 @@
 	    (member keys nosave-in-article))
 	(let (func)
 	  (save-window-excursion
-	    (pop-to-buffer gnus-article-current-summary 'norecord)
+	    (pop-to-buffer gnus-article-current-summary nil 'norecord)
 	    ;; We disable the pick minor mode commands.
 	    (let (gnus-pick-mode)
 	      (setq func (lookup-key (current-local-map) keys))))
@@ -5658,14 +5658,14 @@
 	    (call-interactively func)
 	    (setq new-sum-point (point)))
 	  (when (member keys nosave-but-article)
-	    (pop-to-buffer gnus-article-buffer 'norecord)))
+	    (pop-to-buffer gnus-article-buffer nil 'norecord)))
       ;; These commands should restore window configuration.
       (let ((obuf (current-buffer))
 	    (owin (current-window-configuration))
 	    (opoint (point))
 	    win func in-buffer selected new-sum-start new-sum-hscroll)
 	(cond (not-restore-window
-	       (pop-to-buffer gnus-article-current-summary 'norecord))
+	       (pop-to-buffer gnus-article-current-summary nil 'norecord))
 	      ((setq win (get-buffer-window gnus-article-current-summary))
 	       (select-window win))
 	      (t
--- a/lisp/gnus/gnus-ems.el	Mon Jun 11 00:23:06 2007 +0000
+++ b/lisp/gnus/gnus-ems.el	Mon Jun 11 00:56:04 2007 +0000
@@ -172,40 +172,95 @@
 
 (defun gnus-x-splash ()
   "Show a splash screen using a pixmap in the current buffer."
-  (let ((dir (nnheader-find-etc-directory "gnus"))
-	pixmap file height beg i)
-    (save-excursion
-      (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
-      (let ((buffer-read-only nil)
-	    width height)
-	(erase-buffer)
-	(when (and dir
-		   (file-exists-p (setq file
-					(expand-file-name "x-splash" dir))))
-	  (let ((coding-system-for-read 'raw-text)
-		default-enable-multibyte-characters)
-	    (with-temp-buffer
-	      (insert-file-contents file)
-	      (goto-char (point-min))
-	      (ignore-errors
-		(setq pixmap (read (current-buffer)))))))
-	(when pixmap
-	  (make-face 'gnus-splash)
-	  (setq height (/ (car pixmap) (frame-char-height))
-		width (/ (cadr pixmap) (frame-char-width)))
-	  (set-face-foreground 'gnus-splash "Brown")
-	  (set-face-stipple 'gnus-splash pixmap)
-	  (insert-char ?\n (* (/ (window-height) 2 height) height))
-	  (setq i height)
-	  (while (> i 0)
-	    (insert-char ?\  (* (/ (window-width) 2 width) width))
-	    (setq beg (point))
-	    (insert-char ?\  width)
-	    (set-text-properties beg (point) '(face gnus-splash))
-	    (insert ?\n)
-	    (decf i))
-	  (goto-char (point-min))
-	  (sit-for 0))))))
+  (interactive)
+  (unless window-system
+    (error "`gnus-x-splash' requires running on the window system"))
+  (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p)
+						    (interactive-p))
+						"*gnus-x-splash*"
+					      gnus-group-buffer)))
+  (let ((inhibit-read-only nil)
+	(file (nnheader-find-etc-directory "images/gnus/x-splash" t))
+	pixmap fcw fch width height fringes sbars left yoffset top ls)
+    (erase-buffer)
+    (when (and file
+	       (ignore-errors
+		(let ((coding-system-for-read 'raw-text)
+		      default-enable-multibyte-characters)
+		  (with-temp-buffer
+		    (insert-file-contents file)
+		    (goto-char (point-min))
+		    (setq pixmap (read (current-buffer)))))))
+      (setq fcw (float (frame-char-width))
+	    fch (float (frame-char-height))
+	    width (/ (car pixmap) fcw)
+	    height (/ (cadr pixmap) fch)
+	    fringes (if (fboundp 'window-fringes)
+			(eval '(window-fringes))
+		      '(10 11 nil))
+	    sbars (frame-parameter nil 'vertical-scroll-bars))
+      (cond ((eq sbars 'right)
+	     (setq sbars
+		   (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14)
+			      fcw))))
+	    (sbars
+	     (setq sbars
+		   (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14)
+			    fcw)
+			 0))))
+      (setq left (- (* (round (/ (1- (/ (+ (window-width)
+					   (car sbars) (cdr sbars)
+					   (/ (+ (or (car fringes) 0)
+						 (or (cadr fringes) 0))
+					      fcw))
+					width))
+				 2))
+		       width)
+		    (car sbars)
+		    (/ (or (car fringes) 0) fcw))
+	    yoffset (cadr (window-edges))
+	    top (max 0 (- (* (max (if (and tool-bar-mode
+					   (not (featurep 'gtk))
+					   (eq (frame-first-window)
+					       (selected-window)))
+				      1 0)
+				  (round (/ (1- (/ (+ (1- (window-height))
+						      (* 2 yoffset))
+						   height))
+					    2)))
+			     height)
+			  yoffset))
+	    ls (/ (or line-spacing 0) fch)
+	    height (max 0 (- height ls)))
+      (cond ((>= (- top ls) 1)
+	     (insert
+	      (propertize
+	       " "
+	       'display `(space :width 0 :ascent 100))
+	      "\n"
+	      (propertize
+	       " "
+	       'display `(space :width 0 :height ,(- top ls 1) :ascent 100))
+	      "\n"))
+	    ((> (- top ls) 0)
+	     (insert
+	      (propertize
+	       " "
+	       'display `(space :width 0 :height ,(- top ls) :ascent 100))
+	      "\n")))
+      (if (and (> width 0) (> left 0))
+	  (insert (propertize
+		   " "
+		   'display `(space :width ,left :height ,height :ascent 0)))
+	(setq width (+ width left)))
+      (when (> width 0)
+	(insert (propertize
+		 " "
+		 'display `(space :width ,width :height ,height :ascent 0)
+		 'face `(gnus-splash :stipple ,pixmap))))
+      (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min)))
+      (redraw-frame (selected-frame))
+      (sit-for 0))))
 
 ;;; Image functions.
 
--- a/lisp/gnus/gnus-start.el	Mon Jun 11 00:23:06 2007 +0000
+++ b/lisp/gnus/gnus-start.el	Mon Jun 11 00:56:04 2007 +0000
@@ -758,8 +758,7 @@
       (cond
        ((featurep 'xemacs)
 	(gnus-xmas-splash))
-       ((and window-system
-	     (= (frame-height) (1+ (window-height))))
+       (window-system
 	(gnus-x-splash))))
 
     (let ((level (and (numberp arg) (> arg 0) arg))
--- a/man/ChangeLog	Mon Jun 11 00:23:06 2007 +0000
+++ b/man/ChangeLog	Mon Jun 11 00:56:04 2007 +0000
@@ -1,3 +1,8 @@
+2007-06-06  Andreas Seltenreich  <andreas@gate450.dyndns.org>
+
+	* gnus.texi (Misc Group Stuff, Summary Buffer)
+	(Server Commands, Article Keymap): Fix typo.  s/function/command/.
+
 2007-06-07  Alan Mackenzie  <acm@muc.de>
 
 	* display.texi (Optional Mode Line): Document the new form of
--- a/man/gnus.texi	Mon Jun 11 00:23:06 2007 +0000
+++ b/man/gnus.texi	Mon Jun 11 00:56:04 2007 +0000
@@ -4084,8 +4084,8 @@
 @item v
 @kindex v (Group)
 @cindex keys, reserved for users (Group)
-The key @kbd{v} is reserved for users.  You can bind it key to some
-function or better use it as a prefix key.  For example:
+The key @kbd{v} is reserved for users.  You can bind it to some
+command or better use it as a prefix key.  For example:
 
 @lisp
 (define-key gnus-group-mode-map (kbd "v j d")
@@ -4498,8 +4498,8 @@
 
 @kindex v (Summary)
 @cindex keys, reserved for users (Summary)
-The key @kbd{v} is reserved for users.  You can bind it key to some
-function or better use it as a prefix key.  For example:
+The key @kbd{v} is reserved for users.  You can bind it to some
+command or better use it as a prefix key.  For example:
 @lisp
 (define-key gnus-summary-mode-map (kbd "v -") "LrS") ;; lower subthread
 @end lisp
@@ -11422,8 +11422,8 @@
 
 @kindex v (Article)
 @cindex keys, reserved for users (Article)
-The key @kbd{v} is reserved for users.  You can bind it key to some
-function or better use it as a prefix key.
+The key @kbd{v} is reserved for users.  You can bind it to some
+command or better use it as a prefix key.
 
 A few additional keystrokes are available:
 
@@ -12460,8 +12460,8 @@
 @item v
 @kindex v (Server)
 @cindex keys, reserved for users (Server)
-The key @kbd{v} is reserved for users.  You can bind it key to some
-function or better use it as a prefix key.
+The key @kbd{v} is reserved for users.  You can bind it to some
+command or better use it as a prefix key.
 
 @item a
 @kindex a (Server)