;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Code:
-(require 'gnus-load)
+(require 'gnus)
(require 'gnus-sum)
;;;
"." gnus-pick-article
gnus-down-mouse-2 gnus-pick-mouse-pick-region
;;gnus-mouse-2 gnus-pick-mouse-pick
+ "X" gnus-pick-start-reading
"\r" gnus-pick-start-reading))
(defun gnus-pick-make-menu-bar ()
\\{gnus-pick-mode-map}"
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
- (when (set (make-local-variable 'gnus-pick-mode)
- (if (null arg) (not gnus-pick-mode)
- (> (prefix-numeric-value arg) 0)))
+ (if (not (set (make-local-variable 'gnus-pick-mode)
+ (if (null arg) (not gnus-pick-mode)
+ (> (prefix-numeric-value arg) 0))))
+ (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
;; Make sure that we don't select any articles upon group entry.
(set (make-local-variable 'gnus-auto-select-first) nil)
;; Change line format.
(setq gnus-summary-line-format-spec nil)
(gnus-update-format-specifications nil 'summary)
(gnus-update-summary-mark-positions)
+ (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+ (set (make-local-variable 'gnus-summary-goto-unread) 'never)
;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'pick-menu 'menu))
+ (when (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))
minor-mode-map-alist))
(run-hooks 'gnus-pick-mode-hook))))
+(defun gnus-pick-setup-message ()
+ "Make Message do the right thing on exit."
+ (when (and (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-pick-mode))
+ (message-add-action
+ '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill)))
+
(defvar gnus-pick-line-number 1)
(defun gnus-pick-line-number ()
"Return the current line number."
(gnus-summary-limit-to-articles nil)
(when (or catch-up gnus-mark-unpicked-articles-as-read)
(gnus-summary-limit-mark-excluded-as-read))
- (gnus-summary-first-unread-article)
- (gnus-configure-windows
+ (gnus-summary-first-article)
+ (gnus-configure-windows
(if gnus-pick-display-summary 'article 'pick) t))
(if gnus-pick-elegant-flow
- (gnus-summary-next-group)
+ (progn
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
+ (gnus-summary-limit-mark-excluded-as-read))
+ (if (gnus-group-quit-config gnus-newsgroup-name)
+ (gnus-summary-exit)
+ (gnus-summary-next-group)))
(error "No articles have been picked"))))
(defun gnus-pick-article (&optional arg)
(mouse-set-point start-event)
;; In case the down click is in the middle of some intangible text,
;; use the end of that text, and put it in START-POINT.
- (if (< (point) start-point)
- (goto-char start-point))
+ (when (< (point) start-point)
+ (goto-char start-point))
(gnus-pick-article)
(setq start-point (point))
;; end-of-range is used only in the single-click case.
;; (but not outside the window where the drag started).
(let (event end end-point last-end-point (end-of-range (point)))
(track-mouse
- (while (progn
- (setq event (read-event))
- (or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
- (if (eq (car-safe event) 'switch-frame)
- nil
- (setq end (event-end event)
- end-point (posn-point end))
- (if end-point
- (setq last-end-point end-point))
-
- (cond
- ;; Are we moving within the original window?
- ((and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- ;; Go to START-POINT first, so that when we move to END-POINT,
- ;; if it's in the middle of intangible text,
- ;; point jumps in the direction away from START-POINT.
- (goto-char start-point)
- (goto-char end-point)
- (gnus-pick-article)
- ;; In case the user moved his mouse really fast, pick
- ;; articles on the line between this one and the last one.
- (let* ((this-line (1+ (count-lines 1 end-point)))
- (min-line (min this-line start-line))
- (max-line (max this-line start-line)))
- (while (< min-line max-line)
- (goto-line min-line)
- (gnus-pick-article)
- (setq min-line (1+ min-line)))
- (setq start-line this-line))
- (if (zerop (% click-count 3))
- (setq end-of-range (point))))
- (t
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window
- (1+ (- mouse-row bottom)))))))))))
- (if (consp event)
- (let ((fun (key-binding (vector (car event)))))
- ;; Run the binding of the terminating up-event, if possible.
- ;; In the case of a multiple click, it gives the wrong results,
- ;; because it would fail to set up a region.
- (if nil ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
- ;; In this case, we can just let the up-event execute normally.
- (let ((end (event-end event)))
- ;; Set the position in the event before we replay it,
- ;; because otherwise it may have a position in the wrong
- ;; buffer.
- (setcar (cdr end) end-of-range)
- ;; Delete the overlay before calling the function,
- ;; because delete-overlay increases buffer-modified-tick.
- (setq unread-command-events
- (cons event unread-command-events)))))))))
+ (while (progn
+ (setq event (read-event))
+ (or (mouse-movement-p event)
+ (eq (car-safe event) 'switch-frame)))
+ (if (eq (car-safe event) 'switch-frame)
+ nil
+ (setq end (event-end event)
+ end-point (posn-point end))
+ (when end-point
+ (setq last-end-point end-point))
+
+ (cond
+ ;; Are we moving within the original window?
+ ((and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ ;; Go to START-POINT first, so that when we move to END-POINT,
+ ;; if it's in the middle of intangible text,
+ ;; point jumps in the direction away from START-POINT.
+ (goto-char start-point)
+ (goto-char end-point)
+ (gnus-pick-article)
+ ;; In case the user moved his mouse really fast, pick
+ ;; articles on the line between this one and the last one.
+ (let* ((this-line (1+ (count-lines 1 end-point)))
+ (min-line (min this-line start-line))
+ (max-line (max this-line start-line)))
+ (while (< min-line max-line)
+ (goto-line min-line)
+ (gnus-pick-article)
+ (setq min-line (1+ min-line)))
+ (setq start-line this-line))
+ (when (zerop (% click-count 3))
+ (setq end-of-range (point))))
+ (t
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window
+ (1+ (- mouse-row bottom)))))))))))
+ (when (consp event)
+ (let ((fun (key-binding (vector (car event)))))
+ ;; Run the binding of the terminating up-event, if possible.
+ ;; In the case of a multiple click, it gives the wrong results,
+ ;; because it would fail to set up a region.
+ (when nil
+ ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
+ (let ((end (event-end event)))
+ ;; Set the position in the event before we replay it,
+ ;; because otherwise it may have a position in the wrong
+ ;; buffer.
+ (setcar (cdr end) end-of-range)
+ ;; Delete the overlay before calling the function,
+ ;; because delete-overlay increases buffer-modified-tick.
+ (push event unread-command-events))))))))
(defun gnus-pick-next-page ()
"Go to the next page. If at the end of the buffer, start reading articles."
(interactive)
- (condition-case nil
- (scroll-up)
- (end-of-buffer (gnus-pick-start-reading))))
+ (let ((scroll-in-place nil))
+ (condition-case nil
+ (scroll-up)
+ (end-of-buffer (gnus-pick-start-reading)))))
;;;
;;; gnus-binary-mode
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
(make-local-variable 'gnus-binary-mode)
- (setq gnus-binary-mode
+ (setq gnus-binary-mode
(if (null arg) (not gnus-binary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-binary-mode
(make-local-variable 'gnus-summary-display-article-function)
(setq gnus-summary-display-article-function 'gnus-binary-display-article)
;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'binary-menu 'menu))
+ (when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar))
(unless (assq 'gnus-binary-mode minor-mode-alist)
(push '(gnus-binary-mode " Binary") minor-mode-alist))
;;; Internal variables.
-(defvar gnus-tree-line-format-alist
+(defvar gnus-tree-line-format-alist
`((?n gnus-tmp-name ?s)
(?f gnus-tmp-from ?s)
(?N gnus-tmp-number ?d)
(defun gnus-tree-mode ()
"Major mode for displaying thread trees."
(interactive)
- (setq gnus-tree-mode-line-format-spec
- (gnus-parse-format gnus-tree-mode-line-format
+ (setq gnus-tree-mode-line-format-spec
+ (gnus-parse-format gnus-tree-mode-line-format
gnus-summary-mode-line-format-alist))
- (setq gnus-tree-line-format-spec
- (gnus-parse-format gnus-tree-line-format
+ (setq gnus-tree-line-format-spec
+ (gnus-parse-format gnus-tree-line-format
gnus-tree-line-format-alist t))
- (when (and menu-bar-mode
- (gnus-visual-p 'tree-menu 'menu))
+ (when (gnus-visual-p 'tree-menu 'menu)
(gnus-tree-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
- (t 2)))
+ (t 2)))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- tree-window (min bottom (save-excursion
+ tree-window (min bottom (save-excursion
(forward-line (- top)) (point)))))
(select-window selected))))
(let ((windows 0)
tot-win-height)
(walk-windows (lambda (window) (incf windows)))
- (setq tot-win-height
- (- (frame-height)
+ (setq tot-win-height
+ (- (frame-height)
(* window-min-height (1- windows))
2))
(let* ((window-min-height 2)
(when (and win
(not (eq tot wh)))
(let ((selected (selected-window)))
- (select-window win)
- (enlarge-window (- tot wh))
- (select-window selected)))))))
+ (when (ignore-errors (select-window win))
+ (enlarge-window (- tot wh))
+ (select-window selected))))))))
;;; Generating the tree.
"***")
(t gnus-tmp-from)))
(gnus-tmp-open-bracket
- (cond ((memq gnus-tmp-number sparse)
+ (cond ((memq gnus-tmp-number sparse)
(caadr gnus-tree-brackets))
(dummy (caaddr gnus-tree-brackets))
(adopted (car (nth 3 gnus-tree-brackets)))
(not (eval (caar list))))
(setq list (cdr list)))))
(unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
+ (gnus-put-text-property
+ beg end 'face
(if (boundp face) (symbol-value face) face)))))
(defun gnus-tree-indent (level)
;; Recurse downwards in all children of this article.
(while thread
(gnus-generate-horizontal-tree
- (pop thread) (if do (1+ level) level)
+ (pop thread) (if do (1+ level) level)
(or dummyp dummy) dummy)))))
(defsubst gnus-tree-indent-vertical ()
- (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
+ (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
(- (point) (gnus-point-at-bol)))))
(when (> len 0)
(insert (make-string len ? )))))
"Generate a vertical tree."
(let* ((dummy (stringp (car thread)))
(do (or dummy
- (memq (mail-header-number (car thread)) gnus-tmp-limit)))
+ (and (car thread)
+ (memq (mail-header-number (car thread))
+ gnus-tmp-limit))))
beg)
(if (not do)
;; We don't want this article.
(setq beg (point))
;; Draw "-" lines leftwards.
(while (progn
- (forward-char -2)
+ (unless (bolp)
+ (forward-char -2))
(= (following-char) ? ))
(delete-char 1)
(insert (car gnus-tree-parent-child-edges)))
;; Recurse downwards in all children of this article.
(while thread
(gnus-generate-vertical-tree
- (pop thread) (if do (1+ level) level)
+ (pop thread) (if do (1+ level) level)
(or dummyp dummy) dummy)))))
;;; Interface functions.
(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-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
(setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
'face gnus-selected-tree-face))
;; Move the overlay to the article.
- (gnus-move-overlay
+ (gnus-move-overlay
gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
(gnus-tree-minimize)
(gnus-tree-recenter)
(let (region)
(when (setq region (gnus-tree-article-region article))
(gnus-put-text-property (car region) (cdr region) 'face face)
- (set-window-point
+ (set-window-point
(get-buffer-window (current-buffer) t) (cdr region))))))
;;;
("exit" . gnus-group-exit)))
(defvar gnus-carpal-summary-buffer-buttons
- '("mark"
+ '("mark"
("read" . gnus-summary-mark-as-read-forward)
("tick" . gnus-summary-tick-article-forward)
("clear" . gnus-summary-clear-mark-forward)
("exit" . gnus-summary-exit)
("fed-up" . gnus-summary-catchup-and-goto-next-group)))
-(defvar gnus-carpal-server-buffer-buttons
+(defvar gnus-carpal-server-buffer-buttons
'(("add" . gnus-server-add-server)
("browse" . gnus-server-browse-server)
("list" . gnus-server-list-servers)
(save-excursion
(set-buffer (get-buffer-create buffer))
(gnus-carpal-mode)
- (setq gnus-carpal-attached-buffer
+ (setq gnus-carpal-attached-buffer
(intern (format "gnus-%s-buffer" type)))
(gnus-add-current-to-buffer-list)
- (let ((buttons (symbol-value
+ (let ((buttons (symbol-value
(intern (format "gnus-carpal-%s-buffer-buttons"
type))))
(buffer-read-only nil)
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))
+ (set-window-point (get-buffer-window (current-buffer))
(point-min)))))))
(defun gnus-carpal-select ()