diff options
author | Miles Bader <miles@gnu.org> | 2007-06-11 00:56:04 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2007-06-11 00:56:04 +0000 |
commit | 2d715b39ea1c89066f469405d065dd1a6631d28e (patch) | |
tree | 984af0d421a8c093dadd7e4aaacecc2b8246ba76 /lisp | |
parent | 60b4b29868b65a17da34328f69947727264cfc31 (diff) | |
download | emacs-2d715b39ea1c89066f469405d065dd1a6631d28e.tar.gz emacs-2d715b39ea1c89066f469405d065dd1a6631d28e.tar.bz2 emacs-2d715b39ea1c89066f469405d065dd1a6631d28e.zip |
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
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/gnus/ChangeLog | 11 | ||||
-rw-r--r-- | lisp/gnus/gnus-art.el | 8 | ||||
-rw-r--r-- | lisp/gnus/gnus-ems.el | 123 | ||||
-rw-r--r-- | lisp/gnus/gnus-start.el | 3 |
4 files changed, 105 insertions, 40 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 4958577588e..17ef7f996b3 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -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. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index eb31ae415cc..90af0740318 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5607,7 +5607,7 @@ not have a face in `gnus-article-boring-faces'." "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 @@ not have a face in `gnus-article-boring-faces'." (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 @@ not have a face in `gnus-article-boring-faces'." (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 diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index 60e66adc98b..4400b81f041 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -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. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 9fbab8b340b..d906cec6c6a 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -758,8 +758,7 @@ prompt the user for the name of an NNTP server to use." (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)) |