;;; Code:
-(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-load)
+(require 'gnus-sum)
;;;
;;; gnus-pick-mode
(defvar gnus-pick-mode-hook nil
"Hook run in summary pick mode buffers.")
+(defvar gnus-mark-unpicked-articles-as-read nil
+ "*If non-nil, mark all unpicked articles as read.")
+
+(defvar gnus-summary-pick-line-format
+ "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in pick buffers.
+It accepts the same format specs that `gnus-summary-line-format' does.")
+
;;; Internal variables.
(defvar gnus-pick-mode-map nil)
gnus-pick-mode-map
"t" gnus-uu-mark-thread
"T" gnus-uu-unmark-thread
- " " gnus-summary-mark-as-processable
+ " " gnus-pick-next-page
"u" gnus-summary-unmark-as-processable
"U" gnus-summary-unmark-all-processable
"v" gnus-uu-mark-over
"E" gnus-uu-mark-by-regexp
"b" gnus-uu-mark-buffer
"B" gnus-uu-unmark-buffer
+ "." gnus-pick-article
+ gnus-mouse-2 gnus-pick-pick-article
"\r" gnus-pick-start-reading))
(defun gnus-pick-make-menu-bar ()
["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
(defun gnus-pick-mode (&optional arg)
- "Minor mode for provind a pick-and-read interface in Gnus summary buffers."
+ "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
+
+\\{gnus-pick-mode-map}"
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
(make-local-variable 'gnus-pick-mode)
;; Make sure that we don't select any articles upon group entry.
(make-local-variable 'gnus-auto-select-first)
(setq gnus-auto-select-first nil)
+ ;; Change line format.
+ (setq gnus-summary-line-format gnus-summary-pick-line-format)
+ (setq gnus-summary-line-format-spec nil)
+ (gnus-update-format-specifications nil 'summary)
+ (gnus-update-summary-mark-positions)
;; Set up the menu.
(when (and menu-bar-mode
(gnus-visual-p 'pick-menu 'menu))
(gnus-pick-make-menu-bar))
(unless (assq 'gnus-pick-mode minor-mode-alist)
(push '(gnus-pick-mode " Pick") minor-mode-alist))
- (unless (assq 'gnus-topic-mode minor-mode-map-alist)
- (push (cons 'gnus-topic-mode gnus-pick-mode-map)
+ (unless (assq 'gnus-pick-mode minor-mode-map-alist)
+ (push (cons 'gnus-pick-mode gnus-pick-mode-map)
minor-mode-map-alist))
(run-hooks 'gnus-pick-mode-hook))))
+(defvar gnus-pick-line-number 1)
+(defun gnus-pick-line-number ()
+ "Return the current line number."
+ (if (bobp)
+ (setq gnus-pick-line-number 1)
+ (incf gnus-pick-line-number)))
+
(defun gnus-pick-start-reading (&optional catch-up)
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
(unless gnus-newsgroup-processable
(error "No articles have been picked"))
(gnus-summary-limit-to-articles nil)
- (when catch-up
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
(gnus-summary-limit-mark-excluded-as-read))
- (gnus-configure-windows (if gnus-pick-display-summary 'summary 'pick) t))
+ (gnus-summary-first-unread-article)
+ (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
+
+(defun gnus-pick-article (&optional arg)
+ "Pick the article on the current line.
+If ARG, pick the article on that line instead."
+ (interactive "P")
+ (when arg
+ (let (pos)
+ (save-excursion
+ (goto-char (point-min))
+ (when (zerop (forward-line (1- (prefix-numeric-value arg))))
+ (setq pos (point))))
+ (if (not pos)
+ (gnus-error 2 "No such line: %s" arg)
+ (goto-char pos))))
+ (gnus-summary-mark-as-processable 1))
+
+(defun gnus-mouse-pick-article (e)
+ (interactive "e")
+ (mouse-set-point e)
+ (save-excursion
+ (gnus-summary-mark-as-processable 1)))
+(defun gnus-pick-next-page ()
+ "Go to the next page. If at the end of the buffer, start reading articles."
+ (interactive)
+ (condition-case ()
+ (scroll-up)
+ (gnus-pick-start-reading)))
;;;
;;; gnus-binary-mode
(gnus-binary-make-menu-bar))
(unless (assq 'gnus-binary-mode minor-mode-alist)
(push '(gnus-binary-mode " Binary") minor-mode-alist))
- (unless (assq 'gnus-topic-mode minor-mode-map-alist)
- (push (cons 'gnus-topic-mode gnus-binary-mode-map)
+ (unless (assq 'gnus-binary-mode minor-mode-map-alist)
+ (push (cons 'gnus-binary-mode gnus-binary-mode-map)
minor-mode-map-alist))
(run-hooks 'gnus-binary-mode-hook))))
(defvar gnus-selected-tree-face 'modeline
"*Face used for highlighting selected articles in the thread tree.")
-(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) (?\{ . ?\}))
+(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
+ (?\{ . ?\}) (?< . ?>))
"Brackets used in tree nodes.")
(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
(defvar gnus-tree-mode-hook nil
"*Hook run in tree mode buffers.")
-(defvar gnus-tree-buffer "*Tree*"
- "Buffer where Gnus thread trees are displayed.")
-
;;; Internal variables.
(defvar gnus-tree-line-format-alist
gnus-tree-mode-map
"\r" gnus-tree-select-article
gnus-mouse-2 gnus-tree-pick-article
- "\C-?" gnus-tree-read-summary-keys)
+ "\C-?" gnus-tree-read-summary-keys
+
+ "\C-c\C-i" gnus-info-find-node)
(substitute-key-definition
'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
(defun gnus-tree-make-menu-bar ()
- )
+ (unless (boundp 'gnus-tree-menu)
+ (easy-menu-define
+ gnus-tree-menu gnus-tree-mode-map ""
+ '("Tree"
+ ["Select article" gnus-tree-select-article t]))))
(defun gnus-tree-mode ()
"Major mode for displaying thread trees."
(defun gnus-tree-recenter ()
"Center point in the tree window."
(let ((selected (selected-window))
- (cur-window (get-buffer-window (current-buffer) t)))
- (when cur-window
- (select-window cur-window)
+ (tree-window (get-buffer-window gnus-tree-buffer t)))
+ (when tree-window
+ (select-window tree-window)
(when gnus-selected-tree-overlay
(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
(let* ((top (cond ((< (window-height) 4) 0)
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- cur-window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ tree-window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
(select-window selected))))
(defun gnus-get-tree-buffer ()
(defun gnus-tree-minimize ()
(when (and gnus-tree-minimize-window
(not (one-window-p)))
- (let* ((window-min-height 2)
- (height (count-lines (point-min) (point-max)))
- (min (max (1- window-min-height) height))
- (tot (if (numberp gnus-tree-minimize-window)
- (min gnus-tree-minimize-window min)
- min))
- (win (get-buffer-window (current-buffer)))
- (wh (and win (1- (window-height win)))))
- (when (and win
- (not (eq tot wh)))
- (let ((selected (selected-window)))
- (select-window win)
- (enlarge-window (- tot wh))
- (select-window selected))))))
+ (let ((windows 0)
+ tot-win-height)
+ (walk-windows (lambda (window) (incf windows)))
+ (setq tot-win-height
+ (- (frame-height)
+ (* window-min-height (1- windows))
+ 2))
+ (let* ((window-min-height 2)
+ (height (count-lines (point-min) (point-max)))
+ (min (max (1- window-min-height) height))
+ (tot (if (numberp gnus-tree-minimize-window)
+ (min gnus-tree-minimize-window min)
+ min))
+ (win (get-buffer-window (current-buffer)))
+ (wh (and win (1- (window-height win)))))
+ (setq tot (min tot tot-win-height))
+ (when (and win
+ (not (eq tot wh)))
+ (let ((selected (selected-window)))
+ (select-window win)
+ (enlarge-window (- tot wh))
+ (select-window selected)))))))
;;; Generating the tree.
-(defun gnus-tree-node-insert (header sparse)
+(defun gnus-tree-node-insert (header sparse &optional adopted)
(let* ((dummy (stringp header))
(header (if (vectorp header) header
(progn
(cond ((memq gnus-tmp-number sparse)
(caadr gnus-tree-brackets))
(dummy (caaddr gnus-tree-brackets))
+ (adopted (car (nth 3 gnus-tree-brackets)))
(t (caar gnus-tree-brackets))))
(gnus-tmp-close-bracket
(cond ((memq gnus-tmp-number sparse)
(cdadr gnus-tree-brackets))
+ (adopted (cdr (nth 3 gnus-tree-brackets)))
(dummy
(cdaddr gnus-tree-brackets))
(t (cdar gnus-tree-brackets))))
(buffer-read-only nil)
beg end)
- (add-text-properties
+ (gnus-add-text-properties
(setq beg (point))
(setq end (progn (eval gnus-tree-line-format-spec) (point)))
(list 'gnus-number gnus-tmp-number))
(not (eval (caar list))))
(setq list (cdr list)))))
(unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (put-text-property
+ (gnus-put-text-property
beg end 'face
(if (boundp face) (symbol-value face) face)))))
(gnus-tree-minimize)
(gnus-tree-recenter)
(let ((selected (selected-window)))
- (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
- (gnus-horizontal-recenter)
- (select-window selected)))))
+ (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected))))))
-(defun gnus-generate-horizontal-tree (thread level &optional dummyp)
+(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
"Generate a horizontal tree."
(let* ((dummy (stringp (car thread)))
(do (or dummy
(goto-char beg)))
(setq dummyp nil)
;; Insert the article node.
- (gnus-tree-node-insert (pop thread) gnus-tmp-sparse))
+ (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
(if (null thread)
;; End of the thread, so we go to the next line.
(unless (bolp)
(while thread
(gnus-generate-horizontal-tree
(pop thread) (if do (1+ level) level)
- (or dummyp dummy))))))
+ (or dummyp dummy) dummy)))))
(defsubst gnus-tree-indent-vertical ()
(let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
(insert "\n")))
(end-of-line))
-(defun gnus-generate-vertical-tree (thread level &optional dummyp)
+(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
"Generate a vertical tree."
(let* ((dummy (stringp (car thread)))
(do (or dummy
(memq (mail-header-number (car thread)) gnus-tmp-limit)))
- col beg)
+ beg)
(if (not do)
;; We don't want this article.
(setq thread (cdr thread))
(setq dummyp nil)
;; Insert the article node.
(gnus-tree-indent-vertical)
- (gnus-tree-node-insert (pop thread) gnus-tmp-sparse)
+ (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
(gnus-tree-forward-line 1))
(if (null thread)
;; End of the thread, so we go to the next line.
(while thread
(gnus-generate-vertical-tree
(pop thread) (if do (1+ level) level)
- (or dummyp dummy))))))
+ (or dummyp dummy) dummy)))))
;;; Interface functions.
(defun gnus-possibly-generate-tree (article &optional force)
"Generate the thread tree for ARTICLE if it isn't displayed already."
- (save-excursion
- (let ((top (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-cut-thread
- (gnus-remove-thread
- (mail-header-id (gnus-summary-article-header article)) t))))
- (gnus-tmp-limit gnus-newsgroup-limit)
- (gnus-tmp-sparse gnus-newsgroup-sparse))
- (when (or force
- (not (eq top gnus-tree-displayed-thread)))
- (gnus-generate-tree top)
- (setq gnus-tree-displayed-thread top)))))
+ (when (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (and gnus-use-trees
+ gnus-show-threads
+ (vectorp (gnus-summary-article-header article))))
+ (save-excursion
+ (let ((top (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-cut-thread
+ (gnus-remove-thread
+ (mail-header-id
+ (gnus-summary-article-header article)) t))))
+ (gnus-tmp-limit gnus-newsgroup-limit)
+ (gnus-tmp-sparse gnus-newsgroup-sparse))
+ (when (or force
+ (not (eq top gnus-tree-displayed-thread)))
+ (gnus-generate-tree top)
+ (setq gnus-tree-displayed-thread top))))))
(defun gnus-tree-open (group)
(gnus-get-tree-buffer))
(gnus-tree-minimize)
(gnus-tree-recenter)
(let ((selected (selected-window)))
- (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
- (gnus-horizontal-recenter)
- (select-window selected)))
+ (when (get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected))))
;; If we remove this save-excursion, it updates the wrong mode lines?!?
(save-excursion
(set-buffer gnus-tree-buffer)
(set-buffer (gnus-get-tree-buffer))
(let (region)
(when (setq region (gnus-tree-article-region article))
- (put-text-property (car region) (cdr region) 'face face)
+ (gnus-put-text-property (car region) (cdr region) 'face face)
(set-window-point
(get-buffer-window (current-buffer) t) (cdr region))))))
+;;;
+;;; gnus-carpal
+;;;
+
+(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)
+ ("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)
+ ("mail" . gnus-summary-mail)
+ ("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 "-- ")
+ (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 (current-buffer))
+ (setq buffer-read-only t)
+ (make-local-variable 'gnus-carpal-attached-buffer)
+ (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 (get-buffer-create buffer))
+ (gnus-carpal-mode)
+ (setq gnus-carpal-attached-buffer
+ (intern (format "gnus-%s-buffer" type)))
+ (gnus-add-current-to-buffer-list)
+ (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))
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / gnus / blobdiff