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 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     ;; This is how URLs _should_ be embedded in text...
 218     ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
 219     ;; Next regexp stolen from highlight-headers.el.
 220     ;; Modified by Vladimir Alexiev.
 221     (,gnus-button-url-regexp 0 t gnus-button-url 0)
 222     ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
 223      gnus-button-message-id 3)
 224     ("\\(<URL: *\\)?mailto: *\\([^ \n\t]+\\)>?" 0 t gnus-button-reply 2))
 225   "Alist of regexps matching buttons in article bodies.
 226
 227 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 228 REGEXP: is the string matching text around the button,
 229 BUTTON: is the number of the regexp grouping actually matching the button,
 230 FORM: is a lisp expression which must eval to true for the button to
 231 be added,
 232 CALLBACK: is the function to call when the user push this button, and each
 233 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 234
 235 CALLBACK can also be a variable, in that case the value of that
 236 variable it the real callback function.")
 237
 238 (defvar gnus-header-button-alist
 239   `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
 240      0 t gnus-button-message-id 0)
 241     ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
 242     ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
 243      0 t gnus-button-mailto 0)
 244     ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
 245     ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
 246     ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
 247      gnus-button-message-id 3))
 248   "Alist of headers and regexps to match buttons in article heads.
 249
 250 This alist is very similar to `gnus-button-alist', except that each
 251 alist has an additional HEADER element first in each entry:
 252
 253 \(HEADER REGEXP BUTTON FORM CALLBACK PAR)
 254
 255 HEADER is a regexp to match a header.  For a fuller explanation, see
 256 `gnus-button-alist'.")
 257
 258 ;see gnus-cus.el
 259 ;(eval-when-compile
 260 ;  (defvar browse-url-browser-function))
 261
 262 ;;; Group mode highlighting.
 263
 264 (defvar gnus-group-highlight
 265   (cond
 266    ((not (eq gnus-display-type 'color))
 267     '((mailp . bold)
 268       ((= unread 0) . italic)))
 269    ((eq gnus-background-mode 'dark)
 270     `(((> unread 200) . ,(custom-face-lookup "Red" nil nil t nil nil))
 271       ((and (< level 3) (zerop unread)) .
 272        ,(custom-face-lookup "SeaGreen" nil nil t nil nil))
 273       ((< level 3) . ,(custom-face-lookup "SpringGreen" nil nil t nil nil))
 274       ((zerop unread) . ,(custom-face-lookup "SteelBlue" nil nil t nil nil))
 275       (t . ,(custom-face-lookup "SkyBlue" nil nil t nil nil))
 276       ))
 277    (t
 278     `(((not mailp) .
 279        ,(custom-face-lookup "ForestGreen" nil nil t nil nil))
 280       ((zerop unread) .
 281        ,(custom-face-lookup "Blue" nil nil t nil nil)))))
 282   "Group lines are highlighted with the FACE for the first FORM which
 283 evaluate to a non-nil value.
 284
 285 Point will be at the beginning of the line when FORM is evaluated.
 286 Variables bound when these forms are evaluated include:
 287
 288 group: The group name.
 289 unread: The number of unread articles.
 290 method: The select method.
 291 mailp: Whether the select method is a mail method.
 292 level: The level of the group.
 293 score: The score of the group.
 294 ticked: The number of ticked articles in the group.
 295 ")
 296
 297
 298 ;;; Internal variables.
 299
 300 (defvar gnus-button-marker-list nil)
 301
 302 \f
 303
 304 (eval-and-compile
 305   (autoload 'nnkiboze-generate-groups "nnkiboze")
 306   (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
 307
 308 ;;;
 309 ;;; gnus-menu
 310 ;;;
 311
 312 (defun gnus-visual-turn-off-edit-menu (type)
 313   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
 314     [menu-bar edit] 'undefined))
 315
 316 ;; Newsgroup buffer
 317
 318 (defun gnus-group-make-menu-bar ()
 319   (gnus-visual-turn-off-edit-menu 'group)
 320   (or
 321    (boundp 'gnus-group-reading-menu)
 322    (progn
 323      (easy-menu-define
 324       gnus-group-reading-menu gnus-group-mode-map ""
 325       '("Group"
 326         ["Read" gnus-group-read-group (gnus-group-group-name)]
 327         ["Select" gnus-group-select-group (gnus-group-group-name)]
 328         ["See old articles" (gnus-group-select-group 'all)
 329          :keys "C-u SPC" :active (gnus-group-group-name)]
 330         ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
 331         ["Catch up all articles" gnus-group-catchup-current-all
 332          (gnus-group-group-name)]
 333         ["Check for new articles" gnus-group-get-new-news-this-group
 334          (gnus-group-group-name)]
 335         ["Toggle subscription" gnus-group-unsubscribe-current-group
 336          (gnus-group-group-name)]
 337         ["Kill" gnus-group-kill-group (gnus-group-group-name)]
 338         ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
 339         ["Describe" gnus-group-describe-group (gnus-group-group-name)]
 340         ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
 341         ["Edit kill file" gnus-group-edit-local-kill
 342          (gnus-group-group-name)]
 343         ;; Actually one should check, if any of the marked groups gives t for
 344         ;; (gnus-check-backend-function 'request-expire-articles ...)
 345         ["Expire articles" gnus-group-expire-articles
 346          (or (and (gnus-group-group-name)
 347                   (gnus-check-backend-function
 348                    'request-expire-articles
 349                    (gnus-group-group-name))) gnus-group-marked)]
 350         ["Set group level" gnus-group-set-current-level
 351          (gnus-group-group-name)]
 352         ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
 353         ))
 354
 355      (easy-menu-define
 356       gnus-group-group-menu gnus-group-mode-map ""
 357       '("Groups"
 358         ("Listing"
 359          ["List subscribed groups" gnus-group-list-groups t]
 360          ["List all groups" gnus-group-list-all-groups t]
 361          ["List killed groups" gnus-group-list-killed gnus-killed-list]
 362          ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
 363          ["List level..." gnus-group-list-level t]
 364          ["Describe all groups" gnus-group-describe-all-groups t]
 365          ["Group apropos..." gnus-group-apropos t]
 366          ["Group and description apropos..." gnus-group-description-apropos t]
 367          ["List groups matching..." gnus-group-list-matching t]
 368          ["List all groups matching..." gnus-group-list-all-matching t]
 369          ["List active file" gnus-group-list-active t])
 370         ("Sort"
 371          ["Default sort" gnus-group-sort-groups
 372           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 373          ["Sort by method" gnus-group-sort-groups-by-method
 374           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 375          ["Sort by rank" gnus-group-sort-groups-by-rank
 376           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 377          ["Sort by score" gnus-group-sort-groups-by-score
 378           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 379          ["Sort by level" gnus-group-sort-groups-by-level
 380           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 381          ["Sort by unread" gnus-group-sort-groups-by-unread
 382           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
 383          ["Sort by name" gnus-group-sort-groups-by-alphabet
 384           (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
 385         ("Mark"
 386          ["Mark group" gnus-group-mark-group
 387           (and (gnus-group-group-name)
 388                (not (memq (gnus-group-group-name) gnus-group-marked)))]
 389          ["Unmark group" gnus-group-unmark-group
 390           (and (gnus-group-group-name)
 391                (memq (gnus-group-group-name) gnus-group-marked))]
 392          ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
 393          ["Mark regexp..." gnus-group-mark-regexp t]
 394          ["Mark region" gnus-group-mark-region t]
 395          ["Mark buffer" gnus-group-mark-buffer t]
 396          ["Execute command" gnus-group-universal-argument
 397           (or gnus-group-marked (gnus-group-group-name))])
 398         ("Subscribe"
 399          ["Subscribe to random group" gnus-group-unsubscribe-group t]
 400          ["Kill all newsgroups in region" gnus-group-kill-region t]
 401          ["Kill all zombie groups" gnus-group-kill-all-zombies
 402           gnus-zombie-list]
 403          ["Kill all groups on level..." gnus-group-kill-level t])
 404         ("Foreign groups"
 405          ["Make a foreign group" gnus-group-make-group t]
 406          ["Add a directory group" gnus-group-make-directory-group t]
 407          ["Add the help group" gnus-group-make-help-group t]
 408          ["Add the archive group" gnus-group-make-archive-group t]
 409          ["Make a doc group" gnus-group-make-doc-group t]
 410          ["Make a kiboze group" gnus-group-make-kiboze-group t]
 411          ["Make a virtual group" gnus-group-make-empty-virtual t]
 412          ["Add a group to a virtual" gnus-group-add-to-virtual t]
 413          ["Rename group" gnus-group-rename-group
 414           (gnus-check-backend-function
 415            'request-rename-group (gnus-group-group-name))]
 416          ["Delete group" gnus-group-delete-group
 417           (gnus-check-backend-function
 418            'request-delete-group (gnus-group-group-name))])
 419         ("Editing groups"
 420          ["Parameters" gnus-group-edit-group-parameters
 421           (gnus-group-group-name)]
 422          ["Select method" gnus-group-edit-group-method
 423           (gnus-group-group-name)]
 424          ["Info" gnus-group-edit-group (gnus-group-group-name)])
 425         ("Score file"
 426          ["Flush cache" gnus-score-flush-cache
 427           (or gnus-score-cache gnus-short-name-score-file-cache)])
 428         ("Move"
 429          ["Next" gnus-group-next-group t]
 430          ["Previous" gnus-group-prev-group t]
 431          ["Next unread" gnus-group-next-unread-group t]
 432          ["Previous unread" gnus-group-prev-unread-group t]
 433          ["Next unread same level" gnus-group-next-unread-group-same-level t]
 434          ["Previous unread same level"
 435           gnus-group-previous-unread-group-same-level t]
 436          ["Jump to group" gnus-group-jump-to-group t]
 437          ["First unread group" gnus-group-first-unread-group t]
 438          ["Best unread group" gnus-group-best-unread-group t])
 439         ["Transpose" gnus-group-transpose-groups
 440          (gnus-group-group-name)]
 441         ["Read a directory as a group..." gnus-group-enter-directory t]
 442         ))
 443
 444      (easy-menu-define
 445       gnus-group-misc-menu gnus-group-mode-map ""
 446       '("Misc"
 447         ["Send a bug report" gnus-bug t]
 448         ["Send a mail" gnus-group-mail t]
 449         ["Post an article..." gnus-group-post-news t]
 450         ["Customize score file" gnus-score-customize
 451          (not (string-match "XEmacs" emacs-version))]
 452         ["Check for new news" gnus-group-get-new-news t]
 453         ["Activate all groups" gnus-activate-all-groups t]
 454         ["Delete bogus groups" gnus-group-check-bogus-groups t]
 455         ["Find new newsgroups" gnus-find-new-newsgroups t]
 456         ["Restart Gnus" gnus-group-restart t]
 457         ["Read init file" gnus-group-read-init-file t]
 458         ["Browse foreign server" gnus-group-browse-foreign-server t]
 459         ["Enter server buffer" gnus-group-enter-server-mode t]
 460         ["Expire all expirable articles" gnus-group-expire-all-groups t]
 461         ["Generate any kiboze groups" nnkiboze-generate-groups t]
 462         ["Gnus version" gnus-version t]
 463         ["Save .newsrc files" gnus-group-save-newsrc t]
 464         ["Suspend Gnus" gnus-group-suspend t]
 465         ["Clear dribble buffer" gnus-group-clear-dribble t]
 466         ["Exit from Gnus" gnus-group-exit t]
 467         ["Exit without saving" gnus-group-quit t]
 468         ["Edit global kill file" gnus-group-edit-global-kill t]
 469         ["Read manual" gnus-info-find-node t]
 470         ["Toggle topics" gnus-topic-mode t]
 471         ("SOUP"
 472          ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
 473          ["Send replies" gnus-soup-send-replies
 474           (fboundp 'gnus-soup-pack-packet)]
 475          ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
 476          ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
 477          ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
 478         ))
 479      (run-hooks 'gnus-group-menu-hook)
 480      )))
 481
 482 ;; Summary buffer
 483 (defun gnus-summary-make-menu-bar ()
 484   (gnus-visual-turn-off-edit-menu 'summary)
 485
 486   (unless (boundp 'gnus-summary-misc-menu)
 487
 488     (easy-menu-define
 489      gnus-summary-misc-menu gnus-summary-mode-map ""
 490      '("Misc"
 491        ("Mark"
 492         ("Read"
 493          ["Mark as read" gnus-summary-mark-as-read-forward t]
 494          ["Mark same subject and select"
 495           gnus-summary-kill-same-subject-and-select t]
 496          ["Mark same subject" gnus-summary-kill-same-subject t]
 497          ["Catchup" gnus-summary-catchup t]
 498          ["Catchup all" gnus-summary-catchup-all t]
 499          ["Catchup to here" gnus-summary-catchup-to-here t]
 500          ["Catchup region" gnus-summary-mark-region-as-read t]
 501          ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
 502         ("Various"
 503          ["Tick" gnus-summary-tick-article-forward t]
 504          ["Mark as dormant" gnus-summary-mark-as-dormant t]
 505          ["Remove marks" gnus-summary-clear-mark-forward t]
 506          ["Set expirable mark" gnus-summary-mark-as-expirable t]
 507          ["Set bookmark" gnus-summary-set-bookmark t]
 508          ["Remove bookmark" gnus-summary-remove-bookmark t])
 509         ("Limit"
 510          ["Marks..." gnus-summary-limit-to-marks t]
 511          ["Subject..." gnus-summary-limit-to-subject t]
 512          ["Author..." gnus-summary-limit-to-author t]
 513          ["Score" gnus-summary-limit-to-score t]
 514          ["Unread" gnus-summary-limit-to-unread t]
 515          ["Non-dormant" gnus-summary-limit-exclude-dormant t]
 516          ["Articles" gnus-summary-limit-to-articles t]
 517          ["Pop limit" gnus-summary-pop-limit t]
 518          ["Show dormant" gnus-summary-limit-include-dormant t]
 519          ["Hide childless dormant"
 520           gnus-summary-limit-exclude-childless-dormant t]
 521          ;;["Hide thread" gnus-summary-limit-exclude-thread t]
 522          ["Show expunged" gnus-summary-show-all-expunged t])
 523         ("Process mark"
 524          ["Set mark" gnus-summary-mark-as-processable t]
 525          ["Remove mark" gnus-summary-unmark-as-processable t]
 526          ["Remove all marks" gnus-summary-unmark-all-processable t]
 527          ["Mark above" gnus-uu-mark-over t]
 528          ["Mark series" gnus-uu-mark-series t]
 529          ["Mark region" gnus-uu-mark-region t]
 530          ["Mark by regexp..." gnus-uu-mark-by-regexp t]
 531          ["Mark all" gnus-uu-mark-all t]
 532          ["Mark buffer" gnus-uu-mark-buffer t]
 533          ["Mark sparse" gnus-uu-mark-sparse t]
 534          ["Mark thread" gnus-uu-mark-thread t]
 535          ["Unmark thread" gnus-uu-unmark-thread t]))
 536        ("Scroll article"
 537         ["Page forward" gnus-summary-next-page t]
 538         ["Page backward" gnus-summary-prev-page t]
 539         ["Line forward" gnus-summary-scroll-up t])
 540        ("Move"
 541         ["Next unread article" gnus-summary-next-unread-article t]
 542         ["Previous unread article" gnus-summary-prev-unread-article t]
 543         ["Next article" gnus-summary-next-article t]
 544         ["Previous article" gnus-summary-prev-article t]
 545         ["Next unread subject" gnus-summary-next-unread-subject t]
 546         ["Previous unread subject" gnus-summary-prev-unread-subject t]
 547         ["Next article same subject" gnus-summary-next-same-subject t]
 548         ["Previous article same subject" gnus-summary-prev-same-subject t]
 549         ["First unread article" gnus-summary-first-unread-article t]
 550         ["Best unread article" gnus-summary-best-unread-article t]
 551         ["Go to subject number..." gnus-summary-goto-subject t]
 552         ["Go to article number..." gnus-summary-goto-article t]
 553         ["Go to the last article" gnus-summary-goto-last-article t]
 554         ["Pop article off history" gnus-summary-pop-article t])
 555        ("Sort"
 556         ["Sort by number" gnus-summary-sort-by-number t]
 557         ["Sort by author" gnus-summary-sort-by-author t]
 558         ["Sort by subject" gnus-summary-sort-by-subject t]
 559         ["Sort by date" gnus-summary-sort-by-date t]
 560         ["Sort by score" gnus-summary-sort-by-score t])
 561        ("Exit"
 562         ["Catchup and exit" gnus-summary-catchup-and-exit t]
 563         ["Catchup all and exit" gnus-summary-catchup-and-exit t]
 564         ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
 565         ["Exit group" gnus-summary-exit t]
 566         ["Exit group without updating" gnus-summary-exit-no-update t]
 567         ["Exit and goto next group" gnus-summary-next-group t]
 568         ["Exit and goto prev group" gnus-summary-prev-group t]
 569         ["Reselect group" gnus-summary-reselect-current-group t]
 570         ["Rescan group" gnus-summary-rescan-group t])
 571        ("Help"
 572         ["Fetch group FAQ" gnus-summary-fetch-faq t]
 573         ["Describe group" gnus-summary-describe-group t]
 574         ["Read manual" gnus-info-find-node t])
 575        ("Cache"
 576         ["Enter article" gnus-cache-enter-article t]
 577         ["Remove article" gnus-cache-remove-article t])
 578        ("Modes"
 579         ["Pick and read" gnus-pick-mode t]
 580         ["Binary" gnus-binary-mode t])
 581        ["Filter articles..." gnus-summary-execute-command t]
 582        ["Run command on subjects..." gnus-summary-universal-argument t]
 583        ["Toggle line truncation" gnus-summary-toggle-truncation t]
 584        ["Expand window" gnus-summary-expand-window t]
 585        ["Expire expirable articles" gnus-summary-expire-articles
 586         (gnus-check-backend-function
 587          'request-expire-articles gnus-newsgroup-name)]
 588        ["Edit local kill file" gnus-summary-edit-local-kill t]
 589        ["Edit main kill file" gnus-summary-edit-global-kill t]
 590        ))
 591
 592     (easy-menu-define
 593      gnus-summary-kill-menu gnus-summary-mode-map ""
 594      (cons
 595       "Score"
 596       (nconc
 597        (list
 598         ["Enter score..." gnus-summary-score-entry t])
 599        (gnus-visual-score-map 'increase)
 600        (gnus-visual-score-map 'lower)
 601        '(("Mark"
 602           ["Kill below" gnus-summary-kill-below t]
 603           ["Mark above" gnus-summary-mark-above t]
 604           ["Tick above" gnus-summary-tick-above t]
 605           ["Clear above" gnus-summary-clear-above t])
 606          ["Current score" gnus-summary-current-score t]
 607          ["Set score" gnus-summary-set-score t]
 608          ["Customize score file" gnus-score-customize t]
 609          ["Switch current score file..." gnus-score-change-score-file t]
 610          ["Set mark below..." gnus-score-set-mark-below t]
 611          ["Set expunge below..." gnus-score-set-expunge-below t]
 612          ["Edit current score file" gnus-score-edit-current-scores t]
 613          ["Edit score file" gnus-score-edit-file t]
 614          ["Trace score" gnus-score-find-trace t]
 615          ["Rescore buffer" gnus-summary-rescore t]
 616          ["Increase score..." gnus-summary-increase-score t]
 617          ["Lower score..." gnus-summary-lower-score t]))))
 618
 619     '(("Default header"
 620        ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
 621         :style radio
 622         :selected (null gnus-score-default-header)]
 623        ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
 624         :style radio
 625         :selected (eq gnus-score-default-header 'a)]
 626        ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
 627         :style radio
 628         :selected (eq gnus-score-default-header 's)]
 629        ["Article body"
 630         (gnus-score-set-default 'gnus-score-default-header 'b)
 631         :style radio
 632         :selected (eq gnus-score-default-header 'b )]
 633        ["All headers"
 634         (gnus-score-set-default 'gnus-score-default-header 'h)
 635         :style radio
 636         :selected (eq gnus-score-default-header 'h )]
 637        ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
 638         :style radio
 639         :selected (eq gnus-score-default-header 'i )]
 640        ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
 641         :style radio
 642         :selected (eq gnus-score-default-header 't )]
 643        ["Crossposting"
 644         (gnus-score-set-default 'gnus-score-default-header 'x)
 645         :style radio
 646         :selected (eq gnus-score-default-header 'x )]
 647        ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
 648         :style radio
 649         :selected (eq gnus-score-default-header 'l )]
 650        ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
 651         :style radio
 652         :selected (eq gnus-score-default-header 'd )]
 653        ["Followups to author"
 654         (gnus-score-set-default 'gnus-score-default-header 'f)
 655         :style radio
 656         :selected (eq gnus-score-default-header 'f )])
 657       ("Default type"
 658        ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
 659         :style radio
 660         :selected (null gnus-score-default-type)]
 661        ;; The `:active' key is commented out in the following,
 662        ;; because the GNU Emacs hack to support radio buttons use
 663        ;; active to indicate which button is selected.
 664        ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
 665         :style radio
 666         ;; :active (not (memq gnus-score-default-header '(l d)))
 667         :selected (eq gnus-score-default-type 's)]
 668        ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
 669         :style radio
 670         ;; :active (not (memq gnus-score-default-header '(l d)))
 671         :selected (eq gnus-score-default-type 'r)]
 672        ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
 673         :style radio
 674         ;; :active (not (memq gnus-score-default-header '(l d)))
 675         :selected (eq gnus-score-default-type 'e)]
 676        ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
 677         :style radio
 678         ;; :active (not (memq gnus-score-default-header '(l d)))
 679         :selected (eq gnus-score-default-type 'f)]
 680        ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
 681         :style radio
 682         ;; :active (eq (gnus-score-default-header 'd))
 683         :selected (eq gnus-score-default-type 'b)]
 684        ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
 685         :style radio
 686         ;; :active (eq (gnus-score-default-header 'd))
 687         :selected (eq gnus-score-default-type 'n)]
 688        ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
 689         :style radio
 690         ;; :active (eq (gnus-score-default-header 'd))
 691         :selected (eq gnus-score-default-type 'a)]
 692        ["Less than number"
 693         (gnus-score-set-default 'gnus-score-default-type '<)
 694         :style radio
 695         ;; :active (eq (gnus-score-default-header 'l))
 696         :selected (eq gnus-score-default-type '<)]
 697        ["Equal to number"
 698         (gnus-score-set-default 'gnus-score-default-type '=)
 699         :style radio
 700         ;; :active (eq (gnus-score-default-header 'l))
 701         :selected (eq gnus-score-default-type '=)]
 702        ["Greater than number"
 703         (gnus-score-set-default 'gnus-score-default-type '>)
 704         :style radio
 705         ;; :active (eq (gnus-score-default-header 'l))
 706         :selected (eq gnus-score-default-type '>)])
 707       ["Default fold" gnus-score-default-fold-toggle
 708        :style toggle
 709        :selected gnus-score-default-fold]
 710       ("Default duration"
 711        ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
 712         :style radio
 713         :selected (null gnus-score-default-duration)]
 714        ["Permanent"
 715         (gnus-score-set-default 'gnus-score-default-duration 'p)
 716         :style radio
 717         :selected (eq gnus-score-default-duration 'p)]
 718        ["Temporary"
 719         (gnus-score-set-default 'gnus-score-default-duration 't)
 720         :style radio
 721         :selected (eq gnus-score-default-duration 't)]
 722        ["Immediate"
 723         (gnus-score-set-default 'gnus-score-default-duration 'i)
 724         :style radio
 725         :selected (eq gnus-score-default-duration 'i)]))
 726
 727     (easy-menu-define
 728      gnus-summary-article-menu gnus-summary-mode-map ""
 729      '("Article"
 730        ("Hide"
 731         ["All" gnus-article-hide t]
 732         ["Headers" gnus-article-hide-headers t]
 733         ["Signature" gnus-article-hide-signature t]
 734         ["Citation" gnus-article-hide-citation t]
 735         ["PGP" gnus-article-hide-pgp t]
 736         ["Boring headers" gnus-article-hide-boring-headers t])
 737        ("Highlight"
 738         ["All" gnus-article-highlight t]
 739         ["Headers" gnus-article-highlight-headers t]
 740         ["Signature" gnus-article-highlight-signature t]
 741         ["Citation" gnus-article-highlight-citation t])
 742        ("Date"
 743         ["Local" gnus-article-date-local t]
 744         ["UT" gnus-article-date-ut t]
 745         ["Original" gnus-article-date-original t]
 746         ["Lapsed" gnus-article-date-lapsed t])
 747        ("Filter"
 748         ["Overstrike" gnus-article-treat-overstrike t]
 749         ["Word wrap" gnus-article-fill-cited-article t]
 750         ["CR" gnus-article-remove-cr t]
 751         ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
 752         ["Show X-Face" gnus-article-display-x-face t]
 753         ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
 754         ["Rot 13" gnus-summary-caesar-message t]
 755         ["Add buttons" gnus-article-add-buttons t]
 756         ["Add buttons to head" gnus-article-add-buttons-to-head t]
 757         ["Stop page breaking" gnus-summary-stop-page-breaking t]
 758         ["Toggle MIME" gnus-summary-toggle-mime t]
 759         ["Verbose header" gnus-summary-verbose-headers t]
 760         ["Toggle header" gnus-summary-toggle-header t])
 761        ("Output"
 762         ["Save in default format" gnus-summary-save-article t]
 763         ["Save in file" gnus-summary-save-article-file t]
 764         ["Save in Unix mail format" gnus-summary-save-article-mail t]
 765         ["Save in MH folder" gnus-summary-save-article-folder t]
 766         ["Save in VM folder" gnus-summary-save-article-vm t]
 767         ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
 768         ["Save body in file" gnus-summary-save-article-body-file t]
 769         ["Pipe through a filter" gnus-summary-pipe-output t]
 770         ["Add to SOUP packet" gnus-soup-add-article t])
 771        ("Backend"
 772         ["Respool article..." gnus-summary-respool-article t]
 773         ["Move article..." gnus-summary-move-article
 774          (gnus-check-backend-function
 775           'request-move-article gnus-newsgroup-name)]
 776         ["Copy article..." gnus-summary-copy-article t]
 777         ["Crosspost article..." gnus-summary-crosspost-article
 778          (gnus-check-backend-function
 779           'request-replace-article gnus-newsgroup-name)]
 780         ["Import file..." gnus-summary-import-article t]
 781         ["Edit article" gnus-summary-edit-article
 782          (not (gnus-group-read-only-p))]
 783         ["Delete article" gnus-summary-delete-article
 784          (gnus-check-backend-function
 785           'request-expire-articles gnus-newsgroup-name)]
 786         ["Query respool" gnus-summary-respool-query t]
 787         ["Delete expirable articles" gnus-summary-expire-articles-now
 788          (gnus-check-backend-function
 789           'request-expire-articles gnus-newsgroup-name)])
 790        ("Extract"
 791         ["Uudecode" gnus-uu-decode-uu t]
 792         ["Uudecode and save" gnus-uu-decode-uu-and-save t]
 793         ["Unshar" gnus-uu-decode-unshar t]
 794         ["Unshar and save" gnus-uu-decode-unshar-and-save t]
 795         ["Save" gnus-uu-decode-save t]
 796         ["Binhex" gnus-uu-decode-binhex t]
 797         ["Postscript" gnus-uu-decode-postscript t])
 798        ["Enter digest buffer" gnus-summary-enter-digest-group t]
 799        ["Isearch article..." gnus-summary-isearch-article t]
 800        ["Search articles forward..." gnus-summary-search-article-forward t]
 801        ["Search articles backward..." gnus-summary-search-article-backward t]
 802        ["Beginning of the article" gnus-summary-beginning-of-article t]
 803        ["End of the article" gnus-summary-end-of-article t]
 804        ["Fetch parent of article" gnus-summary-refer-parent-article t]
 805        ["Fetch referenced articles" gnus-summary-refer-references&nb