[gnus git] branch master updated: m0-5-8-gea49862 =1= gnus-win.el (gnus-configure-frame): Don't signal an error when jumping to *Server* from a dedicated *Group* window. (gnus-configure-frame): CSE.
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via ea4986256b5af077008d52ee4299847bf28fc7d9 (commit)
from 6828b0fb18eb20a8e19d62b34c269968bf0ec90e (commit)
- Log -----------------------------------------------------------------
commit ea4986256b5af077008d52ee4299847bf28fc7d9
Author: Stefan Monnier <[email protected]>
Date: Sat May 26 12:59:55 2012 +0000
gnus-win.el (gnus-configure-frame): Don't signal an error when jumping to
*Server* from a dedicated *Group* window.
(gnus-configure-frame): CSE.
gnus-registry.el: Minor style cleanup.
(gnus-registry--set/remove-mark): New function, extracted from
gnus-registry-install-shortcuts.
(gnus-registry-install-shortcuts): Use it.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b290f40..536bb2e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2012-05-25 Stefan Monnier <[email protected]>
+
+ * gnus-win.el (gnus-configure-frame): Don't signal an error when
+ jumping to *Server* from a dedicated *Group* window.
+ (gnus-configure-frame): CSE.
+
+ * gnus-registry.el: Minor style cleanup.
+ (gnus-registry--set/remove-mark): New function, extracted from
+ gnus-registry-install-shortcuts.
+ (gnus-registry-install-shortcuts): Use it.
+
2012-05-25 Katsumi Yamaoka <[email protected]>
* nnspool.el (news-path): Use eval-and-compile.
diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index 42762a4..8aecc98 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -90,7 +90,7 @@
(defvar gnus-adaptive-word-syntax-table)
(defvar gnus-registry-dirty t
- "Boolean set to t when the registry is modified")
+ "Boolean set to t when the registry is modified.")
(defgroup gnus-registry nil
"The Gnus registry."
@@ -278,7 +278,7 @@ the Bit Bucket."
:tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
- "*The article registry by Message ID. See `registry-db'")
+ "The article registry by Message ID. See `registry-db'.")
;; top-level registry data management
(defun gnus-registry-remake-db (&optional forsure)
@@ -412,9 +412,9 @@ This is not required after changing `gnus-registry-cache-file'."
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
(defun gnus-registry-split-fancy-with-parent ()
- "Split this message into the same group as its parent. The parent
-is obtained from the registry. This function can be used as an entry
-in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
+ "Split this message into the same group as its parent.
+The parent is obtained from the registry. This function can be used as an
+entry in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
this: (: gnus-registry-split-fancy-with-parent)
This function tracks ALL backends, unlike
@@ -740,7 +740,7 @@ Overrides existing keywords with FORCE set non-nil."
(registry-lookup-secondary-value gnus-registry-db 'keyword keyword))
(defun gnus-registry-register-message-ids ()
- "Register the Message-ID of every article in the group"
+ "Register the Message-ID of every article in the group."
(unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
(dolist (article gnus-newsgroup-articles)
(let* ((id (gnus-registry-fetch-message-id-fast article))
@@ -755,7 +755,7 @@ Overrides existing keywords with FORCE set non-nil."
;; message field fetchers
(defun gnus-registry-fetch-message-id-fast (article)
- "Fetch the Message-ID quickly, using the internal gnus-data-list function"
+ "Fetch the Message-ID quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
@@ -787,7 +787,7 @@ Addresses without a name will say \"noname\"."
nil))
(defun gnus-registry-fetch-simplified-message-subject-fast (article)
- "Fetch the Subject quickly, using the internal gnus-data-list function"
+ "Fetch the Subject quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
@@ -805,7 +805,7 @@ Addresses without a name will say \"noname\"."
(or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) "")))
(defun gnus-registry-fetch-header-fast (article header)
- "Fetch the HEADER quickly, using the internal gnus-data-list function"
+ "Fetch the HEADER quickly, using the internal gnus-data-list function."
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
(gnus-string-remove-all-properties
@@ -825,7 +825,34 @@ FUNCTION should take two parameters, a mark symbol and the cell value."
(when cell-data
(funcall function mark cell-data)))))
-;;; this is ugly code, but I don't know how to do it better
+;; FIXME: Why not merge gnus-registry--set/remove-mark and
+;; gnus-registry-set-article-mark-internal?
+(defun gnus-registry--set/remove-mark (remove mark articles)
+ "Set/remove the MARK over process-marked ARTICLES."
+ ;; If this is called and the user doesn't want the
+ ;; registry enabled, we'll ask anyhow.
+ (unless gnus-registry-install
+ (let ((gnus-registry-install 'ask))
+ (gnus-registry-install-p)))
+
+ ;; Now the user is asked if gnus-registry-install is `ask'.
+ (when (gnus-registry-install-p)
+ (gnus-registry-set-article-mark-internal
+ ;; All this just to get the mark, I must be doing it wrong.
+ mark articles remove t)
+ ;; FIXME: Why do we do the above only here and not directly inside
+ ;; gnus-registry-set-article-mark-internal? I.e. we wouldn't we want to do
+ ;; the things below when gnus-registry-set-article-mark-internal is called
+ ;; from gnus-registry-set-article-mark or
+ ;; gnus-registry-remove-article-mark?
+ (gnus-message 9 "Applying mark %s to %d articles"
+ mark (length articles))
+ (dolist (article articles)
+ (gnus-summary-update-article
+ article
+ (assoc article (gnus-data-list nil))))))
+
+;; This is ugly code, but I don't know how to do it better.
(defun gnus-registry-install-shortcuts ()
"Install the keyboard shortcuts and menus for the registry.
Uses `gnus-registry-marks' to find what shortcuts to install."
@@ -849,56 +876,28 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(dolist (remove '(t nil))
(let* ((variant-name (if remove "remove" "set"))
- (function-name (format function-format variant-name))
- (shortcut (format "%c" data))
- (shortcut (if remove (upcase shortcut) shortcut)))
- (unintern function-name obarray)
- (eval
- `(defun
- ;; function name
- ,(intern function-name)
- ;; parameter definition
- (&rest articles)
- ;; documentation
+ (function-name
+ (intern (format function-format variant-name)))
+ (shortcut (format "%c" (if remove (upcase data) data))))
+ (defalias function-name
+ ;; If it weren't for the function's docstring, we could
+ ;; use a closure, with lexical-let :-(
+ `(lambda (&rest articles)
,(format
"%s the %s mark over process-marked ARTICLES."
(upcase-initials variant-name)
mark)
- ;; interactive definition
(interactive
(gnus-summary-work-articles current-prefix-arg))
- ;; actual code
-
- ;; if this is called and the user doesn't want the
- ;; registry enabled, we'll ask anyhow
- (unless gnus-registry-install
- (let ((gnus-registry-install 'ask))
- (gnus-registry-install-p)))
-
- ;; now the user is asked if gnus-registry-install is 'ask
- (when (gnus-registry-install-p)
- (gnus-registry-set-article-mark-internal
- ;; all this just to get the mark, I must be doing it wrong
- (intern ,(symbol-name mark))
- articles ,remove t)
- (gnus-message
- 9
- "Applying mark %s to %d articles"
- ,(symbol-name mark) (length articles))
- (dolist (article articles)
- (gnus-summary-update-article
- article
- (assoc article (gnus-data-list nil)))))))
- (push (intern function-name) keys-plist)
+ (gnus-registry--set/remove-mark ',mark ',remove articles)))
+ (push function-name keys-plist)
(push shortcut keys-plist)
(push (vector (format "%s %s"
(upcase-initials variant-name)
(symbol-name mark))
- (intern function-name) t)
+ function-name t)
gnus-registry-misc-menus)
- (gnus-message
- 9
- "Defined mark handling function %s"
+ (gnus-message 9 "Defined mark handling function %s"
function-name))))))
(gnus-define-keys-1
'(gnus-registry-mark-map "M" gnus-summary-mark-map)
@@ -919,7 +918,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
- "Show the marks for an article by the :char property"
+ "Show the marks for an article by the :char property."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark)
@@ -932,7 +931,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; use like this:
;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
- "Show the marks for an article by name"
+ "Show the marks for an article by name."
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
(mapconcat (lambda (mark) (symbol-name mark)) marks ",")))
@@ -1074,13 +1073,14 @@ only the last one's marks are returned."
;;;###autoload
(defun gnus-registry-initialize ()
-"Initialize the Gnus registry."
+ "Initialize the Gnus registry."
(interactive)
(gnus-message 5 "Initializing the registry")
(gnus-registry-install-hooks)
(gnus-registry-install-shortcuts)
(gnus-registry-read))
+;; FIXME: Why autoload this function?
;;;###autoload
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
diff --git a/lisp/gnus-win.el b/lisp/gnus-win.el
index 579210c..34c6c0c 100644
--- a/lisp/gnus-win.el
+++ b/lisp/gnus-win.el
@@ -239,7 +239,8 @@ See the Gnus manual for an explanation of the syntax used.")
(defun gnus-configure-frame (split &optional window)
"Split WINDOW according to SPLIT."
- (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window)))
+ (let* ((current-window (or (get-buffer-window (current-buffer))
+ (selected-window)))
(window (or window current-window)))
(select-window window)
;; The SPLIT might be something that is to be evalled to
@@ -269,9 +270,21 @@ See the Gnus manual for an explanation of the syntax used.")
(let ((buf (gnus-get-buffer-create
(gnus-window-to-buffer-helper buffer))))
(when (buffer-name buf)
- (if (eq buf (window-buffer (selected-window)))
- (set-buffer buf)
- (switch-to-buffer buf))))
+ (cond
+ ((eq buf (window-buffer (selected-window)))
+ (set-buffer buf))
+ ((eq t (window-dedicated-p))
+ ;; If the window is hard-dedicated, we have a problem because
+ ;; we just can't do what we're asked. But signalling an error,
+ ;; like `switch-to-buffer' would do, is not an option because
+ ;; it would prevent things like "^" (to jump to the *Servers*)
+ ;; in a dedicated *Group*.
+ ;; FIXME: Maybe a better/additional fix would be to change
+ ;; gnus-configure-windows so that when called
+ ;; from a hard-dedicated frame, it creates (and
+ ;; configures) a new frame, leaving the dedicated frame alone.
+ (pop-to-buffer buf))
+ (t (switch-to-buffer buf)))))
(when (memq 'frame-focus split)
(setq gnus-window-frame-focus window))
;; We return the window if it has the `point' spec.
@@ -340,9 +353,9 @@ See the Gnus manual for an explanation of the syntax used.")
;; fashion.
(setq comp-subs (nreverse comp-subs))
(while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
(setq new-win
+ (if (null (cdr comp-subs))
+ window
(split-window window (cadar comp-subs)
(eq type 'horizontal))))
(setq result (or (gnus-configure-frame
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 11 ++++
lisp/gnus-registry.el | 136 ++++++++++++++++++++++++------------------------
lisp/gnus-win.el | 27 +++++++---
3 files changed, 99 insertions(+), 75 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project