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