cgit.sxemacs.org Git - gnus/blob - lisp/gnus-vis.el

   1 ;;; gnus-vis.el --- display-oriented parts of Gnus
   2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;;      Per Abrahamsen <abraham@iesd.auc.dk>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (require 'gnus)
  29 (require 'gnus-ems)
  30 (require 'easymenu)
  31 (require 'custom)
  32 (require 'browse-url)
  33 (eval-when-compile (require 'cl))
  34
  35 (defvar gnus-group-menu-hook nil
  36   "*Hook run after the creation of the group mode menu.")
  37
  38 (defvar gnus-summary-menu-hook nil
  39   "*Hook run after the creation of the summary mode menu.")
  40
  41 (defvar gnus-article-menu-hook nil
  42   "*Hook run after the creation of the article mode menu.")
  43
  44 ;;; Summary highlights.
  45
  46 ;(defvar gnus-summary-highlight-properties
  47 ;  '((unread "ForestGreen" "green")
  48 ;    (ticked "Firebrick" "pink")
  49 ;    (read "black" "white")
  50 ;    (low italic italic)
  51 ;    (high bold bold)
  52 ;    (canceled "yellow/black" "black/yellow")))
  53
  54 ;(defvar gnus-summary-highlight-translation
  55 ;  '(((unread (= mark gnus-unread-mark))
  56 ;     (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
  57 ;     (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
  58 ;                   (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
  59 ;     (canceled (= mark gnus-canceled-mark)))
  60 ;    ((low (< score gnus-summary-default-score))
  61 ;     (high (> score gnus-summary-default-score)))))
  62
  63 ;(defun gnus-visual-map-face-translation ()
  64 ;  (let ((props gnus-summary-highlight-properties)
  65 ;       (trans gnus-summary-highlight-translation)
  66 ;       map)
  67 ;    (while props)))
  68
  69 ;see gnus-cus.el
  70 ;(defvar gnus-summary-selected-face 'underline
  71 ;  "*Face used for highlighting the current article in the summary buffer.")
  72
  73 ;see gnus-cus.el
  74 ;(defvar gnus-summary-highlight
  75 ;  (cond ((not (eq gnus-display-type 'color))
  76 ;        '(((> score default) . bold)
  77 ;          ((< score default) . italic)))
  78 ;       ((eq gnus-background-mode 'dark)
  79 ;        (list (cons '(= mark gnus-canceled-mark)
  80 ;                    (custom-face-lookup "yellow" "black" nil nil nil nil))
  81 ;              (cons '(and (> score default)
  82 ;                          (or (= mark gnus-dormant-mark)
  83 ;                              (= mark gnus-ticked-mark)))
  84 ;                    (custom-face-lookup "pink" nil nil t nil nil))
  85 ;              (cons '(and (< score default)
  86 ;                          (or (= mark gnus-dormant-mark)
  87 ;                              (= mark gnus-ticked-mark)))
  88 ;                    (custom-face-lookup "pink" nil nil nil t nil))
  89 ;              (cons '(or (= mark gnus-dormant-mark)
  90 ;                         (= mark gnus-ticked-mark))
  91 ;                    (custom-face-lookup "pink" nil nil nil nil nil))
  92
  93 ;              (cons '(and (> score default) (= mark gnus-ancient-mark))
  94 ;                    (custom-face-lookup "SkyBlue" nil nil t nil nil))
  95 ;              (cons '(and (< score default) (= mark gnus-ancient-mark))
  96 ;                    (custom-face-lookup "SkyBlue" nil nil nil t nil))
  97 ;              (cons '(= mark gnus-ancient-mark)
  98 ;                    (custom-face-lookup "SkyBlue" nil nil nil nil nil))
  99
 100 ;              (cons '(and (> score default) (= mark gnus-unread-mark))
 101 ;                    (custom-face-lookup "white" nil nil t nil nil))
 102 ;              (cons '(and (< score default) (= mark gnus-unread-mark))
 103 ;                    (custom-face-lookup "white" nil nil nil t nil))
 104 ;              (cons '(= mark gnus-unread-mark)
 105 ;                    (custom-face-lookup "white" nil nil nil nil nil))
 106
 107 ;              (cons '(> score default) 'bold)
 108 ;              (cons '(< score default) 'italic)))
 109 ;       (t
 110 ;        (list (cons '(= mark gnus-canceled-mark)
 111 ;                    (custom-face-lookup "yellow" "black" nil nil nil nil))
 112 ;              (cons '(and (> score default)
 113 ;                          (or (= mark gnus-dormant-mark)
 114 ;                              (= mark gnus-ticked-mark)))
 115 ;                    (custom-face-lookup "firebrick" nil nil t nil nil))
 116 ;              (cons '(and (< score default)
 117 ;                          (or (= mark gnus-dormant-mark)
 118 ;                              (= mark gnus-ticked-mark)))
 119 ;                    (custom-face-lookup "firebrick" nil nil nil t nil))
 120 ;              (cons '(or (= mark gnus-dormant-mark)
 121 ;                         (= mark gnus-ticked-mark))
 122 ;                    (custom-face-lookup "firebrick" nil nil nil nil nil))
 123
 124 ;              (cons '(and (> score default) (= mark gnus-ancient-mark))
 125 ;                    (custom-face-lookup "RoyalBlue" nil nil t nil nil))
 126 ;              (cons '(and (< score default) (= mark gnus-ancient-mark))
 127 ;                    (custom-face-lookup "RoyalBlue" nil nil nil t nil))
 128 ;              (cons '(= mark gnus-ancient-mark)
 129 ;                    (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
 130
 131 ;              (cons '(and (> score default) (/= mark gnus-unread-mark))
 132 ;                    (custom-face-lookup "DarkGreen" nil nil t nil nil))
 133 ;              (cons '(and (< score default) (/= mark gnus-unread-mark))
 134 ;                    (custom-face-lookup "DarkGreen" nil nil nil t nil))
 135 ;              (cons '(/= mark gnus-unread-mark)
 136 ;                    (custom-face-lookup "DarkGreen" nil nil nil nil nil))
 137
 138 ;              (cons '(> score default) 'bold)
 139 ;              (cons '(< score default) 'italic))))
 140 ;  "*Alist of `(FORM . FACE)'.
 141 ;Summary lines are highlighted with the FACE for the first FORM which
 142 ;evaluate to a non-nil value.
 143
 144 ;Point will be at the beginning of the line when FORM is evaluated.
 145 ;The following can be used for convenience:
 146
 147 ;score:   (gnus-summary-article-score)
 148 ;default: gnus-summary-default-score
 149 ;below:   gnus-summary-mark-below
 150 ;mark:    (gnus-summary-article-mark)
 151
 152 ;The latter can be used like this:
 153 ;   ((= mark gnus-replied-mark) . underline)")
 154
 155 ;;; article highlights
 156
 157 ;see gnus-cus.el
 158 ;(defvar gnus-header-face-alist
 159 ;  (cond ((not (eq gnus-display-type 'color))
 160 ;        '(("" bold italic)))
 161 ;       ((eq gnus-background-mode 'dark)
 162 ;        (list (list "From" nil
 163 ;                    (custom-face-lookup "SkyBlue" nil nil t t nil))
 164 ;              (list "Subject" nil
 165 ;                    (custom-face-lookup "pink" nil nil t t nil))
 166 ;              (list "Newsgroups:.*," nil
 167 ;                    (custom-face-lookup "yellow" nil nil t t nil))
 168 ;              (list ""
 169 ;                    (custom-face-lookup "cyan" nil nil t nil nil)
 170 ;                    (custom-face-lookup "green" nil nil nil t nil))))
 171 ;       (t
 172 ;        (list (list "From" nil
 173 ;                    (custom-face-lookup "RoyalBlue" nil nil t t nil))
 174 ;              (list "Subject" nil
 175 ;                    (custom-face-lookup "firebrick" nil nil t t nil))
 176 ;              (list "Newsgroups:.*," nil
 177 ;                    (custom-face-lookup "red" nil nil t t nil))
 178 ;              (list ""
 179 ;                    (custom-face-lookup "DarkGreen" nil nil t nil nil)
 180 ;                    (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
 181 ;  "Alist of headers and faces used for highlighting them.
 182 ;The entries in the list has the form `(REGEXP NAME CONTENT)', where
 183 ;REGEXP is a regular expression matching the beginning of the header,
 184 ;NAME is the face used for highlighting the header name and CONTENT is
 185 ;the face used for highlighting the header content.
 186
 187 ;The first non-nil NAME or CONTENT with a matching REGEXP in the list
 188 ;will be used.")
 189
 190
 191 ;see gnus-cus.el
 192 ;(defvar gnus-make-foreground t
 193 ;  "Non nil means foreground color to highlight citations.")
 194
 195 ;see gnus-cus.el
 196 ;(defvar gnus-article-button-face 'bold
 197 ;  "Face used for text buttons.")
 198
 199 ;see gnus-cus.el
 200 ;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
 201 ;                                   gnus-mouse-face
 202 ;                                 'highlight)
 203 ;  "Face used when the mouse is over the button.")
 204
 205 ;see gnus-cus.el
 206 ;(defvar gnus-signature-face 'italic
 207 ;  "Face used for signature.")
 208
 209 (defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
 210   "*Regular expression that matches URLs.")
 211
 212 (defvar gnus-button-alist
 213   `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
 214      t gnus-button-message-id 3)
 215     ;; This is how URLs _should_ be embedded in text...
 216     ("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
 217     ;; Next regexp stolen from highlight-headers.el.
 218     ;; Modified by Vladimir Alexiev.
 219     (,gnus-button-url-regexp 0 t gnus-button-url 0)
 220     ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
 221      gnus-button-message-id 3)
 222     ("\\(<URL: *\\)?mailto: *\\([^ \n\t]+\\)>?" 0 t gnus-button-reply 2))
 223   "Alist of regexps matching buttons in article bodies.
 224
 225 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 226 REGEXP: is the string matching text around the button,
 227 BUTTON: is the number of the regexp grouping actually matching the button,
 228 FORM: is a lisp expression which must eval to true for the button to
 229 be added,
 230 CALLBACK: is the function to call when the user push this button, and each
 231 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 232
 233 CALLBACK can also be a variable, in that case the value of that
 234 variable it the real callback function.")
 235
 236 (defvar gnus-header-button-alist
 237   `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
 238      0 t gnus-button-message-id 0)
 239     ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
 240     ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
 241      0 t gnus-button-mailto 0)
 242     ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0))
 243   "Alist of headers and regexps to match buttons in article heads.
 244
 245 This alist is very similar to `gnus-button-alist', except that each
 246 alist has an additional HEADER element first in each entry:
 247
 248 \(HEADER REGEXP BUTTON FORM CALLBACK PAR)
 249
 250 HEADER is a regexp to match a header.  For a fuller explanation, see
 251 `gnus-button-alist'.")
 252
 253 ;see gnus-cus.el
 254 ;(eval-when-compile
 255 ;  (defvar browse-url-browser-function))
 256
 257 ;;; Group mode highlighting.
 258
 259 (defvar gnus-group-highlight
 260   (cond
 261    ((not (eq gnus-display-type 'color))
 262     '((mailp . bold)
 263       ((= unread 0) . italic)))
 264    ((eq gnus-background-mode 'dark)
 265     `(((not mailp) .
 266        ,(custom-face-lookup "ForestGreen" nil nil t nil nil))
 267       ((zerop unread) .
 268        ,(custom-face-lookup "Blue" nil nil t nil nil))))
 269    (t
 270     `(((not mailp) .
 271        ,(custom-face-lookup "ForestGreen" nil nil t nil nil))
 272       ((zerop unread) .
 273        ,(custom-face-lookup "Blue" nil nil t nil nil)))))
 274   "Group lines are highlighted with the FACE for the first FORM which
 275 evaluate to a non-nil value.
 276
 277 Point will be at the beginning of the line when FORM is evaluated.
 278 Variables bound when these forms are evaluated include:
 279
 280 group: The group name.
 281 unread: The number of unread articles.
 282 method: The select method.
 283 mailp: Whether the select method is a mail method.
 284 level: The level of the group.
 285 score: The score of the group.
 286 ")
 287
 288
 289 ;;; Internal variables.
 290
 291 (defvar gnus-button-marker-list nil)
 292
 293 \f
 294
 295 (eval-and-compile
 296   (autoload 'nnkiboze-generate-groups "nnkiboze")
 297   (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
 298
 299 ;;;
 300 ;;; gnus-menu
 301 ;;;
 302
 303 (defun gnus-visual-turn-off-edit-menu (type)
 304   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
 305     [menu-bar edit] 'undefined))
 306
 307 ;; Newsgroup buffer
 308
 309 (defun gnus-group-make-menu-bar ()
 310   (gnus-visual-turn-off-edit-menu 'group)
 311   (or
 312    (boundp 'gnus-group-reading-menu)
 313    (progn
 314      (easy-menu-define
 315       gnus-group-reading-menu gnus-group-mode-map ""
 316       '("Group"
 317         ["Read" gnus-group-read-group t]
 318         ["Select" gnus-group-select-group t]
 319         ["See old articles" (gnus-group-select-group 'all) :keys "C-u SPC"]
 320         ["Catch up" gnus-group-catchup-current t]
 321         ["Catch up all articles" gnus-group-catchup-current-all t]
 322         ["Check for new articles" gnus-group-get-new-news-this-group t]
 323         ["Toggle subscription" gnus-group-unsubscribe-current-group t]
 324         ["Kill" gnus-group-kill-group t]
 325         ["Yank" gnus-group-yank-group t]
 326         ["Describe" gnus-group-describe-group t]
 327         ["Fetch FAQ" gnus-group-fetch-faq t]
 328         ["Edit kill file" gnus-group-edit-local-kill t]
 329         ["Expire articles" gnus-group-expire-articles t]
 330         ["Set group level" gnus-group-set-current-level t]
 331         ["Select quick" gnus-group-quick-select-group t]
 332         ))
 333
 334      (easy-menu-define
 335       gnus-group-group-menu gnus-group-mode-map ""
 336       '("Groups"
 337         ("Listing"
 338          ["List subscribed groups" gnus-group-list-groups t]
 339          ["List all groups" gnus-group-list-all-groups t]
 340          ["List groups matching..." gnus-group-list-matching t]
 341          ["List killed groups" gnus-group-list-killed t]
 342          ["List zombie groups" gnus-group-list-zombies t]
 343          ["List level" gnus-group-list-level t]
 344          ["Describe all groups" gnus-group-describe-all-groups t]
 345          ["Group apropos" gnus-group-apropos t]
 346          ["Group and description apropos" gnus-group-description-apropos t]
 347          ["List groups matching..." gnus-group-list-matching t]
 348          ["List all groups matching..." gnus-group-list-all-matching t]
 349          ["List active file" gnus-group-list-active t])
 350         ("Sort"
 351          ["Default sort" gnus-group-sort-groups t]
 352          ["Sort by method" gnus-group-sort-by-method t]
 353          ["Sort by rank" gnus-group-sort-by-rank t]
 354          ["Sort by score" gnus-group-sort-by-score t]
 355          ["Sort by level" gnus-group-sort-by-level t]
 356          ["Sort by unread" gnus-group-sort-by-unread t]
 357          ["Sort by name" gnus-group-sort-by-alphabet t])
 358         ("Mark"
 359          ["Mark group" gnus-group-mark-group t]
 360          ["Unmark group" gnus-group-unmark-group t]
 361          ["Unmark all" gnus-group-unmark-all-groups t]
 362          ["Mark regexp" gnus-group-mark-regexp t]
 363          ["Mark region" gnus-group-mark-region t]
 364          ["Mark buffer" gnus-group-mark-buffer t]
 365          ["Execute command" gnus-group-universal-argument t])
 366         ("Subscribe"
 367          ["Subscribe to random group" gnus-group-unsubscribe-group t]
 368          ["Kill all newsgroups in region" gnus-group-kill-region t]
 369          ["Kill all zombie groups" gnus-group-kill-all-zombies t]
 370          ["Kill all groups on level..." gnus-group-kill-level t])
 371         ("Foreign groups"
 372          ["Make a foreign group" gnus-group-make-group t]
 373          ["Add a directory group" gnus-group-make-directory-group t]
 374          ["Add the help group" gnus-group-make-help-group t]
 375          ["Add the archive group" gnus-group-make-archive-group t]
 376          ["Make a doc group" gnus-group-make-doc-group t]
 377          ["Make a kiboze group" gnus-group-make-kiboze-group t]
 378          ["Make a virtual group" gnus-group-make-empty-virtual t]
 379          ["Add a group to a virtual" gnus-group-add-to-virtual t]
 380          ["Rename group" gnus-group-rename-group t]
 381          ["Delete group" gnus-group-delete-group t])
 382         ("Editing groups"
 383          ["Parameters" gnus-group-edit-group-parameters t]
 384          ["Select method" gnus-group-edit-group-method t]
 385          ["Info" gnus-group-edit-group t])
 386         ("Score file"
 387          ["Flush cache" gnus-score-flush-cache t])
 388         ("Move"
 389          ["Next" gnus-group-next-group t]
 390          ["Previous" gnus-group-prev-group t]
 391          ["Next unread" gnus-group-next-unread-group t]
 392          ["Previous unread" gnus-group-prev-unread-group t]
 393          ["Next unread same level" gnus-group-next-unread-group-same-level t]
 394          ["Previous unread same level"
 395           gnus-group-previous-unread-group-same-level t]
 396          ["Jump to group" gnus-group-jump-to-group t]
 397          ["First unread group" gnus-group-first-unread-group t]
 398          ["Best unread group" gnus-group-best-unread-group t])
 399         ["Transpose" gnus-group-transpose-groups t]
 400         ["Read a directory as a group" gnus-group-enter-directory t]
 401         ))
 402
 403      (easy-menu-define
 404       gnus-group-misc-menu gnus-group-mode-map ""
 405       '("Misc"
 406         ["Send a bug report" gnus-bug t]
 407         ["Send a mail" gnus-group-mail t]
 408         ["Post an article" gnus-group-post-news t]
 409         ["Customize score file" gnus-score-customize
 410          (not (string-match "XEmacs" emacs-version)) ]
 411         ["Check for new news" gnus-group-get-new-news t]
 412         ["Activate all groups" gnus-activate-all-groups t]
 413         ["Delete bogus groups" gnus-group-check-bogus-groups t]
 414         ["Find new newsgroups" gnus-find-new-newsgroups t]
 415         ["Restart Gnus" gnus-group-restart t]
 416         ["Read init file" gnus-group-read-init-file t]
 417         ["Browse foreign server" gnus-group-browse-foreign-server t]
 418         ["Enter server buffer" gnus-group-enter-server-mode t]
 419         ["Expire expirable articles" gnus-group-expire-all-groups t]
 420         ["Generate any kiboze groups" nnkiboze-generate-groups t]
 421         ["Gnus version" gnus-version t]
 422         ["Save .newsrc files" gnus-group-save-newsrc t]
 423         ["Suspend Gnus" gnus-group-suspend t]
 424         ["Clear dribble buffer" gnus-group-clear-dribble t]
 425         ["Exit from Gnus" gnus-group-exit t]
 426         ["Exit without saving" gnus-group-quit t]
 427         ["Edit global kill file" gnus-group-edit-global-kill t]
 428         ["Read manual" gnus-info-find-node t]
 429         ["Toggle topics" gnus-topic-mode t]
 430         ("SOUP"
 431          ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
 432          ["Send replies" gnus-soup-send-replies
 433           (fboundp 'gnus-soup-pack-packet)]
 434          ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
 435          ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
 436          ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
 437         ))
 438      (run-hooks 'gnus-group-menu-hook)
 439      )))
 440
 441 ;; Summary buffer
 442 (defun gnus-summary-make-menu-bar ()
 443   (gnus-visual-turn-off-edit-menu 'summary)
 444
 445   (unless (boundp 'gnus-summary-misc-menu)
 446
 447     (easy-menu-define
 448      gnus-summary-misc-menu gnus-summary-mode-map ""
 449      '("Misc"
 450        ("Mark"
 451         ("Read"
 452          ["Mark as read" gnus-summary-mark-as-read-forward t]
 453          ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t]
 454          ["Mark same subject" gnus-summary-kill-same-subject t]
 455          ["Catchup" gnus-summary-catchup t]
 456          ["Catchup all" gnus-summary-catchup-all t]
 457          ["Catchup to here" gnus-summary-catchup-to-here t]
 458          ["Catchup region" gnus-summary-mark-region-as-read t]
 459          ["Mark excluded" gnus-summary-limit-mark-exlcuded-as-read t])
 460         ("Various"
 461          ["Tick" gnus-summary-tick-article-forward t]
 462          ["Mark as dormant" gnus-summary-mark-as-dormant t]
 463          ["Remove marks" gnus-summary-clear-mark-forward t]
 464          ["Set expirable mark" gnus-summary-mark-as-expirable t]
 465          ["Set bookmark" gnus-summary-set-bookmark t]
 466          ["Remove bookmark" gnus-summary-remove-bookmark t])
 467         ("Limit"
 468          ["Unread" gnus-summary-limit-to-unread t]
 469          ["Marks" gnus-summary-limit-to-marks t]
 470          ["Score" gnus-summary-limit-to-score t]
 471          ["Subject" gnus-summary-limit-to-subject t]
 472          ["Author" gnus-summary-limit-to-author t]
 473          ["Non-dormant" gnus-summary-limit-exclude-dormant t]
 474          ["Articles" gnus-summary-limit-to-articles t]
 475          ["Pop limit" gnus-summary-pop-limit t]
 476          ["Show dormant" gnus-summary-limit-include-dormant t]
 477          ["Hide childless dormant"
 478           gnus-summary-limit-exclude-childless-dormant t]
 479          ["Hide thread" gnus-summary-limit-exclude-thread t]
 480          ["Show expunged" gnus-summary-show-all-expunged t])
 481         ("Process mark"
 482          ["Set mark" gnus-summary-mark-as-processable t]
 483          ["Remove mark" gnus-summary-unmark-as-processable t]
 484          ["Remove all marks" gnus-summary-unmark-all-processable t]
 485          ["Mark above" gnus-uu-mark-over t]
 486          ["Mark series" gnus-uu-mark-series t]
 487          ["Mark region" gnus-uu-mark-region t]
 488          ["Mark by regexp" gnus-uu-mark-by-regexp t]
 489          ["Mark all" gnus-uu-mark-all t]
 490          ["Mark buffer" gnus-uu-mark-buffer t]
 491          ["Mark sparse" gnus-uu-mark-sparse t]
 492          ["Mark thread" gnus-uu-mark-thread t]
 493          ["Unmark thread" gnus-uu-unmark-thread t]))
 494        ("Scroll article"
 495         ["Page forward" gnus-summary-next-page t]
 496         ["Page backward" gnus-summary-prev-page t]
 497         ["Line forward" gnus-summary-scroll-up t])
 498        ("Move"
 499         ["Next unread article" gnus-summary-next-unread-article t]
 500         ["Previous unread article" gnus-summary-prev-unread-article t]
 501         ["Next article" gnus-summary-next-article t]
 502         ["Previous article" gnus-summary-prev-article t]
 503         ["Next unread subject" gnus-summary-next-unread-subject t]
 504         ["Previous unread subject" gnus-summary-prev-unread-subject t]
 505         ["Next article same subject" gnus-summary-next-same-subject t]
 506         ["Previous article same subject" gnus-summary-prev-same-subject t]
 507         ["First unread article" gnus-summary-first-unread-article t]
 508         ["Best unread article" gnus-summary-best-unread-article t]
 509         ["Go to subject number..." gnus-summary-goto-subject t]
 510         ["Go to article number..." gnus-summary-goto-article t]
 511         ["Go to the last article" gnus-summary-goto-last-article t]
 512         ["Pop article off history" gnus-summary-pop-article t])
 513        ("Sort"
 514         ["Sort by number" gnus-summary-sort-by-number t]
 515         ["Sort by author" gnus-summary-sort-by-author t]
 516         ["Sort by subject" gnus-summary-sort-by-subject t]
 517         ["Sort by date" gnus-summary-sort-by-date t]
 518         ["Sort by score" gnus-summary-sort-by-score t])
 519        ("Exit"
 520         ["Catchup and exit" gnus-summary-catchup-and-exit t]
 521         ["Catchup all and exit" gnus-summary-catchup-and-exit t]
 522         ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
 523         ["Exit group" gnus-summary-exit t]
 524         ["Exit group without updating" gnus-summary-exit-no-update t]
 525         ["Exit and goto next group" gnus-summary-next-group t]
 526         ["Exit and goto prev group" gnus-summary-prev-group t]
 527         ["Reselect group" gnus-summary-reselect-current-group t]
 528         ["Rescan group" gnus-summary-rescan-group t])
 529        ("Help"
 530         ["Fetch group FAQ" gnus-summary-fetch-faq t]
 531         ["Describe group" gnus-summary-describe-group t]
 532         ["Read manual" gnus-info-find-node t])
 533        ("Cache"
 534         ["Enter article" gnus-cache-enter-article t]
 535         ["Remove article" gnus-cache-remove-article t])
 536        ("Modes"
 537         ["Pick and read" gnus-pick-mode t]
 538         ["Binary" gnus-binary-mode t])
 539        ["Filter articles" gnus-summary-execute-command t]
 540        ["Run command on subjects" gnus-summary-universal-argument t]
 541        ["Toggle line truncation" gnus-summary-toggle-truncation t]
 542        ["Expand window" gnus-summary-expand-window t]
 543        ["Expire expirable articles" gnus-summary-expire-articles t]
 544        ["Edit local kill file" gnus-summary-edit-local-kill t]
 545        ["Edit main kill file" gnus-summary-edit-global-kill t]
 546        ))
 547
 548     (easy-menu-define
 549      gnus-summary-kill-menu gnus-summary-mode-map ""
 550      (cons
 551       "Score"
 552       (nconc
 553        (list
 554         ["Enter score" gnus-summary-score-entry t])
 555        (gnus-visual-score-map 'increase)
 556        (gnus-visual-score-map 'lower)
 557        '(("Mark"
 558           ["Kill below" gnus-summary-kill-below t]
 559           ["Mark above" gnus-summary-mark-above t]
 560           ["Tick above" gnus-summary-tick-above t]
 561           ["Clear above" gnus-summary-clear-above t])
 562          ["Current score" gnus-summary-current-score t]
 563          ["Set score" gnus-summary-set-score t]
 564          ["Customize score file" gnus-score-customize t]
 565          ["Switch current score file" gnus-score-change-score-file t]
 566          ["Set mark below" gnus-score-set-mark-below t]
 567          ["Set expunge below" gnus-score-set-expunge-below t]
 568          ["Edit current score file" gnus-score-edit-alist t]
 569          ["Edit score file" gnus-score-edit-file t]
 570          ["Trace score" gnus-score-find-trace t]
 571          ["Rescore buffer" gnus-summary-rescore t]
 572          ["Increase score" gnus-summary-increase-score t]
 573          ["Lower score" gnus-summary-lower-score t]))))
 574
 575     '(("Default header"
 576        ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
 577         :style radio
 578         :selected (null gnus-score-default-header)]
 579        ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
 580         :style radio
 581         :selected (eq gnus-score-default-header 'a )]
 582        ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
 583         :style radio
 584         :selected (eq gnus-score-default-header 's )]
 585        ["Article body"
 586         (gnus-score-set-default 'gnus-score-default-header 'b)
 587         :style radio
 588         :selected (eq gnus-score-default-header 'b )]
 589        ["All headers"
 590         (gnus-score-set-default 'gnus-score-default-header 'h)
 591         :style radio
 592         :selected (eq gnus-score-default-header 'h )]
 593        ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
 594         :style radio
 595         :selected (eq gnus-score-default-header 'i )]
 596        ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
 597         :style radio
 598         :selected (eq gnus-score-default-header 't )]
 599        ["Crossposting"
 600         (gnus-score-set-default 'gnus-score-default-header 'x)
 601         :style radio
 602         :selected (eq gnus-score-default-header 'x )]
 603        ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
 604         :style radio
 605         :selected (eq gnus-score-default-header 'l )]
 606        ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
 607         :style radio
 608         :selected (eq gnus-score-default-header 'd )]
 609        ["Followups to author"
 610         (gnus-score-set-default 'gnus-score-default-header 'f)
 611         :style radio
 612         :selected (eq gnus-score-default-header 'f )])
 613       ("Default type"
 614        ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
 615         :style radio
 616         :selected (null gnus-score-default-type)]
 617        ;; The `:active' key is commented out in the following,
 618        ;; because the GNU Emacs hack to support radio buttons use
 619        ;; active to indicate which button is selected.
 620        ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
 621         :style radio
 622         ;; :active (not (memq gnus-score-default-header '(l d)))
 623         :selected (eq gnus-score-default-type 's)]
 624        ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
 625         :style radio
 626         ;; :active (not (memq gnus-score-default-header '(l d)))
 627         :selected (eq gnus-score-default-type 'r)]
 628        ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
 629         :style radio
 630         ;; :active (not (memq gnus-score-default-header '(l d)))
 631         :selected (eq gnus-score-default-type 'e)]
 632        ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
 633         :style radio
 634         ;; :active (not (memq gnus-score-default-header '(l d)))
 635         :selected (eq gnus-score-default-type 'f)]
 636        ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
 637         :style radio
 638         ;; :active (eq (gnus-score-default-header 'd))
 639         :selected (eq gnus-score-default-type 'b)]
 640        ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
 641         :style radio
 642         ;; :active (eq (gnus-score-default-header 'd))
 643         :selected (eq gnus-score-default-type 'n)]
 644        ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
 645         :style radio
 646         ;; :active (eq (gnus-score-default-header 'd))
 647         :selected (eq gnus-score-default-type 'a)]
 648        ["Less than number"
 649         (gnus-score-set-default 'gnus-score-default-type '<)
 650         :style radio
 651         ;; :active (eq (gnus-score-default-header 'l))
 652         :selected (eq gnus-score-default-type '<)]
 653        ["Equal to number"
 654         (gnus-score-set-default 'gnus-score-default-type '=)
 655         :style radio
 656         ;; :active (eq (gnus-score-default-header 'l))
 657         :selected (eq gnus-score-default-type '=)]
 658        ["Greater than number"
 659         (gnus-score-set-default 'gnus-score-default-type '>)
 660         :style radio
 661         ;; :active (eq (gnus-score-default-header 'l))
 662         :selected (eq gnus-score-default-type '>)])
 663       ["Default fold" gnus-score-default-fold-toggle
 664        :style toggle
 665        :selected gnus-score-default-fold]
 666       ("Default duration"
 667        ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
 668         :style radio
 669         :selected (null gnus-score-default-duration)]
 670        ["Permanent"
 671         (gnus-score-set-default 'gnus-score-default-duration 'p)
 672         :style radio
 673         :selected (eq gnus-score-default-duration 'p)]
 674        ["Temporary"
 675         (gnus-score-set-default 'gnus-score-default-duration 't)
 676         :style radio
 677         :selected (eq gnus-score-default-duration 't)]
 678        ["Immediate"
 679         (gnus-score-set-default 'gnus-score-default-duration 'i)
 680         :style radio
 681         :selected (eq gnus-score-default-duration 'i)]))
 682
 683     (easy-menu-define
 684      gnus-summary-article-menu gnus-summary-mode-map ""
 685      '("Article"
 686        ("Hide"
 687         ["All" gnus-article-hide t]
 688         ["Headers" gnus-article-hide-headers t]
 689         ["Signature" gnus-article-hide-signature t]
 690         ["Citation" gnus-article-hide-citation t]
 691         ["PGP" gnus-article-hide-pgp t]
 692         ["Boring headers" gnus-article-hide-boring-headers t])
 693        ("Highlight"
 694         ["All" gnus-article-highlight t]
 695         ["Headers" gnus-article-highlight-headers t]
 696         ["Signature" gnus-article-highlight-signature t]
 697         ["Citation" gnus-article-highlight-citation t])
 698        ("Date"
 699         ["Local" gnus-article-date-local t]
 700         ["UT" gnus-article-date-ut t]
 701         ["Original" gnus-article-date-original t]
 702         ["Lapsed" gnus-article-date-lapsed t])
 703        ("Filter"
 704         ["Overstrike" gnus-article-treat-overstrike t]
 705         ["Word wrap" gnus-article-fill-cited-article t]
 706         ["CR" gnus-article-remove-cr t]
 707         ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
 708         ["Show X-Face" gnus-article-display-x-face t]
 709         ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
 710         ["Rot 13" gnus-summary-caesar-message t]
 711         ["Add buttons" gnus-article-add-buttons t]
 712         ["Add buttons to head" gnus-article-add-buttons-to-head t]
 713         ["Stop page breaking" gnus-summary-stop-page-breaking t]
 714         ["Toggle MIME" gnus-summary-toggle-mime t]
 715         ["Verbose header" gnus-summary-verbose-headers t]
 716         ["Toggle header" gnus-summary-toggle-header t])
 717        ("Output"
 718         ["Save in default format" gnus-summary-save-article t]
 719         ["Save in file" gnus-summary-save-article-file t]
 720         ["Save in Unix mail format" gnus-summary-save-article-mail t]
 721         ["Save in MH folder" gnus-summary-save-article-folder t]
 722         ["Save in VM folder" gnus-summary-save-article-vm t]
 723         ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
 724         ["Save body in file" gnus-summary-save-article-body-file t]
 725         ["Pipe through a filter" gnus-summary-pipe-output t]
 726         ["Add to SOUP packet" gnus-soup-add-article t])
 727        ("Backend"
 728         ["Respool article" gnus-summary-respool-article t]
 729         ["Move article" gnus-summary-move-article t]
 730         ["Copy article" gnus-summary-copy-article t]
 731         ["Crosspost article" gnus-summary-crosspost-article t]
 732         ["Import file" gnus-summary-import-article t]
 733         ["Edit article" gnus-summary-edit-article t]
 734         ["Delete article" gnus-summary-delete-article t]
 735         ["Query respool" gnus-summary-respool-query t]
 736         ["Delete expirable articles" gnus-summary-expire-articles-now t])
 737        ("Extract"
 738         ["Uudecode" gnus-uu-decode-uu t]
 739         ["Uudecode and save" gnus-uu-decode-uu-and-save t]
 740         ["Unshar" gnus-uu-decode-unshar t]
 741         ["Unshar and save" gnus-uu-decode-unshar-and-save t]
 742         ["Save" gnus-uu-decode-save t]
 743         ["Binhex" gnus-uu-decode-binhex t]
 744         ["Postscript" gnus-uu-decode-postscript t])
 745        ["Enter digest buffer" gnus-summary-enter-digest-group t]
 746        ["Isearch article" gnus-summary-isearch-article t]
 747        ["Search articles forward" gnus-summary-search-article-forward t]
 748        ["Search articles backward" gnus-summary-search-article-backward t]
 749        ["Beginning of the article" gnus-summary-beginning-of-article t]
 750        ["End of the article" gnus-summary-end-of-article t]
 751        ["Fetch parent of article" gnus-summary-refer-parent-article t]
 752        ["Fetch referenced articles" gnus-summary-refer-references t]
 753        ["Fetch article with id..." gnus-summary-refer-article t]
 754        ["Redisplay" gnus-summary-show-article t]))
 755
 756
 757
 758     (easy-menu-define
 759      gnus-summary-thread-menu gnus-summary-mode-map ""
 760      '("Threads"
 761        ["Toggle threading" gnus-summary-toggle-threads t]
 762        ["Hide threads" gnus-summary-hide-all-threads t]
 763        ["Show threads" gnus-summary-show-all-threads t]
 764        ["Hide thread" gnus-summary-hide-thread t]
 765        ["Show thread" gnus-summary-show-thread t]
 766        ["Go to next thread" gnus-summary-next-thread t]
 767        ["Go to previous thread" gnus-summary-prev-thread t]
 768        ["Go down thread" gnus-summary-down-thread t]
 769        ["Go up thread" gnus-summary-up-thread t]
 770        ["Top of thread" gnus-summary-top-thread t]
 771        ["Mark thread as read" gnus-summary-kill-thread t]
 772        ["Lower thread score" gnus-summary-lower-thread t]
 773        ["Raise thread score" gnus-summary-raise-thread t]
 774        ["Rethread current" gnus-summary-rethread-current t]
 775        ))
 776
 777     (easy-menu-define
 778      gnus-summary-post-menu gnus-summary-mode-map ""
 779      '("Post"
 780        ["Post an article" gnus-summary-post-news t]
 781        ["Followup" gnus-summary-followup t]
 782        ["Followup and yank" gnus-summary-followup-with-original t]
 783        ["Supersede article" gnus-summary-supersede-article t]
 784        ["Cancel article" gnus-summary-cancel-article t]
 785        ["Reply" gnus-summary-reply t]
 786        ["Reply and yank" gnus-summary-reply-with-original t]
 787        ["Mail forward" gnus-summary-mail-forward t]
 788        ["Post forward" gnus-summary-post-forward t]
 789        ["Digest and mail" gnus-uu-digest-mail-forward t]
 790        ["Digest and post" gnus-uu-digest-post-forward t]
 791        ["Resend message" gnus-summary-resend-message t]
 792        ["Send bounced mail" gnus-summary-resend-bounced-mail t]
 793        ["Send a mail" gnus-summary-mail-other-window t]
 794        ["Reply & followup" gnus-summary-followup-and-reply t]
 795        ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t]
 796        ["Uuencode and post" gnus-uu-post-news t]
 797        ("Draft"
 798         ["Send" gnus-summary-send-draft t]
 799         ["Send bounced" gnus-resend-bounced-mail t])
 800        ))
 801     (run-hooks 'gnus-summary-menu-hook)
 802     ))
 803
 804 (defun gnus-score-set-default (var value)
 805   "A version of set that updates the GNU Emacs menu-bar."
 806   (set var value)
 807   ;; It is the message that forces the active status to be updated.
 808   (message ""))
 809
 810 (defvar gnus-score-default-header nil
 811   "Default header when entering new scores.
 812
 813 Should be one of the following symbols.
 814
 815  a: from
 816  s: subject
 817  b: body
 818  h: head
 819  i: message-id
 820  t: references
 821  x: xref
 822  l: lines
 823  d: date
 824  f: followup
 825
 826 If nil, the user will be asked for a header.")
 827
 828 (defvar gnus-score-default-type nil
 829   "Default match type when entering new scores.
 830
 831 Should be one of the following symbols.
 832
 833  s: substring
 834  e: exact string
 835  f: fuzzy string
 836  r: regexp string
 837  b: before date
 838  a: at date
 839  n: this date
 840  <: less than number
 841  >: greater than number
 842  =: equal to number
 843
 844 If nil, the user will be asked for a match type.")
 845
 846 (defvar gnus-score-default-fold nil
 847   "Use case folding for new score file entries iff not nil.")
 848
 849
 850 (defun gnus-score-default-fold-toggle ()
 851   "Toggle folding for new score file entries."
 852   (interactive)
 853   (setq gnus-score-default-fold (not gnus-score-default-fold))
 854   (if gnus-score-default-fold
 855       (message "New score file entries will be case insensitive.")
 856     (message "New score file entries will be case sensitive.")))
 857
 858 (defvar gnus-score-default-duration nil
 859   "Default duration of effect when entering new scores.
 860
 861 Should be one of the following symbols.
 862
 863  t: temporary
 864  p: permanent
 865  i: immediate
 866
 867 If nil, the user will be asked for a duration.")
 868
 869 (defun gnus-visual-score-map (type)
 870   (if t
 871       nil
 872     (let ((headers '(("author" "from" string)
 873                      ("subject" "subject" string)
 874                      ("article body" "body" string)
 875                      ("article head" "head" string)
 876                      ("xref" "xref" string)
 877                      ("lines" "lines" number)
 878                      ("followups to author" "followup" string)))
 879           (types '((number ("less than" <)
 880                            ("greater than" >)
 881                            ("equal" =))
 882                    (string ("substring" s)
 883                            ("exact string" e)
 884                            ("fuzzy string" f)
 885                            ("regexp" r))))
 886           (perms '(("temporary" (current-time-string))
 887                    ("permanent" nil)
 888                    ("immediate" now)))
 889           header)
 890       (list
 891        (apply
 892         'nconc
 893         (list
 894          (if (eq type 'lower)
 895              "Lower score"
 896            "Increase score"))
 897         (let (outh)
 898           (while headers
 899             (setq header (car headers))
 900             (setq outh
 901                   (cons
 902                    (apply
 903                     'nconc
 904                     (list (car header))
 905                     (let ((ts (cdr (assoc (nth 2 header) types)))
 906                           outt)
 907                       (while ts
 908                         (setq outt
 909                               (cons
 910                                (apply
 911                                 'nconc
 912                                 (list (car (car ts)))
 913                                 (let ((ps perms)
 914                                       outp)
 915                                   (while ps
 916                                     (setq outp
 917                                           (cons
 918                                            (vector
 919                                             (car (car ps))
 920                                             (list
 921                                              'gnus-summary-score-entry
 922                                              (nth 1 header)
 923                                              (if (or (string= (nth 1 header)
 924                                                               "head")
 925                                                      (string= (nth 1 header)
 926                                                               "body"))
 927                                                  ""
 928                                                (list 'gnus-summary-header
 929                                                      (nth 1 header)))
 930                                              (list 'quote (nth 1 (car ts)))
 931                                              (list 'gnus-score-default nil)
 932                                              (nth 1 (car ps))
 933                                              t)
 934                                             t)
 935                                            outp))
 936                                     (setq ps (cdr ps)))
 937                                   (list (nreverse outp))))
 938                                outt))
 939                         (setq ts (cdr ts)))
 940                       (list (nreverse outt))))
 941                    outh))
 942             (setq headers (cdr headers)))
 943           (list (nreverse outh))))))))
 944
 945 ;; Article buffer
 946 (defun gnus-article-make-menu-bar ()
 947   (gnus-visual-turn-off-edit-menu 'summary)
 948   (or
 949    (boundp 'gnus-article-article-menu)
 950    (progn
 951      (easy-menu-define
 952       gnus-article-article-menu gnus-article-mode-map ""
 953       '("Article"
 954         ["Scroll forwards" gnus-article-goto-next-page t]
 955         ["Scroll backwards" gnus-article-goto-prev-page t]
 956         ["Show summary" gnus-article-show-summary t]
 957         ["Fetch Message-ID at point" gnus-article-refer-article t]
 958         ["Mail to address at point" gnus-article-mail t]
 959         ))
 960
 961      (easy-menu-define
 962       gnus-article-treatment-menu gnus-article-mode-map ""
 963       '("Treatment"
 964         ["Hide headers" gnus-article-hide-headers t]
 965         ["Hide signature" gnus-article-hide-signature t]
 966         ["Hide citation" gnus-article-hide-citation t]
 967         ["Treat overstrike" gnus-article-treat-overstrike t]
 968         ["Remove carriage return" gnus-article-remove-cr t]
 969         ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
 970         ))
 971      (run-hooks 'gnus-article-menu-hook))))
 972
 973 ;;;
 974 ;;; summary highlights
 975 ;;;
 976
 977 (defun gnus-highlight-selected-summary ()
 978   ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 979   ;; Highlight selected article in summary buffer
 980   (if gnus-summary-selected-face
 981       (save-excursion
 982         (let* ((beg (progn (beginning-of-line) (point)))
 983                (end (progn (end-of-line) (point)))
 984                ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
 985                (from (if (get-text-property beg gnus-mouse-face-prop)
 986                          beg
 987                        (1+ (or (next-single-property-change
 988                                 beg gnus-mouse-face-prop nil end)
 989                                beg))))
 990                (to (1- (or (next-single-property-change
 991                             from gnus-mouse-face-prop nil end)
 992                            end))))
 993           ;; If no mouse-face prop on line (e.g. xemacs) we
 994           ;; will have to = from = end, so we highlight the
 995           ;; entire line instead.
 996           (if (= (+ to 2) from)
 997               (progn
 998                 (setq from beg)
 999                 (setq to end)))
1000           (if gnus-newsgroup-selected-overlay
1001               (gnus-move-overlay gnus-newsgroup-selected-overlay
1002                                  from to (current-buffer))
1003             (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
1004             (gnus-overlay-put gnus-newsgroup-selected-overlay 'face
1005                               gnus-summary-selected-face))))))
1006
1007 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
1008 (defun gnus-summary-highlight-line ()
1009   "Highlight current line according to `gnus-summary-highlight'."
1010   (let* ((list gnus-summary-highlight)
1011          (p (point))
1012          (end (progn (end-of-line) (point)))
1013          ;; now find out where the line starts and leave point there.
1014          (beg (progn (beginning-of-line) (point)))
1015          (article (gnus-summary-article-number))
1016          (score (or (cdr (assq (or article gnus-current-article)
1017                                gnus-newsgroup-scored))
1018                     gnus-summary-default-score 0))
1019          (default gnus-summary-default-score)
1020          (mark (or (gnus-summary-article-mark) gnus-unread-mark))
1021          (inhibit-read-only t))
1022     ;; Eval the cars of the lists until we find a match.
1023     (while (and list
1024                 (not (eval (caar list))))
1025       (setq list (cdr list)))
1026     (let ((face (cdar list)))
1027       (unless (eq face (get-text-property beg 'face))
1028         (put-text-property
1029          beg end 'face
1030          (setq face (if (boundp face) (symbol-value face) face)))
1031         (when gnus-summary-highlight-line-function
1032           (funcall gnus-summary-highlight-line-function article face))))
1033     (goto-char p)))
1034
1035 (defun gnus-group-highlight-line ()
1036   "Highlight the current line according to `gnus-group-highlight'."
1037   (let* ((list gnus-group-highlight)
1038          (p (point))
1039          (end (progn (end-of-line) (point)))
1040          ;; now find out where the line starts and leave point there.
1041          (beg (progn (beginning-of-line) (point)))
1042          (group (gnus-group-group-name))
1043          (entry (gnus-group-entry group))
1044          (unread (if (numberp (car entry)) (car entry) 0))
1045          (info (nth 2 entry))
1046          (method (gnus-server-get-method group (gnus-info-method info)))
1047          (mailp (memq 'mail (assoc (symbol-name
1048                                     (car (or method gnus-select-method)))
1049                                    gnus-valid-select-methods)))
1050          (level (gnus-info-level info))
1051          (score (gnus-info-score info))
1052          (inhibit-read-only t))
1053     ;; Eval the cars of the lists until we find a match.
1054     (while (and list
1055                 (not (eval (caar list))))
1056       (setq list (cdr list)))
1057     (let ((face (cdar list)))
1058       (unless (eq face (get-text-property beg 'face))
1059         (put-text-property
1060          beg end 'face
1061          (setq face (if (boundp face) (symbol-value face) face)))
1062         (gnus-extent-start-open beg)))
1063     (goto-char p)))
1064
1065 ;;;
1066 ;;; gnus-carpal
1067 ;;;
1068
1069 (defvar gnus-carpal-group-buffer-buttons
1070   '(("next" . gnus-group-next-unread-group)
1071     ("prev" . gnus-group-prev-unread-group)
1072     ("read" . gnus-group-read-group)
1073     ("select" . gnus-group-select-group)
1074     ("catch-up" . gnus-group-catchup-current)
1075     ("new-news" . gnus-group-get-new-news-this-group)
1076     ("toggle-sub" . gnus-group-unsubscribe-current-group)
1077     ("subscribe" . gnus-group-unsubscribe-group)
1078     ("kill" . gnus-group-kill-group)
1079     ("yank" . gnus-group-yank-group)
1080     ("describe" . gnus-group-describe-group)
1081     "list"
1082     ("subscribed" . gnus-group-list-groups)
1083     ("all" . gnus-group-list-all-groups)
1084     ("killed" . gnus-group-list-killed)
1085     ("zombies" . gnus-group-list-zombies)
1086     ("matching" . gnus-group-list-matching)
1087     ("post" . gnus-group-post-news)
1088     ("mail" . gnus-group-mail)
1089     ("rescan" . gnus-group-get-new-news)
1090     ("browse-foreign" . gnus-group-browse-foreign)
1091     ("exit" . gnus-group-exit)))
1092
1093 (defvar gnus-carpal-summary-buffer-buttons
1094   '("mark"
1095     ("read" . gnus-summary-mark-as-read-forward)
1096     ("tick" . gnus-summary-tick-article-forward)
1097     ("clear" . gnus-summary-clear-mark-forward)
1098     ("expirable" . gnus-summary-mark-as-expirable)
1099     "move"
1100     ("scroll" . gnus-summary-next-page)
1101     ("next-unread" . gnus-summary-next-unread-article)
1102     ("prev-unread" . gnus-summary-prev-unread-article)
1103     ("first" . gnus-summary-first-unread-article)
1104     ("best" . gnus-summary-best-unread-article)
1105     "article"
1106     ("headers" . gnus-summary-toggle-header)
1107     ("uudecode" . gnus-uu-decode-uu)
1108     ("enter-digest" . gnus-summary-enter-digest-group)
1109     ("fetch-parent" . gnus-summary-refer-parent-article)
1110     "mail"
1111     ("move" . gnus-summary-move-article)
1112     ("copy" . gnus-summary-copy-article)
1113     ("respool" . gnus-summary-respool-article)
1114     "threads"
1115     ("lower" . gnus-summary-lower-thread)
1116     ("kill" . gnus-summary-kill-thread)
1117     "post"
1118     ("post" . gnus-summary-post-news)
1119     ("mail" . gnus-summary-mail)
1120     ("followup" . gnus-summary-followup-with-original)
1121     ("reply" . gnus-summary-reply-with-original)
1122     ("cancel" . gnus-summary-cancel-article)
1123     "misc"
1124     ("exit" . gnus-summary-exit)
1125     ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
1126
1127 (defvar gnus-carpal-server-buffer-buttons
1128   '(("add" . gnus-server-add-server)
1129     ("browse" . gnus-server-browse-server)
1130     ("list" . gnus-server-list-servers)
1131     ("kill" . gnus-server-kill-server)
1132     ("yank" . gnus-server-yank-server)
1133     ("copy" . gnus-server-copy-server)
1134     ("exit" . gnus-server-exit)))
1135
1136 (defvar gnus-carpal-browse-buffer-buttons
1137   '(("subscribe" . gnus-browse-unsubscribe-current-group)
1138     ("exit" . gnus-browse-exit)))
1139
1140 (defvar gnus-carpal-group-buffer "*Carpal Group*")
1141 (defvar gnus-carpal-summary-buffer "*Carpal Summary*")
1142 (defvar gnus-carpal-server-buffer "*Carpal Server*")
1143 (defvar gnus-carpal-browse-buffer "*Carpal Browse*")
1144
1145 (defvar gnus-carpal-attached-buffer nil)
1146
1147 (defvar gnus-carpal-mode-hook nil
1148   "*Hook run in carpal mode buffers.")
1149
1150 (defvar gnus-carpal-button-face 'bold
1151   "*Face used on carpal buttons.")
1152
1153 (defvar gnus-carpal-header-face 'bold-italic
1154   "*Face used on carpal buffer headers.")
1155
1156 (defvar gnus-carpal-mode-map nil)
1157 (put 'gnus-carpal-mode 'mode-class 'special)
1158
1159 (if gnus-carpal-mode-map
1160     nil
1161   (setq gnus-carpal-mode-map (make-keymap))
1162   (suppress-keymap gnus-carpal-mode-map)
1163   (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
1164   (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
1165   (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
1166
1167 (defun gnus-carpal-mode ()
1168   "Major mode for clicking buttons.
1169
1170 All normal editing commands are switched off.
1171 \\<gnus-carpal-mode-map>
1172 The following commands are available:
1173
1174 \\{gnus-carpal-mode-map}"
1175   (interactive)
1176   (kill-all-local-variables)
1177   (setq mode-line-modified "-- ")
1178   (setq major-mode 'gnus-carpal-mode)
1179   (setq mode-name "Gnus Carpal")
1180   (setq mode-line-process nil)
1181   (use-local-map gnus-carpal-mode-map)
1182   (buffer-disable-undo (current-buffer))
1183   (setq buffer-read-only t)
1184   (make-local-variable 'gnus-carpal-attached-buffer)
1185   (run-hooks 'gnus-carpal-mode-hook))
1186
1187 (defun gnus-carpal-setup-buffer (type)
1188   (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
1189     (if (get-buffer buffer)
1190         ()
1191       (save-excursion
1192         (set-buffer (get-buffer-create buffer))
1193         (gnus-carpal-mode)
1194         (setq gnus-carpal-attached-buffer
1195               (intern (format "gnus-%s-buffer" type)))
1196         (gnus-add-current-to-buffer-list)
1197         (let ((buttons (symbol-value
1198                         (intern (format "gnus-carpal-%s-buffer-buttons"
1199                                         type))))
1200               (buffer-read-only nil)
1201               button)
1202           (while buttons
1203             (setq button (car buttons)
1204                   buttons (cdr buttons))
1205             (if (stringp button)
1206                 (set-text-properties
1207                  (point)
1208                  (prog2 (insert button) (point) (insert " "))
1209                  (list 'face gnus-carpal-header-face))
1210               (set-text-properties
1211                (point)
1212                (prog2 (insert (car button)) (point) (insert " "))
1213                (list 'gnus-callback (cdr button)
1214                      'face gnus-carpal-button-face
1215                      gnus-mouse-face-prop 'highlight))))
1216           (let ((fill-column (- (window-width) 2)))
1217             (fill-region (point-min) (point-max)))
1218           (set-window-point (get-buffer-window (current-buffer))
1219                             (point-min)))))))
1220
1221 (defun gnus-carpal-select ()
1222   "Select the button under point."
1223   (interactive)
1224   (let ((func (get-text-property (point) 'gnus-callback)))
1225     (if (null func)
1226         ()
1227       (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
1228       (call-interactively func))))
1229
1230 (defun gnus-carpal-mouse-select (event)
1231   "Select the button under the mouse pointer."
1232   (interactive "e")
1233   (mouse-set-point event)
1234   (gnus-carpal-select))
1235
1236 ;;;
1237 ;;; article highlights
1238 ;;;
1239
1240 ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
1241
1242 ;;; Internal Variables:
1243
1244 (defvar gnus-button-regexp nil)
1245 ;; Regexp matching any of the regexps from `gnus-button-alist'.
1246
1247 (defvar gnus-button-last nil)
1248 ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
1249
1250 ;;; Commands:
1251
1252 (defun gnus-article-push-button (event)
1253   "Check text under the mouse pointer for a callback function.
1254 If the text under the mouse pointer has a `gnus-callback' property,
1255 call it with the value of the `gnus-data' text property."
1256   (interactive "e")
1257   (set-buffer (window-buffer (posn-window (event-start event))))
1258   (let* ((pos (posn-point (event-start event)))
1259          (data (get-text-property pos 'gnus-data))
1260          (fun (get-text-property pos 'gnus-callback)))
1261     (if fun (funcall fun data))))
1262
1263 (defun gnus-article-press-button ()
1264   "Check text at point for a callback function.
1265 If the text at point has a `gnus-callback' property,
1266 call it with the value of the `gnus-data' text property."
1267   (interactive)
1268   (let* ((data (get-text-property (point) 'gnus-data))
1269          (fun (get-text-property (point) 'gnus-callback)))
1270     (if fun (funcall fun data))))
1271
1272 (defun gnus-article-prev-button (n)
1273   "Move point to N buttons backward.
1274 If N is negative, move forward instead."
1275   (interactive "p")
1276   (gnus-article-next-button (- n)))
1277
1278 (defun gnus-article-next-button (n)
1279   "Move point to N buttons forward.
1280 If N is negative, move backward instead."
1281   (interactive "p")
1282   (let ((function (if (< n 0) 'prev-single-property-change
1283                     'next-single-property-change))
1284         (limit (if (< n 0) (point-min) (point-max))))
1285     (setq n (abs n))
1286     (while (and (not (= limit (point)))
1287                 (> n 0))
1288       ;; Skip past the current button.
1289       (when (get-text-property (point) 'gnus-callback)
1290         (goto-char (funcall function (point) 'gnus-callback nil limit)))
1291       ;; Go to the next (or previous) button.
1292       (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
1293       (decf n))
1294     (unless (zerop n)
1295       (gnus-message 5 "No more buttons"))
1296     n))
1297
1298 (defun gnus-article-highlight (&optional force)
1299   "Highlight current article.
1300 This function calls `gnus-article-highlight-headers',
1301 `gnus-article-highlight-citation',
1302 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
1303 do the highlighting.  See the documentation for those functions."
1304   (interactive (list 'force))
1305   (gnus-article-highlight-headers)
1306   (gnus-article-highlight-citation force)
1307   (gnus-article-highlight-signature)
1308   (gnus-article-add-buttons force)
1309   (gnus-article-add-buttons-to-head))
1310
1311 (defun gnus-article-highlight-some (&optional force)
1312   "Highlight current article.
1313 This function calls `gnus-article-highlight-headers',
1314 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
1315 do the highlighting.  See the documentation for those functions."
1316   (interactive (list 'force))
1317   (gnus-article-highlight-headers)
1318   (gnus-article-highlight-signature)
1319   (gnus-article-add-buttons))
1320
1321 (defun gnus-article-highlight-headers ()
1322   "Highlight article headers as specified by `gnus-header-face-alist'."
1323   (interactive)
1324   (save-excursion
1325     (set-buffer gnus-article-buffer)
1326     (save-restriction
1327       (goto-char (point-min))
1328       (when (search-forward "\n\n" nil t)
1329         (narrow-to-region (1- (point)) (point-min))
1330         (let ((alist gnus-header-face-alist)
1331               (buffer-read-only nil)
1332               (case-fold-search t)
1333               (inhibit-point-motion-hooks t)
1334               entry regexp header-face field-face from hpoints fpoints)
1335           (while (setq entry (pop alist))
1336             (goto-char (point-min))
1337             (setq regexp (concat "^\\(" (nth 0 entry) "\\)")
1338                   header-face (nth 1 entry)
1339                   field-face (nth 2 entry))
1340             (while (and (re-search-forward regexp nil t)
1341                         (not (eobp)))
1342               (beginning-of-line)
1343               (setq from (point))
1344               (search-forward ":" nil t)
1345               (when (and header-face
1346                          (not (memq (point) hpoints)))
1347                 (push (point) hpoints)
1348                 (put-text-property from (point) 'face header-face))
1349               (when (and field-face
1350                          (not (memq (setq from (point)) fpoints)))
1351                 (push from fpoints)
1352                 (if (re-search-forward "^[^ \t]" nil t)
1353                     (forward-char -1)
1354                   (goto-char (point-max)))
1355                 (put-text-property from (point) 'face field-face)))))))))
1356
1357 (defun gnus-article-highlight-signature ()
1358   "Highlight the signature in an article.
1359 It does this by highlighting everything after
1360 `gnus-signature-separator' using `gnus-signature-face'."
1361   (interactive)
1362   (save-excursion
1363     (set-buffer gnus-article-buffer)
1364     (let ((buffer-read-only nil)
1365           (inhibit-point-motion-hooks t))
1366       (save-restriction
1367         (when (and gnus-signature-face
1368                    (gnus-narrow-to-signature))
1369           (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
1370                             'face gnus-signature-face)
1371           (widen)
1372           (re-search-backward gnus-signature-separator nil t)
1373           (let ((start (match-beginning 0))
1374                 (end (match-end 0)))
1375             (gnus-article-add-button start end 'gnus-signature-toggle
1376                                      end)))))))
1377
1378 (defun gnus-article-add-buttons (&optional force)
1379   "Find external references in the article and make buttons of them.
1380 \"External references\" are things like Message-IDs and URLs, as
1381 specified by `gnus-button-alist'."
1382   (interactive (list 'force))
1383   (save-excursion
1384     (set-buffer gnus-article-buffer)
1385     ;; Remove all old markers.
1386     (while gnus-button-marker-list
1387       (set-marker (pop gnus-button-marker-list) nil))
1388     (let ((buffer-read-only nil)
1389           (inhibit-point-motion-hooks t)
1390           (case-fold-search t)
1391           (alist gnus-button-alist)
1392           beg entry regexp)
1393       (goto-char (point-min))
1394       ;; We skip the headers.
1395       (unless (search-forward "\n\n" nil t)
1396         (goto-char (point-max)))
1397       (setq beg (point))
1398       (while (setq entry (pop alist))
1399         (setq regexp (car entry))
1400         (while (re-search-forward regexp nil t)
1401           (let* ((start (and entry (match-beginning (nth 1 entry))))
1402                  (end (and entry (match-end (nth 1 entry))))
1403                  (from (match-beginning 0)))
1404             (when (or (eq t (nth 1 entry))
1405                       (eval (nth 1 entry)))
1406               ;; That optional form returned non-nil, so we add the
1407               ;; button.
1408               (gnus-article-add-button
1409                start end 'gnus-button-push
1410                (car (push (set-marker (make-marker) from)
1411                           gnus-button-marker-list))))))))))
1412
1413 (defun gnus-article-add-buttons-old (&optional force)
1414   "Find external references in the article and make buttons of them.
1415 \"External references\" are things like Message-IDs and URLs, as
1416 specified by `gnus-button-alist'."
1417   (interactive (list 'force))
1418   (unless (eq gnus-button-last gnus-button-alist)
1419     (setq gnus-button-regexp (mapconcat 'car gnus-button-alist  "\\|")
1420           gnus-button-last gnus-button-alist))
1421   (save-excursion
1422     (set-buffer gnus-article-buffer)
1423     ;; Remove all old markers.
1424     (while gnus-button-marker-list
1425       (set-marker (pop gnus-button-marker-list) nil))
1426     ;; We parse citations first to be able to match attributions.
1427     (gnus-cite-parse-maybe force)
1428     (let ((buffer-read-only nil)
1429           (inhibit-point-motion-hooks t)
1430           (case-fold-search t))
1431       (goto-char (point-min))
1432       ;; We skip the headers.
1433       (unless (search-forward "\n\n" nil t)
1434         (goto-char (point-max)))
1435       ;; Then we search forward using that big regexp we have.
1436       (while (re-search-forward gnus-button-regexp nil t)
1437         (goto-char (match-beginning 0))
1438         (let* ((from (point))
1439                (current (match-end 0))
1440                (entry (gnus-button-entry)) ; Find sub-regexp.
1441                (start (and entry (match-beginning (nth 1 entry))))
1442                (end (and entry (match-end (nth 1 entry))))
1443                (form (nth 2 entry)))
1444           ;; We now have a valid entry.
1445           (when entry
1446             (goto-char current)
1447             (when (eval form)
1448               ;; That optional form returned non-nil, so we add the
1449               ;; button.
1450               (gnus-article-add-button
1451                start end 'gnus-button-push
1452                (car (push (set-marker (make-marker) from)
1453                           gnus-button-marker-list))))))))))
1454
1455 ;; Add buttons to the head of an article.
1456 (defun gnus-article-add-buttons-to-head ()
1457   "Add buttons to the head of the article."
1458   (interactive)
1459   (save-excursion
1460     (set-buffer gnus-article-buffer)
1461     (let ((buffer-read-only nil)
1462           (inhibit-point-motion-hooks t)
1463           (case-fold-search t)
1464           (alist gnus-header-button-alist)
1465           entry beg end)
1466       (nnheader-narrow-to-headers)
1467       (while alist
1468         ;; Each alist entry.
1469         (setq entry (car alist)
1470               alist (cdr alist))
1471         (goto-char (point-min))
1472         (while (re-search-forward (car entry) nil t)
1473           ;; Each header matching the entry.
1474           (setq beg (match-beginning 0))
1475           (setq end (or (and (re-search-forward "^[^ \t]" nil t)
1476                              (match-beginning 0))
1477                         (point-max)))
1478           (goto-char beg)
1479           (while (re-search-forward (nth 1 entry) end t)
1480             ;; Each match within a header.
1481             (let* ((from (match-beginning 0))
1482                    (entry (cdr entry))
1483                    (start (match-beginning (nth 1 entry)))
1484                    (end (match-end (nth 1 entry)))
1485                    (form (nth 2 entry)))
1486               (goto-char (match-end 0))
1487               (and (eval form)
1488                    (gnus-article-add-button
1489                     start end (nth 3 entry)
1490                     (buffer-substring (match-beginning (nth 4 entry))
1491                                       (match-end (nth 4 entry)))))))
1492           (goto-char end))))
1493     (widen)))
1494
1495
1496
1497 ;;; External functions:
1498
1499 (defun gnus-article-add-button (from to fun &optional data)
1500   "Create a button between FROM and TO with callback FUN and data DATA."
1501   (and gnus-article-button-face
1502        (gnus-overlay-put (gnus-make-overlay from to)
1503                          'face gnus-article-button-face))
1504   (add-text-properties
1505    from to
1506    (nconc (and gnus-article-mouse-face
1507                (list gnus-mouse-face-prop gnus-article-mouse-face))
1508           (list 'gnus-callback fun)
1509           (and data (list 'gnus-data data)))))
1510
1511 ;;; Internal functions:
1512
1513 (defun gnus-signature-toggle (end)
1514   (save-excursion
1515     (set-buffer gnus-article-buffer)
1516     (let ((buffer-read-only nil))
1517       (if (get-text-property end 'invisible)
1518           (remove-text-properties end (point-max) gnus-hidden-properties)
1519         (add-text-properties end (point-max) gnus-hidden-properties)))))
1520
1521 ;see gnus-cus.el
1522 ;(defun gnus-make-face (color)
1523 ;  ;; Create entry for face with COLOR.
1524 ;  (if gnus-make-foreground
1525 ;      (custom-face-lookup color nil nil nil nil nil)
1526 ;    (custom-face-lookup nil color nil nil nil nil)))
1527
1528 (defun gnus-button-entry ()
1529   ;; Return the first entry in `gnus-button-alist' matching this place.
1530   (let ((alist gnus-button-alist)
1531         (entry nil))
1532     (while alist
1533       (setq entry (car alist)
1534             alist (cdr alist))
1535       (if (looking-at (car entry))
1536           (setq alist nil)
1537         (setq entry nil)))
1538     entry))
1539
1540 (defun gnus-button-push (marker)
1541   ;; Push button starting at MARKER.
1542   (save-excursion
1543     (set-buffer gnus-article-buffer)
1544     (goto-char marker)
1545     (let* ((entry (gnus-button-entry))
1546            (inhibit-point-motion-hooks t)
1547            (fun (nth 3 entry))
1548            (args (mapcar (lambda (group)
1549                            (let ((string (buffer-substring
1550                                           (match-beginning group)
1551                                           (match-end group))))
1552                              (set-text-properties 0 (length string) nil string)
1553                              string))
1554                          (nthcdr 4 entry))))
1555       (cond ((fboundp fun)
1556              (apply fun args))
1557             ((and (boundp fun)
1558                   (fboundp (symbol-value fun)))
1559              (apply (symbol-value fun) args))
1560             (t
1561              (message "You must define `%S' to use this button"
1562                       (cons fun args)))))))
1563
1564 (defun gnus-button-message-id (message-id)
1565   "Fetch MESSAGE-ID."
1566   (save-excursion
1567     (set-buffer gnus-summary-buffer)
1568     (gnus-summary-refer-article message-id)))
1569
1570 (defun gnus-button-mailto (address)
1571   ;; Mail to ADDRESS.
1572   (gnus-new-mail address))
1573
1574 (defun gnus-button-reply (address)
1575   ;; Reply to ADDRESS.
1576   (gnus-mail-reply t address))
1577
1578 (defun gnus-button-url (address)
1579   "Browse ADDRESS."
1580   (funcall browse-url-browser-function address))
1581
1582 ;;; Next/prev buttons in the article buffer.
1583
1584 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
1585 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
1586
1587 (defvar gnus-prev-page-map nil)
1588 (unless gnus-prev-page-map
1589   (setq gnus-prev-page-map (make-sparse-keymap))
1590   (define-key gnus-prev-page-map gnus-mouse-2 'gnus-article-prev-page)
1591   (define-key gnus-prev-page-map "\r" 'gnus-article-prev-page))
1592
1593 (defun gnus-insert-prev-page-button ()
1594   (let ((buffer-read-only nil))
1595     (gnus-eval-format gnus-prev-page-line-format nil
1596                       `(gnus-prev t local-map ,gnus-prev-page-map))))
1597
1598 (defvar gnus-next-page-map nil)
1599 (unless gnus-next-page-map
1600   (setq gnus-next-page-map (make-keymap))
1601   (suppress-keymap gnus-prev-page-map)
1602   (define-key gnus-next-page-map gnus-mouse-2 'gnus-article-next-page)
1603   (define-key gnus-next-page-map "\r" 'gnus-article-next-page))
1604
1605 (defun gnus-insert-next-page-button ()
1606   (let ((buffer-read-only nil))
1607     (gnus-eval-format gnus-next-page-line-format nil
1608                       `(gnus-next t local-map ,gnus-next-page-map))))
1609
1610 ;;; Compatibility Functions:
1611
1612 (or (fboundp 'rassoc)
1613     ;; Introduced in Emacs 19.29.
1614     (defun rassoc (elt list)
1615       "Return non-nil if ELT is `equal' to the cdr of an element of LIST.
1616 The value is actually the element of LIST whose cdr is ELT."
1617       (let (result)
1618         (while list
1619           (setq result (car list))
1620           (if (equal (cdr result) elt)
1621               (setq list nil)
1622             (setq result nil
1623                   list (cdr list))))
1624         result)))
1625
1626 ; (require 'gnus-cus)
1627 (gnus-ems-redefine)
1628 (provide 'gnus-vis)
1629
1630 ;;; gnus-vis.el ends here