xemacs-beta: lisp/gnus/gnus-salt.el comparison

comparison lisp/gnus/gnus-salt.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30

author	cvs
date	Mon, 13 Aug 2007 09:02:59 +0200
parents	8d2a9b52c682
children	0d2f883870bc

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996 Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;; This file is part of GNU Emacs.
 ;;; Commentary:
 ;;; Code:
 (require 'gnus)
-(require 'gnus-sum)
+(eval-when-compile (require 'cl))
 ;;;
 ;;; gnus-pick-mode
 ;;;
 (defvar gnus-pick-display-summary nil
 "*Display summary while reading.")
 (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-pick-elegant-flow t
-"If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked.")
-(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-define-keys
 gnus-pick-mode-map
 "t" gnus-uu-mark-thread
 "T" gnus-uu-unmark-thread
-" " gnus-pick-next-page
+" " gnus-summary-mark-as-processable
 "u" gnus-summary-unmark-as-processable
 "U" gnus-summary-unmark-all-processable
 "v" gnus-uu-mark-over
 "r" gnus-uu-mark-region
 "R" gnus-uu-unmark-region
 "e" gnus-uu-mark-by-regexp
 "E" gnus-uu-mark-by-regexp
 "b" gnus-uu-mark-buffer
 "B" gnus-uu-unmark-buffer
-"." 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 ()
 (unless (boundp 'gnus-pick-menu)
 (easy-menu-define
 "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)
-(if (not (set (make-local-variable 'gnus-pick-mode)
+(make-local-variable 'gnus-pick-mode)
-		  (if (null arg) (not gnus-pick-mode)
+(setq gnus-pick-mode
-		    (> (prefix-numeric-value arg) 0))))
+	  (if (null arg) (not gnus-pick-mode)
-	(remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
+	    (> (prefix-numeric-value arg) 0)))
+(when gnus-pick-mode
 ;; Make sure that we don't select any articles upon group entry.
-(set (make-local-variable 'gnus-auto-select-first) nil)
+(make-local-variable 'gnus-auto-select-first)
-;; Change line format.
+(setq gnus-auto-select-first nil)
-(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)
-(add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
-(set (make-local-variable 'gnus-summary-goto-unread) 'never)
 ;; Set up the menu.
-(when (gnus-visual-p 'pick-menu '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-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))))
-(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."
-(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."
 (interactive "P")
-(if gnus-newsgroup-processable
+(unless gnus-newsgroup-processable
-(progn
+(error "No articles have been picked"))
 (gnus-summary-limit-to-articles nil)
-(when (or catch-up gnus-mark-unpicked-articles-as-read)
+(when catch-up
-	  (gnus-summary-limit-mark-excluded-as-read))
+(gnus-summary-limit-mark-excluded-as-read))
-(gnus-summary-first-article)
+(gnus-summary-first-unread-article)
-(gnus-configure-windows
+(gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
-	 (if gnus-pick-display-summary 'article 'pick) t))
-(if gnus-pick-elegant-flow
-	(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)
-"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-pick-mouse-pick (e)
-(interactive "e")
-(mouse-set-point e)
-(save-excursion
-(gnus-summary-mark-as-processable 1)))
-(defun gnus-pick-mouse-pick-region (start-event)
-"Pick articles that the mouse is dragged over.
-This must be bound to a button-down mouse event."
-(interactive "e")
-(mouse-minibuffer-check start-event)
-(let* ((echo-keystrokes 0)
-	 (start-posn (event-start start-event))
-	 (start-point (posn-point start-posn))
-(start-line (1+ (count-lines 1 start-point)))
-	 (start-window (posn-window start-posn))
-	 (start-frame (window-frame start-window))
-	 (bounds (window-edges start-window))
-	 (top (nth 1 bounds))
-	 (bottom (if (window-minibuffer-p start-window)
-		     (nth 3 bounds)
-		   ;; Don't count the mode line.
-		   (1- (nth 3 bounds))))
-	 (click-count (1- (event-click-count start-event))))
-(setq mouse-selection-click-count click-count)
-(setq mouse-selection-click-count-buffer (current-buffer))
-(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.
-(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.
-;; It is the place where the drag has reached so far
-;; (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))
-	   (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)
-(let ((scroll-in-place nil))
-(condition-case nil
-	(scroll-up)
-(end-of-buffer (gnus-pick-start-reading)))))
 ;;;
 ;;; gnus-binary-mode
 ;;;
 (defvar gnus-binary-mode nil
-"Minor mode for providing a binary group interface in Gnus summary buffers.")
+"Minor mode for provind a binary group interface in Gnus summary buffers.")
 (defvar gnus-binary-mode-hook nil
 "Hook run in summary binary mode buffers.")
 (defvar gnus-binary-mode-map nil)
 (defun gnus-binary-mode (&optional arg)
 "Minor mode for providing a binary group interface in Gnus summary buffers."
 (interactive "P")
 (when (eq major-mode 'gnus-summary-mode)
 (make-local-variable 'gnus-binary-mode)
 (setq gnus-binary-mode
 	  (if (null arg) (not gnus-binary-mode)
 	    (> (prefix-numeric-value arg) 0)))
 (when gnus-binary-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)
 (make-local-variable 'gnus-summary-display-article-function)
 (setq gnus-summary-display-article-function 'gnus-binary-display-article)
 ;; Set up the menu.
-(when (gnus-visual-p 'binary-menu 'menu)
+(when (and menu-bar-mode
+		 (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))
 (unless (assq 'gnus-binary-mode minor-mode-map-alist)
 	(push (cons 'gnus-binary-mode gnus-binary-mode-map)
 (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
 			     (?\{ . ?\}) (?< . ?>))
 "Brackets used in tree nodes.")
 (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
-"Characters used to connect parents with children.")
+"Charaters used to connect parents with children.")
 (defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
 "*The format specification for the tree mode line.")
 (defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
 (defvar gnus-tree-mode-hook nil
 "*Hook run in tree mode buffers.")
 ;;; Internal variables.
 (defvar gnus-tree-line-format-alist
 `((?n gnus-tmp-name ?s)
 (?f gnus-tmp-from ?s)
 (?N gnus-tmp-number ?d)
 (?\[ gnus-tmp-open-bracket ?c)
 (?\] gnus-tmp-close-bracket ?c)
 ["Select article" gnus-tree-select-article t]))))
 (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
 			   gnus-summary-mode-line-format-alist))
 (setq gnus-tree-line-format-spec
 	(gnus-parse-format gnus-tree-line-format
 			   gnus-tree-line-format-alist t))
-(when (gnus-visual-p 'tree-menu 'menu)
+(when (and menu-bar-mode
+	     (gnus-visual-p 'tree-menu 'menu))
 (gnus-tree-make-menu-bar))
 (kill-all-local-variables)
 (gnus-simplify-mode-line)
 (setq mode-name "Tree")
 (setq major-mode 'gnus-tree-mode)
 (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)
 			((< (window-height) 7) 1)
 			(t 2)))
 	     (height (1- (window-height)))
 	     (bottom (save-excursion (goto-char (point-max))
 				     (forward-line (- height))
 				     (point))))
 	;; Set the window start to either `bottom', which is the biggest
 	;; possible valid number, or the second line from the top,
 	;; whichever is the least.
 	(set-window-start
 	 tree-window (min bottom (save-excursion
 				   (forward-line (- top)) (point)))))
 (select-window selected))))
 (defun gnus-get-tree-buffer ()
 "Return the tree buffer properly initialized."
 (when (and gnus-tree-minimize-window
 	     (not (one-window-p)))
 (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))
 	     (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)))
-	    (when (ignore-errors (select-window win))
+	    (select-window win)
-	      (enlarge-window (- tot wh))
+	    (enlarge-window (- tot wh))
-	      (select-window selected))))))))
+	    (select-window selected)))))))
 ;;; Generating the tree.
 (defun gnus-tree-node-insert (header sparse &optional adopted)
 (let* ((dummy (stringp header))
 		  (substring gnus-tmp-from 0 beg))))
 	   ((memq gnus-tmp-number sparse)
 	    "***")
 	   (t gnus-tmp-from)))
 	 (gnus-tmp-open-bracket
 	  (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
 	;; Eval the cars of the lists until we find a match.
 	(while (and list
 		    (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
 (if (boundp face) (symbol-value face) face)))))
 (defun gnus-tree-indent (level)
 (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
 	(unless (bolp)
 	  (insert "\n"))
 ;; Recurse downwards in all children of this article.
 (while thread
 	(gnus-generate-horizontal-tree
 	 (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)
 		(- (point) (gnus-point-at-bol)))))
 (when (> len 0)
 (insert (make-string len ? )))))
 (defsubst gnus-tree-forward-line (n)
 (defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
 "Generate a vertical tree."
 (let* ((dummy (stringp (car thread)))
 	 (do (or dummy
-		 (and (car thread)
+		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
-		      (memq (mail-header-number (car thread))
-			    gnus-tmp-limit))))
 	 beg)
 (if (not do)
 	;; We don't want this article.
 	(setq thread (cdr thread))
 (if (not (save-excursion (beginning-of-line) (bobp)))
 	  (delete-char -1)
 	  (insert (cadr gnus-tree-parent-child-edges))
 	  (setq beg (point))
 	  ;; Draw "-" lines leftwards.
 	  (while (progn
-		   (unless (bolp)
+		   (forward-char -2)
-		     (forward-char -2))
 		   (= (following-char) ? ))
 	    (delete-char 1)
 	    (insert (car gnus-tree-parent-child-edges)))
 	  (goto-char beg)
 	  (gnus-tree-forward-line 1)))
 	  (end-of-line)
 	  (incf gnus-tmp-indent))
 ;; Recurse downwards in all children of this article.
 (while thread
 	(gnus-generate-vertical-tree
 	 (pop thread) (if do (1+ level) level)
 	 (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."
 (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))
+		      (gnus-summary-article-header article)) t))))
-		     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)
 (defun gnus-tree-open (group)
 (gnus-get-tree-buffer))
 (defun gnus-tree-close (group)
-					;(gnus-kill-buffer gnus-tree-buffer)
+;(gnus-kill-buffer gnus-tree-buffer)
 )
 (defun gnus-highlight-selected-tree (article)
 "Highlight the selected article in the tree."
 (let ((buf (current-buffer))
 	;; Create a new overlay.
 	(gnus-overlay-put
 	 (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-selected-tree-overlay (goto-char (car region)) (cdr region))
 (gnus-tree-minimize)
 (gnus-tree-recenter)
 (let ((selected (selected-window)))
 	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
 (save-excursion
 (set-buffer (gnus-get-tree-buffer))
 (let (region)
 (when (setq region (gnus-tree-article-region article))
 	(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)
 (provide 'gnus-salt)

Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-salt.el @ 70:131b0175ea99 r20-0b30