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-load)
  30 (require 'gnus-ems)
  31 (require 'easymenu)
  32 (require 'custom)
  33 (require 'browse-url)
  34 (require 'gnus-score)
  35 (require 'gnus-art)
  36 (require 'gnus-group)
  37 (require 'gnus-range)
  38 (eval-when-compile (require 'cl))
  39
  40 (defvar gnus-group-menu-hook nil
  41   "*Hook run after the creation of the group mode menu.")
  42
  43 (defvar gnus-summary-menu-hook nil
  44   "*Hook run after the creation of the summary mode menu.")
  45
  46 (defvar gnus-article-menu-hook nil
  47   "*Hook run after the creation of the article mode menu.")
  48
  49 ;;; Summary highlights.
  50
  51 ;(defvar gnus-summary-highlight-properties
  52 ;  '((unread "ForestGreen" "green")
  53 ;    (ticked "Firebrick" "pink")
  54 ;    (read "black" "white")
  55 ;    (low italic italic)
  56 ;    (high bold bold)
  57 ;    (canceled "yellow/black" "black/yellow")))
  58
  59 ;(defvar gnus-summary-highlight-translation
  60 ;  '(((unread (= mark gnus-unread-mark))
  61 ;     (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
  62 ;     (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
  63 ;                   (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
  64 ;     (canceled (= mark gnus-canceled-mark)))
  65 ;    ((low (< score gnus-summary-default-score))
  66 ;     (high (> score gnus-summary-default-score)))))
  67
  68 ;(defun gnus-visual-map-face-translation ()
  69 ;  (let ((props gnus-summary-highlight-properties)
  70 ;       (trans gnus-summary-highlight-translation)
  71 ;       map)
  72 ;    (while props)))
  73
  74 ;see gnus-cus.el
  75 ;(defvar gnus-summary-selected-face 'underline
  76 ;  "*Face used for highlighting the current article in the summary buffer.")
  77
  78 ;see gnus-cus.el
  79 ;(defvar gnus-summary-highlight
  80 ;  (cond ((not (eq gnus-display-type 'color))
  81 ;        '(((> score default) . bold)
  82 ;          ((< score default) . italic)))
  83 ;       ((eq gnus-background-mode 'dark)
  84 ;        (list (cons '(= mark gnus-canceled-mark)
  85 ;                    (custom-face-lookup "yellow" "black" nil nil nil nil))
  86 ;              (cons '(and (> score default)
  87 ;                          (or (= mark gnus-dormant-mark)
  88 ;                              (= mark gnus-ticked-mark)))
  89 ;                    (custom-face-lookup "pink" nil nil t nil nil))
  90 ;              (cons '(and (< score default)
  91 ;                          (or (= mark gnus-dormant-mark)
  92 ;                              (= mark gnus-ticked-mark)))
  93 ;                    (custom-face-lookup "pink" nil nil nil t nil))
  94 ;              (cons '(or (= mark gnus-dormant-mark)
  95 ;                         (= mark gnus-ticked-mark))
  96 ;                    (custom-face-lookup "pink" nil nil nil nil nil))
  97
  98 ;              (cons '(and (> score default) (= mark gnus-ancient-mark))
  99 ;                    (custom-face-lookup "SkyBlue" nil nil t nil nil))
 100 ;              (cons '(and (< score default) (= mark gnus-ancient-mark))
 101 ;                    (custom-face-lookup "SkyBlue" nil nil nil t nil))
 102 ;              (cons '(= mark gnus-ancient-mark)
 103 ;                    (custom-face-lookup "SkyBlue" nil nil nil nil nil))
 104
 105 ;              (cons '(and (> score default) (= mark gnus-unread-mark))
 106 ;                    (custom-face-lookup "white" nil nil t nil nil))
 107 ;              (cons '(and (< score default) (= mark gnus-unread-mark))
 108 ;                    (custom-face-lookup "white" nil nil nil t nil))
 109 ;              (cons '(= mark gnus-unread-mark)
 110 ;                    (custom-face-lookup "white" nil nil nil nil nil))
 111
 112 ;              (cons '(> score default) 'bold)
 113 ;              (cons '(< score default) 'italic)))
 114 ;       (t
 115 ;        (list (cons '(= mark gnus-canceled-mark)
 116 ;                    (custom-face-lookup "yellow" "black" nil nil nil nil))
 117 ;              (cons '(and (> score default)
 118 ;                          (or (= mark gnus-dormant-mark)
 119 ;                              (= mark gnus-ticked-mark)))
 120 ;                    (custom-face-lookup "firebrick" nil nil t nil nil))
 121 ;              (cons '(and (< score default)
 122 ;                          (or (= mark gnus-dormant-mark)
 123 ;                              (= mark gnus-ticked-mark)))
 124 ;                    (custom-face-lookup "firebrick" nil nil nil t nil))
 125 ;              (cons '(or (= mark gnus-dormant-mark)
 126 ;                         (= mark gnus-ticked-mark))
 127 ;                    (custom-face-lookup "firebrick" nil nil nil nil nil))
 128
 129 ;              (cons '(and (> score default) (= mark gnus-ancient-mark))
 130 ;                    (custom-face-lookup "RoyalBlue" nil nil t nil nil))
 131 ;              (cons '(and (< score default) (= mark gnus-ancient-mark))
 132 ;                    (custom-face-lookup "RoyalBlue" nil nil nil t nil))
 133 ;              (cons '(= mark gnus-ancient-mark)
 134 ;                    (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
 135
 136 ;              (cons '(and (> score default) (/= mark gnus-unread-mark))
 137 ;                    (custom-face-lookup "DarkGreen" nil nil t nil nil))
 138 ;              (cons '(and (< score default) (/= mark gnus-unread-mark))
 139 ;                    (custom-face-lookup "DarkGreen" nil nil nil t nil))
 140 ;              (cons '(/= mark gnus-unread-mark)
 141 ;                    (custom-face-lookup "DarkGreen" nil nil nil nil nil))
 142
 143 ;              (cons '(> score default) 'bold)
 144 ;              (cons '(< score default) 'italic))))
 145 ;  "*Alist of `(FORM . FACE)'.
 146 ;Summary lines are highlighted with the FACE for the first FORM which
 147 ;evaluate to a non-nil value.
 148
 149 ;Point will be at the beginning of the line when FORM is evaluated.
 150 ;The following can be used for convenience:
 151
 152 ;score:   (gnus-summary-article-score)
 153 ;default: gnus-summary-default-score
 154 ;below:   gnus-summary-mark-below
 155 ;mark:    (gnus-summary-article-mark)
 156
 157 ;The latter can be used like this:
 158 ;   ((= mark gnus-replied-mark) . underline)")
 159
 160 ;;; article highlights
 161
 162 ;see gnus-cus.el
 163 ;(defvar gnus-header-face-alist
 164 ;  (cond ((not (eq gnus-display-type 'color))
 165 ;        '(("" bold italic)))
 166 ;       ((eq gnus-background-mode 'dark)
 167 ;        (list (list "From" nil
 168 ;                    (custom-face-lookup "SkyBlue" nil nil t t nil))
 169 ;              (list "Subject" nil
 170 ;                    (custom-face-lookup "pink" nil nil t t nil))
 171 ;              (list "Newsgroups:.*," nil
 172 ;                    (custom-face-lookup "yellow" nil nil t t nil))
 173 ;              (list ""
 174 ;                    (custom-face-lookup "cyan" nil nil t nil nil)
 175 ;                    (custom-face-lookup "green" nil nil nil t nil))))
 176 ;       (t
 177 ;        (list (list "From" nil
 178 ;                    (custom-face-lookup "RoyalBlue" nil nil t t nil))
 179 ;              (list "Subject" nil
 180 ;                    (custom-face-lookup "firebrick" nil nil t t nil))
 181 ;              (list "Newsgroups:.*," nil
 182 ;                    (custom-face-lookup "red" nil nil t t nil))
 183 ;              (list ""
 184 ;                    (custom-face-lookup "DarkGreen" nil nil t nil nil)
 185 ;                    (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
 186 ;  "Alist of headers and faces used for highlighting them.
 187 ;The entries in the list has the form `(REGEXP NAME CONTENT)', where
 188 ;REGEXP is a regular expression matching the beginning of the header,
 189 ;NAME is the face used for highlighting the header name and CONTENT is
 190 ;the face used for highlighting the header content.
 191
 192 ;The first non-nil NAME or CONTENT with a matching REGEXP in the list
 193 ;will be used.")
 194
 195
 196 ;see gnus-cus.el
 197 ;(defvar gnus-make-foreground t
 198 ;  "Non nil means foreground color to highlight citations.")
 199
 200 ;see gnus-cus.el
 201 ;(defvar gnus-article-button-face 'bold
 202 ;  "Face used for text buttons.")
 203
 204 ;see gnus-cus.el
 205 ;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
 206 ;                                   gnus-mouse-face
 207 ;                                 'highlight)
 208 ;  "Face used when the mouse is over the button.")
 209
 210 ;see gnus-cus.el
 211 ;(defvar gnus-signature-face 'italic
 212 ;  "Face used for signature.")
 213
 214 (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_=#$@~`%&*+|\\/]"
 215   "*Regular expression that matches URLs.")
 216
 217 (defvar gnus-button-alist
 218   `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
 219      t gnus-button-message-id 3)
 220     ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
 221      gnus-button-message-id 3)
 222     ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
 223     ;; This is how URLs _should_ be embedded in text...
 224     ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
 225     ;; Next regexp stolen from highlight-headers.el.
 226     ;; Modified by Vladimir Alexiev.
 227     (,gnus-button-url-regexp 0 t gnus-button-url 0))
 228   "Alist of regexps matching buttons in article bodies.
 229
 230 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 231 REGEXP: is the string matching text around the button,
 232 BUTTON: is the number of the regexp grouping actually matching the button,
 233 FORM: is a lisp expression which must eval to true for the button to
 234 be added,
 235 CALLBACK: is the function to call when the user push this button, and each
 236 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 237
 238 CALLBACK can also be a variable, in that case the value of that
 239 variable it the real callback function.")
 240
 241 (defvar gnus-header-button-alist
 242   `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
 243      0 t gnus-button-message-id 0)
 244     ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
 245     ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
 246      0 t gnus-button-mailto 0)
 247     ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
 248     ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
 249     ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
 250      gnus-button-message-id 3))
 251   "Alist of headers and regexps to match buttons in article heads.
 252
 253 This alist is very similar to `gnus-button-alist', except that each
 254 alist has an additional HEADER element first in each entry:
 255
 256 \(HEADER REGEXP BUTTON FORM CALLBACK PAR)
 257
 258 HEADER is a regexp to match a header.  For a fuller explanation, see
 259 `gnus-button-alist'.")
 260
 261 ;see gnus-cus.el
 262 ;(eval-when-compile
 263 ;  (defvar browse-url-browser-function))
 264
 265 ;;; Group mode highlighting.
 266
 267 ;see gnus-cus.el
 268 ;(defvar gnus-group-highlight nil
 269 ;  "Group lines are highlighted with the FACE for the first FORM which
 270 ;evaluate to a non-nil value.
 271 ;
 272 ;Point will be at the beginning of the line when FORM is evaluated.
 273 ;Variables bound when these forms are evaluated include:
 274 ;
 275 ;group: The group name.
 276 ;unread: The number of unread articles.
 277 ;method: The select method.
 278 ;mailp: Whether the select method is a mail method.
 279 ;level: The level of the group.
 280 ;score: The score of the group.
 281 ;ticked: The number of ticked articles in the group.
 282 ;")
 283
 284
 285 ;;; Internal variables.
 286
 287 (defvar gnus-button-marker-list nil)
 288
 289 \f
 290
 291 (eval-and-compile
 292   (autoload 'nnkiboze-generate-groups "nnkiboze")
 293   (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
 294
 295 ;;;
 296 ;;; gnus-menu
 297 ;;;
 298
 299 (defun gnus-visual-turn-off-edit-menu (type)
 300   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
 301     [menu-bar edit] 'undefined))
 302
 303 ;; Newsgroup buffer
 304
 305 (defun gnus-group-make-menu-bar ()
 306   (gnus-visual-turn-off-edit-menu 'group)
 307   (unless (boundp 'gnus-group-reading-menu)
 308
 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 a 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        ["Edit global kill file" gnus-group-edit-global-kill t]
 452        ["Read manual" gnus-info-find-node t]
 453        ["Toggle topics" gnus-topic-mode t]
 454        ("SOUP"
 455         ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
 456         ["Send replies" gnus-soup-send-replies
 457          (fboundp 'gnus-soup-pack-packet)]
 458         ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
 459         ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
 460         ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
 461        ["Exit from Gnus" gnus-group-exit t]
 462        ["Exit without saving" gnus-group-quit t]
 463        ))
 464
 465     (run-hooks 'gnus-group-menu-hook)
 466     ))
 467
 468 ;; Summary buffer
 469 (defun gnus-summary-make-menu-bar ()
 470   (gnus-visual-turn-off-edit-menu 'summary)
 471
 472   (unless (boundp 'gnus-summary-misc-menu)
 473
 474     (easy-menu-define
 475      gnus-summary-kill-menu gnus-summary-mode-map ""
 476      (cons
 477       "Score"
 478       (nconc
 479        (list
 480         ["Enter score..." gnus-summary-score-entry t])
 481        (gnus-visual-score-map 'increase)
 482        (gnus-visual-score-map 'lower)
 483        '(("Mark"
 484           ["Kill below" gnus-summary-kill-below t]
 485           ["Mark above" gnus-summary-mark-above t]
 486           ["Tick above" gnus-summary-tick-above t]
 487           ["Clear above" gnus-summary-clear-above t])
 488          ["Current score" gnus-summary-current-score t]
 489          ["Set score" gnus-summary-set-score t]
 490          ["Customize score file" gnus-score-customize t]
 491          ["Switch current score file..." gnus-score-change-score-file t]
 492          ["Set mark below..." gnus-score-set-mark-below t]
 493          ["Set expunge below..." gnus-score-set-expunge-below t]
 494          ["Edit current score file" gnus-score-edit-current-scores t]
 495          ["Edit score file" gnus-score-edit-file t]
 496          ["Trace score" gnus-score-find-trace t]
 497          ["Rescore buffer" gnus-summary-rescore t]
 498          ["Increase score..." gnus-summary-increase-score t]
 499          ["Lower score..." gnus-summary-lower-score t]))))
 500
 501     '(("Default header"
 502        ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
 503         :style radio
 504         :selected (null gnus-score-default-header)]
 505        ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
 506         :style radio
 507         :selected (eq gnus-score-default-header 'a)]
 508        ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
 509         :style radio
 510         :selected (eq gnus-score-default-header 's)]
 511        ["Article body"
 512         (gnus-score-set-default 'gnus-score-default-header 'b)
 513         :style radio
 514         :selected (eq gnus-score-default-header 'b )]
 515        ["All headers"
 516         (gnus-score-set-default 'gnus-score-default-header 'h)
 517         :style radio
 518         :selected (eq gnus-score-default-header 'h )]
 519        ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
 520         :style radio
 521         :selected (eq gnus-score-default-header 'i )]
 522        ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
 523         :style radio
 524         :selected (eq gnus-score-default-header 't )]
 525        ["Crossposting"
 526         (gnus-score-set-default 'gnus-score-default-header 'x)
 527         :style radio
 528         :selected (eq gnus-score-default-header 'x )]
 529        ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
 530         :style radio
 531         :selected (eq gnus-score-default-header 'l )]
 532        ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
 533         :style radio
 534         :selected (eq gnus-score-default-header 'd )]
 535        ["Followups to author"
 536         (gnus-score-set-default 'gnus-score-default-header 'f)
 537         :style radio
 538         :selected (eq gnus-score-default-header 'f )])
 539       ("Default type"
 540        ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
 541         :style radio
 542         :selected (null gnus-score-default-type)]
 543        ;; The `:active' key is commented out in the following,
 544        ;; because the GNU Emacs hack to support radio buttons use
 545        ;; active to indicate which button is selected.
 546        ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
 547         :style radio
 548         ;; :active (not (memq gnus-score-default-header '(l d)))
 549         :selected (eq gnus-score-default-type 's)]
 550        ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
 551         :style radio
 552         ;; :active (not (memq gnus-score-default-header '(l d)))
 553         :selected (eq gnus-score-default-type 'r)]
 554        ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
 555         :style radio
 556         ;; :active (not (memq gnus-score-default-header '(l d)))
 557         :selected (eq gnus-score-default-type 'e)]
 558        ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
 559         :style radio
 560         ;; :active (not (memq gnus-score-default-header '(l d)))
 561         :selected (eq gnus-score-default-type 'f)]
 562        ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
 563         :style radio
 564         ;; :active (eq (gnus-score-default-header 'd))
 565         :selected (eq gnus-score-default-type 'b)]
 566        ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
 567         :style radio
 568         ;; :active (eq (gnus-score-default-header 'd))
 569         :selected (eq gnus-score-default-type 'n)]
 570        ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
 571         :style radio
 572         ;; :active (eq (gnus-score-default-header 'd))
 573         :selected (eq gnus-score-default-type 'a)]
 574        ["Less than number"
 575         (gnus-score-set-default 'gnus-score-default-type '<)
 576         :style radio
 577         ;; :active (eq (gnus-score-default-header 'l))
 578         :selected (eq gnus-score-default-type '<)]
 579        ["Equal to number"
 580         (gnus-score-set-default 'gnus-score-default-type '=)
 581         :style radio
 582         ;; :active (eq (gnus-score-default-header 'l))
 583         :selected (eq gnus-score-default-type '=)]
 584        ["Greater than number"
 585         (gnus-score-set-default 'gnus-score-default-type '>)
 586         :style radio
 587         ;; :active (eq (gnus-score-default-header 'l))
 588         :selected (eq gnus-score-default-type '>)])
 589       ["Default fold" gnus-score-default-fold-toggle
 590        :style toggle
 591        :selected gnus-score-default-fold]
 592       ("Default duration"
 593        ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
 594         :style radio
 595         :selected (null gnus-score-default-duration)]
 596        ["Permanent"
 597         (gnus-score-set-default 'gnus-score-default-duration 'p)
 598         :style radio
 599         :selected (eq gnus-score-default-duration 'p)]
 600        ["Temporary"
 601         (gnus-score-set-default 'gnus-score-default-duration 't)
 602         :style radio
 603         :selected (eq gnus-score-default-duration 't)]
 604        ["Immediate"
 605         (gnus-score-set-default 'gnus-score-default-duration 'i)
 606         :style radio
 607         :selected (eq gnus-score-default-duration 'i)]))
 608
 609     (easy-menu-define
 610      gnus-summary-article-menu gnus-summary-mode-map ""
 611      '("Article"
 612        ("Hide"
 613         ["All" gnus-article-hide t]
 614         ["Headers" gnus-article-hide-headers t]
 615         ["Signature" gnus-article-hide-signature t]
 616         ["Citation" gnus-article-hide-citation t]
 617         ["PGP" gnus-article-hide-pgp t]
 618         ["Boring headers" gnus-article-hide-boring-headers t])
 619        ("Highlight"
 620         ["All" gnus-article-highlight t]
 621         ["Headers" gnus-article-highlight-headers t]
 622         ["Signature" gnus-article-highlight-signature t]
 623         ["Citation" gnus-article-highlight-citation t])
 624        ("Date"
 625         ["Local" gnus-article-date-local t]
 626         ["UT" gnus-article-date-ut t]
 627         ["Original" gnus-article-date-original t]
 628         ["Lapsed" gnus-article-date-lapsed t])
 629        ("Filter"
 630         ["Overstrike" gnus-article-treat-overstrike t]
 631         ["Emphasis" gnus-article-emphasize t]
 632         ["Word wrap" gnus-article-fill-cited-article t]
 633         ["CR" gnus-article-remove-cr t]
 634         ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
 635         ["Show X-Face" gnus-article-display-x-face t]
 636         ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
 637         ["Rot 13" gnus-summary-caesar-message t]
 638         ["Add buttons" gnus-article-add-buttons t]
 639         ["Add buttons to head" gnus-article-add-buttons-to-head t]
 640         ["Stop page breaking" gnus-summary-stop-page-breaking t]
 641         ["Toggle MIME" gnus-summary-toggle-mime t]
 642         ["Verbose header" gnus-summary-verbose-headers t]
 643         ["Toggle header" gnus-summary-toggle-header t])
 644        ("Output"
 645         ["Save in default format" gnus-summary-save-article t]
 646         ["Save in file" gnus-summary-save-article-file t]
 647         ["Save in Unix mail format" gnus-summary-save-article-mail t]
 648         ["Save in MH folder" gnus-summary-save-article-folder t]
 649         ["Save in VM folder" gnus-summary-save-article-vm t]
 650         ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
 651         ["Save body in file" gnus-summary-save-article-body-file t]
 652         ["Pipe through a filter" gnus-summary-pipe-output t]
 653         ["Add to SOUP packet" gnus-soup-add-article t])
 654        ("Backend"
 655         ["Respool article..." gnus-summary-respool-article t]
 656         ["Move article..." gnus-summary-move-article
 657          (gnus-check-backend-function
 658           'request-move-article gnus-newsgroup-name)]
 659         ["Copy article..." gnus-summary-copy-article t]
 660         ["Crosspost article..." gnus-summary-crosspost-article
 661          (gnus-check-backend-function
 662           'request-replace-article gnus-newsgroup-name)]
 663         ["Import file..." gnus-summary-import-article t]
 664         ["Edit article" gnus-summary-edit-article
 665          (not (gnus-group-read-only-p))]
 666         ["Delete article" gnus-summary-delete-article
 667          (gnus-check-backend-function
 668           'request-expire-articles gnus-newsgroup-name)]
 669         ["Query respool" gnus-summary-respool-query t]
 670         ["Delete expirable articles" gnus-summary-expire-articles-now
 671          (gnus-check-backend-function
 672           'request-expire-articles gnus-newsgroup-name)])
 673        ("Extract"
 674         ["Uudecode" gnus-uu-decode-uu t]
 675         ["Uudecode and save" gnus-uu-decode-uu-and-save t]
 676         ["Unshar" gnus-uu-decode-unshar t]
 677         ["Unshar and save" gnus-uu-decode-unshar-and-save t]
 678         ["Save" gnus-uu-decode-save t]
 679         ["Binhex" gnus-uu-decode-binhex t]
 680         ["Postscript" gnus-uu-decode-postscript t])
 681        ["Enter digest buffer" gnus-summary-enter-digest-group t]
 682        ["Isearch article..." gnus-summary-isearch-article t]
 683        ["Search articles forward..." gnus-summary-search-article-forward t]
 684        ["Search articles backward..." gnus-summary-search-article-backward t]
 685        ["Beginning of the article" gnus-summary-beginning-of-article t]
 686        ["End of the article" gnus-summary-end-of-article t]
 687        ["Fetch parent of article" gnus-summary-refer-parent-article t]
 688        ["Fetch referenced articles" gnus-summary-refer-references t]
 689        ["Fetch article with id..." gnus-summary-refer-article t]
 690        ["Redisplay" gnus-summary-show-article t]))
 691
 692     (easy-menu-define
 693      gnus-summary-thread-menu gnus-summary-mode-map ""
 694      '("Threads"
 695        ["Toggle threading" gnus-summary-toggle-threads t]
 696        ["Hide threads" gnus-summary-hide-all-threads t]
 697        ["Show threads" gnus-summary-show-all-threads t]
 698        ["Hide thread" gnus-summary-hide-thread t]
 699        ["Show thread" gnus-summary-show-thread t]
 700        ["Go to next thread" gnus-summary-next-thread t]
 701        ["Go to previous thread" gnus-summary-prev-thread t]
 702        ["Go down thread" gnus-summary-down-thread t]
 703        ["Go up thread" gnus-summary-up-thread t]
 704        ["Top of thread" gnus-summary-top-thread t]
 705        ["Mark thread as read" gnus-summary-kill-thread t]
 706        ["Lower thread score" gnus-summary-lower-thread t]
 707        ["Raise thread score" gnus-summary-raise-thread t]
 708        ["Rethread current" gnus-summary-rethread-current t]
 709        ))
 710
 711     (easy-menu-define
 712      gnus-summary-post-menu gnus-summary-mode-map ""
 713      '("Post"
 714        ["Post an article" gnus-summary-post-news t]
 715        ["Followup" gnus-summary-followup t]
 716        ["Followup and yank" gnus-summary-followup-with-original t]
 717        ["Supersede article" gnus-summary-supersede-article t]
 718        ["Cancel article" gnus-summary-cancel-article t]
 719        ["Reply" gnus-summary-reply t]
 720        ["Reply and yank" gnus-summary-reply-with-original t]
 721        ["Mail forward" gnus-summary-mail-forward t]
 722        ["Post forward" gnus-summary-post-forward t]
 723        ["Digest and mail" gnus-uu-digest-mail-forward t]
 724        ["Digest and post" gnus-uu-digest-post-forward t]
 725        ["Resend message" gnus-summary-resend-message t]
 726        ["Send bounced mail" gnus-summary-resend-bounced-mail t]
 727        ["Send a mail" gnus-summary-mail-other-window t]
 728        ["Uuencode and post" gnus-uu-post-news t]
 729        ;;("Draft"
 730        ;;["Send" gnus-summary-send-draft t]
 731        ;;["Send bounced" gnus-resend-bounced-mail t])
 732        ))
 733
 734     (easy-menu-define
 735      gnus-summary-misc-menu gnus-summary-mode-map ""
 736      '("Misc"
 737        ("Mark"
 738         ("Read"
 739          ["Mark as read" gnus-summary-mark-as-read-forward t]
 740          ["Mark same subject and select"
 741           gnus-summary-kill-same-subject-and-select t]
 742          ["Mark same subject" gnus-summary-kill-same-subject t]
 743          ["Catchup" gnus-summary-catchup t]
 744          ["Catchup all" gnus-summary-catchup-all t]
 745          ["Catchup to here" gnus-summary-catchup-to-here t]
 746          ["Catchup region" gnus-summary-mark-region-as-read t]
 747          ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
 748         ("Various"
 749          ["Tick" gnus-summary-tick-article-forward t]
 750          ["Mark as dormant" gnus-summary-mark-as-dormant t]
 7