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