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