*** empty log message ***
[gnus] / lisp / gnus-salt.el
index af64093..f67430c 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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>
 
@@ -24,7 +24,7 @@
 
 ;;; Code:
 
-(require 'gnus-load)
+(require 'gnus)
 (require 'gnus-sum)
 
 ;;;
@@ -75,6 +75,7 @@ It accepts the same format specs that `gnus-summary-line-format' does.")
    "." 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 ()
@@ -103,9 +104,10 @@ It accepts the same format specs that `gnus-summary-line-format' does.")
 \\{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.
@@ -113,9 +115,10 @@ It accepts the same format specs that `gnus-summary-line-format' does.")
       (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))
@@ -124,6 +127,15 @@ It accepts the same format specs that `gnus-summary-line-format' does.")
              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."
@@ -140,11 +152,16 @@ If given a prefix, mark all unpicked articles as read."
         (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)
@@ -191,8 +208,8 @@ This must be bound to a button-down mouse event."
     (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.
@@ -200,71 +217,72 @@ This must be bound to a button-down mouse event."
     ;; (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
@@ -297,7 +315,7 @@ This must be bound to a button-down mouse event."
   (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
@@ -307,8 +325,7 @@ This must be bound to a button-down mouse event."
       (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))
@@ -364,7 +381,7 @@ Two predefined functions are available:
 
 ;;; 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)
@@ -409,14 +426,13 @@ Two predefined functions are available:
 (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)
@@ -484,7 +500,7 @@ Two predefined functions are available:
        (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))
@@ -493,7 +509,7 @@ Two predefined functions are available:
        ;; 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))))
 
@@ -512,8 +528,8 @@ Two predefined functions are available:
     (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)
@@ -528,9 +544,9 @@ Two predefined functions are available:
        (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.
 
@@ -561,7 +577,7 @@ Two predefined functions are available:
            "***")
           (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)))
@@ -597,8 +613,8 @@ Two predefined functions are available:
                    (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)
@@ -661,11 +677,11 @@ Two predefined functions are available:
       ;; 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 ? )))))
@@ -681,7 +697,9 @@ Two predefined functions are available:
   "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.
@@ -702,7 +720,8 @@ Two predefined functions are available:
          (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)))
@@ -722,7 +741,7 @@ Two predefined functions are available:
       ;; 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.
@@ -738,9 +757,10 @@ Two predefined functions are available:
       (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
@@ -768,7 +788,7 @@ Two predefined functions are available:
         (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)
@@ -789,7 +809,7 @@ Two predefined functions are available:
     (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))))))
 
 ;;;
@@ -821,7 +841,7 @@ Two predefined functions are available:
     ("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)
@@ -854,7 +874,7 @@ Two predefined functions are available:
     ("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)
@@ -921,10 +941,10 @@ The following commands are available:
       (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)
@@ -945,7 +965,7 @@ The following commands are available:
                     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 ()