+(defvar gnus-carpal-group-buffer-buttons
+ '(("next" . gnus-group-next-unread-group)
+ ("prev" . gnus-group-prev-unread-group)
+ ("read" . gnus-group-read-group)
+ ("select" . gnus-group-select-group)
+ ("catch-up" . gnus-group-catchup-current)
+ ("new-news" . gnus-group-get-new-news-this-group)
+ ("toggle-sub" . gnus-group-unsubscribe-current-group)
+ ("subscribe" . gnus-group-unsubscribe-group)
+ ("kill" . gnus-group-kill-group)
+ ("yank" . gnus-group-yank-group)
+ ("describe" . gnus-group-describe-group)
+ "list"
+ ("subscribed" . gnus-group-list-groups)
+ ("all" . gnus-group-list-all-groups)
+ ("killed" . gnus-group-list-killed)
+ ("zombies" . gnus-group-list-zombies)
+ ("matching" . gnus-group-list-matching)
+ ("post" . gnus-group-post-news)
+ ("mail" . gnus-group-mail)
+ ("local" . (lambda () (interactive) (gnus-group-news 0)))
+ ("rescan" . gnus-group-get-new-news)
+ ("browse-foreign" . gnus-group-browse-foreign)
+ ("exit" . gnus-group-exit)))
+
+(defvar gnus-carpal-summary-buffer-buttons
+ '("mark"
+ ("read" . gnus-summary-mark-as-read-forward)
+ ("tick" . gnus-summary-tick-article-forward)
+ ("clear" . gnus-summary-clear-mark-forward)
+ ("expirable" . gnus-summary-mark-as-expirable)
+ "move"
+ ("scroll" . gnus-summary-next-page)
+ ("next-unread" . gnus-summary-next-unread-article)
+ ("prev-unread" . gnus-summary-prev-unread-article)
+ ("first" . gnus-summary-first-unread-article)
+ ("best" . gnus-summary-best-unread-article)
+ "article"
+ ("headers" . gnus-summary-toggle-header)
+ ("uudecode" . gnus-uu-decode-uu)
+ ("enter-digest" . gnus-summary-enter-digest-group)
+ ("fetch-parent" . gnus-summary-refer-parent-article)
+ "mail"
+ ("move" . gnus-summary-move-article)
+ ("copy" . gnus-summary-copy-article)
+ ("respool" . gnus-summary-respool-article)
+ "threads"
+ ("lower" . gnus-summary-lower-thread)
+ ("kill" . gnus-summary-kill-thread)
+ "post"
+ ("post" . gnus-summary-post-news)
+ ("local" . gnus-summary-news-other-window)
+ ("mail" . gnus-summary-mail-other-window)
+ ("followup" . gnus-summary-followup-with-original)
+ ("reply" . gnus-summary-reply-with-original)
+ ("cancel" . gnus-summary-cancel-article)
+ "misc"
+ ("exit" . gnus-summary-exit)
+ ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
+
+(defvar gnus-carpal-server-buffer-buttons
+ '(("add" . gnus-server-add-server)
+ ("browse" . gnus-server-browse-server)
+ ("list" . gnus-server-list-servers)
+ ("kill" . gnus-server-kill-server)
+ ("yank" . gnus-server-yank-server)
+ ("copy" . gnus-server-copy-server)
+ ("exit" . gnus-server-exit)))
+
+(defvar gnus-carpal-browse-buffer-buttons
+ '(("subscribe" . gnus-browse-unsubscribe-current-group)
+ ("exit" . gnus-browse-exit)))
+
+(defvar gnus-carpal-group-buffer "*Carpal Group*")
+(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
+(defvar gnus-carpal-server-buffer "*Carpal Server*")
+(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
+
+(defvar gnus-carpal-attached-buffer nil)
+
+(defvar gnus-carpal-mode-hook nil
+ "*Hook run in carpal mode buffers.")
+
+(defvar gnus-carpal-button-face 'bold
+ "*Face used on carpal buttons.")
+
+(defvar gnus-carpal-header-face 'bold-italic
+ "*Face used on carpal buffer headers.")
+
+(defvar gnus-carpal-mode-map nil)
+(put 'gnus-carpal-mode 'mode-class 'special)
+
+(if gnus-carpal-mode-map
+ nil
+ (setq gnus-carpal-mode-map (make-keymap))
+ (suppress-keymap gnus-carpal-mode-map)
+ (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
+
+(defun gnus-carpal-mode ()
+ "Major mode for clicking buttons.
+
+All normal editing commands are switched off.
+\\<gnus-carpal-mode-map>
+The following commands are available:
+
+\\{gnus-carpal-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq mode-line-modified (cdr gnus-mode-line-modified))
+ (setq major-mode 'gnus-carpal-mode)
+ (setq mode-name "Gnus Carpal")
+ (setq mode-line-process nil)
+ (use-local-map gnus-carpal-mode-map)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (make-local-variable 'gnus-carpal-attached-buffer)
+ (gnus-run-hooks 'gnus-carpal-mode-hook))
+
+(defun gnus-carpal-setup-buffer (type)
+ (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
+ (if (get-buffer buffer)
+ ()
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create buffer))
+ (gnus-carpal-mode)
+ (setq gnus-carpal-attached-buffer
+ (intern (format "gnus-%s-buffer" type)))
+ (let ((buttons (symbol-value
+ (intern (format "gnus-carpal-%s-buffer-buttons"
+ type))))
+ (buffer-read-only nil)
+ button)
+ (while buttons
+ (setq button (car buttons)
+ buttons (cdr buttons))
+ (if (stringp button)
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert button) (point) (insert " "))
+ (list 'face gnus-carpal-header-face))
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert (car button)) (point) (insert " "))
+ (list 'gnus-callback (cdr button)
+ 'face gnus-carpal-button-face
+ gnus-mouse-face-prop 'highlight))))
+ (let ((fill-column (- (window-width) 2)))
+ (fill-region (point-min) (point-max)))
+ (set-window-point (get-buffer-window (current-buffer))
+ (point-min)))))))
+
+(defun gnus-carpal-select ()
+ "Select the button under point."
+ (interactive)
+ (let ((func (get-text-property (point) 'gnus-callback)))
+ (if (null func)
+ ()
+ (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
+ (call-interactively func))))
+
+(defun gnus-carpal-mouse-select (event)
+ "Select the button under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point event)
+ (gnus-carpal-select))