1;;; gnus.el --- a newsreader for GNU Emacs -*- lexical-binding:t -*- 2 3;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software 4;; Foundation, Inc. 5 6;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7;; Lars Magne Ingebrigtsen <larsi@gnus.org> 8;; Keywords: news, mail 9;; Version: 5.13 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software: you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation, either version 3 of the License, or 16;; (at your option) any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 26;;; Commentary: 27 28;;; Code: 29 30(run-hooks 'gnus-load-hook) 31 32(eval-when-compile (require 'cl-lib) 33 (require 'subr-x)) 34(require 'wid-edit) 35(require 'mm-util) 36(require 'nnheader) 37(require 'seq) 38 39;; These are defined afterwards with gnus-define-group-parameter 40(defvar gnus-ham-process-destinations) 41(defvar gnus-parameter-ham-marks-alist) 42(defvar gnus-parameter-spam-marks-alist) 43(defvar gnus-spam-autodetect) 44(defvar gnus-spam-autodetect-methods) 45(defvar gnus-spam-newsgroup-contents) 46(defvar gnus-spam-process-destinations) 47(defvar gnus-spam-resend-to) 48(defvar gnus-ham-resend-to) 49(defvar gnus-spam-process-newsgroups) 50 51 52(defgroup gnus nil 53 "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." 54 :group 'news 55 :group 'mail) 56 57(defgroup gnus-start nil 58 "Starting your favorite newsreader." 59 :group 'gnus) 60 61(defgroup gnus-format nil 62 "Dealing with formatting issues." 63 :group 'gnus) 64 65(defgroup gnus-charset nil 66 "Group character set issues." 67 :link '(custom-manual "(gnus)Charsets") 68 :version "21.1" 69 :group 'gnus) 70 71(defgroup gnus-cache nil 72 "Cache interface." 73 :link '(custom-manual "(gnus)Article Caching") 74 :group 'gnus) 75 76(defgroup gnus-registry nil 77 "Article Registry." 78 :group 'gnus) 79 80(defgroup gnus-start-server nil 81 "Server options at startup." 82 :group 'gnus-start) 83 84;; These belong to gnus-group.el. 85(defgroup gnus-group nil 86 "Group buffers." 87 :link '(custom-manual "(gnus)Group Buffer") 88 :group 'gnus) 89 90(defgroup gnus-group-foreign nil 91 "Foreign groups." 92 :link '(custom-manual "(gnus)Foreign Groups") 93 :group 'gnus-group) 94 95(defgroup gnus-group-new nil 96 "Automatic subscription of new groups." 97 :group 'gnus-group) 98 99(defgroup gnus-group-levels nil 100 "Group levels." 101 :link '(custom-manual "(gnus)Group Levels") 102 :group 'gnus-group) 103 104(defgroup gnus-group-select nil 105 "Selecting a Group." 106 :link '(custom-manual "(gnus)Selecting a Group") 107 :group 'gnus-group) 108 109(defgroup gnus-group-listing nil 110 "Showing slices of the group list." 111 :link '(custom-manual "(gnus)Listing Groups") 112 :group 'gnus-group) 113 114(defgroup gnus-group-visual nil 115 "Sorting the group buffer." 116 :link '(custom-manual "(gnus)Group Buffer Format") 117 :group 'gnus-group 118 :group 'gnus-visual) 119 120(defgroup gnus-group-various nil 121 "Various group options." 122 :link '(custom-manual "(gnus)Scanning New Messages") 123 :group 'gnus-group) 124 125;; These belong to gnus-sum.el. 126(defgroup gnus-summary nil 127 "Summary buffers." 128 :link '(custom-manual "(gnus)Summary Buffer") 129 :group 'gnus) 130 131(defgroup gnus-summary-exit nil 132 "Leaving summary buffers." 133 :link '(custom-manual "(gnus)Exiting the Summary Buffer") 134 :group 'gnus-summary) 135 136(defgroup gnus-summary-marks nil 137 "Marks used in summary buffers." 138 :link '(custom-manual "(gnus)Marking Articles") 139 :group 'gnus-summary) 140 141(defgroup gnus-thread nil 142 "Ordering articles according to replies." 143 :link '(custom-manual "(gnus)Threading") 144 :group 'gnus-summary) 145 146(defgroup gnus-summary-format nil 147 "Formatting of the summary buffer." 148 :link '(custom-manual "(gnus)Summary Buffer Format") 149 :group 'gnus-summary) 150 151(defgroup gnus-summary-choose nil 152 "Choosing Articles." 153 :link '(custom-manual "(gnus)Choosing Articles") 154 :group 'gnus-summary) 155 156(defgroup gnus-summary-maneuvering nil 157 "Summary movement commands." 158 :link '(custom-manual "(gnus)Summary Maneuvering") 159 :group 'gnus-summary) 160 161(defgroup gnus-picon nil 162 "Show pictures of people, domains, and newsgroups." 163 :group 'gnus-visual) 164 165(defgroup gnus-summary-mail nil 166 "Mail group commands." 167 :link '(custom-manual "(gnus)Mail Group Commands") 168 :group 'gnus-summary) 169 170(defgroup gnus-summary-sort nil 171 "Sorting the summary buffer." 172 :link '(custom-manual "(gnus)Sorting the Summary Buffer") 173 :group 'gnus-summary) 174 175(defgroup gnus-summary-visual nil 176 "Highlighting and menus in the summary buffer." 177 :link '(custom-manual "(gnus)Summary Highlighting") 178 :group 'gnus-visual 179 :group 'gnus-summary) 180 181(defgroup gnus-summary-various nil 182 "Various summary buffer options." 183 :link '(custom-manual "(gnus)Various Summary Stuff") 184 :group 'gnus-summary) 185 186(defgroup gnus-summary-pick nil 187 "Pick mode in the summary buffer." 188 :link '(custom-manual "(gnus)Pick and Read") 189 :prefix "gnus-pick-" 190 :group 'gnus-summary) 191 192(defgroup gnus-summary-tree nil 193 "Tree display of threads in the summary buffer." 194 :link '(custom-manual "(gnus)Tree Display") 195 :prefix "gnus-tree-" 196 :group 'gnus-summary) 197 198;; Belongs to gnus-uu.el 199(defgroup gnus-extract-view nil 200 "Viewing extracted files." 201 :link '(custom-manual "(gnus)Viewing Files") 202 :group 'gnus-extract) 203 204;; Belongs to gnus-score.el 205(defgroup gnus-score nil 206 "Score and kill file handling." 207 :group 'gnus) 208 209(defgroup gnus-score-kill nil 210 "Kill files." 211 :group 'gnus-score) 212 213(defgroup gnus-score-adapt nil 214 "Adaptive score files." 215 :group 'gnus-score) 216 217(defgroup gnus-score-default nil 218 "Default values for score files." 219 :group 'gnus-score) 220 221(defgroup gnus-score-expire nil 222 "Expiring score rules." 223 :group 'gnus-score) 224 225(defgroup gnus-score-decay nil 226 "Decaying score rules." 227 :group 'gnus-score) 228 229(defgroup gnus-score-files nil 230 "Score and kill file names." 231 :group 'gnus-score 232 :group 'gnus-files) 233 234(defgroup gnus-score-various nil 235 "Various scoring and killing options." 236 :group 'gnus-score) 237 238;; Other 239(defgroup gnus-visual nil 240 "Options controlling the visual fluff." 241 :group 'gnus 242 :group 'faces) 243 244(defgroup gnus-agent nil 245 "Offline support for Gnus." 246 :group 'gnus) 247 248(defgroup gnus-files nil 249 "Files used by Gnus." 250 :group 'gnus) 251 252(defgroup gnus-dribble-file nil 253 "Auto save file." 254 :link '(custom-manual "(gnus)Auto Save") 255 :group 'gnus-files) 256 257(defgroup gnus-newsrc nil 258 "Storing Gnus state." 259 :group 'gnus-files) 260 261(defgroup gnus-server nil 262 "Options related to newsservers and other servers used by Gnus." 263 :group 'gnus) 264 265(defgroup gnus-server-visual nil 266 "Highlighting and menus in the server buffer." 267 :group 'gnus-visual 268 :group 'gnus-server) 269 270(defgroup gnus-message '((message custom-group)) 271 "Composing replies and followups in Gnus." 272 :group 'gnus) 273 274(defgroup gnus-meta nil 275 "Meta variables controlling major portions of Gnus. 276In general, modifying these variables does not take effect until Gnus 277is restarted, and sometimes reloaded." 278 :group 'gnus) 279 280(defgroup gnus-various nil 281 "Other Gnus options." 282 :link '(custom-manual "(gnus)Various Various") 283 :group 'gnus) 284 285(defgroup gnus-exit nil 286 "Exiting Gnus." 287 :link '(custom-manual "(gnus)Exiting Gnus") 288 :group 'gnus) 289 290(defgroup gnus-fun nil 291 "Frivolous Gnus extensions." 292 :link '(custom-manual "(gnus)Exiting Gnus") 293 :group 'gnus) 294 295(defgroup gnus-dbus nil 296 "D-Bus integration for Gnus." 297 :group 'gnus) 298 299(defconst gnus-version-number "5.13" 300 "Version number for this version of Gnus.") 301 302(defconst gnus-version (format "Gnus v%s" gnus-version-number) 303 "Version string for this version of Gnus.") 304 305(defcustom gnus-inhibit-startup-message nil 306 "If non-nil, the startup message will not be displayed. 307This variable is used before `.gnus.el' is loaded, so it should 308be set in `.emacs' instead." 309 :group 'gnus-start 310 :type 'boolean) 311 312(defun gnus-mode-line-buffer-identification (line) 313 (let ((str (car-safe line))) 314 (if (or (not (fboundp 'find-image)) 315 (not (display-graphic-p)) 316 (not (stringp str)) 317 (not (string-match "^Gnus:" str))) 318 line 319 (let ((load-path (append (mm-image-load-path) load-path))) 320 ;; Add the Gnus logo. 321 (add-text-properties 322 0 5 323 (list 'display 324 (find-image 325 '((:type xpm :file "gnus-pointer.xpm" 326 :ascent center) 327 (:type xbm :file "gnus-pointer.xbm" 328 :ascent center)) 329 t) 330 'help-echo (format 331 "This is %s, %s." 332 gnus-version (gnus-emacs-version))) 333 str) 334 (list str))))) 335 336;; We define these group faces here to avoid the display 337;; update forced when creating new faces. 338 339(defface gnus-group-news-1-empty 340 '((((class color) 341 (background dark)) 342 (:foreground "PaleTurquoise")) 343 (((class color) 344 (background light)) 345 (:foreground "ForestGreen")) 346 (t 347 ())) 348 "Level 1 empty newsgroup face." 349 :group 'gnus-group) 350 351(defface gnus-group-news-1 352 '((t (:inherit gnus-group-news-1-empty :bold t))) 353 "Level 1 newsgroup face." 354 :group 'gnus-group) 355 356(defface gnus-group-news-2-empty 357 '((((class color) 358 (background dark)) 359 (:foreground "turquoise")) 360 (((class color) 361 (background light)) 362 (:foreground "CadetBlue4")) 363 (t 364 ())) 365 "Level 2 empty newsgroup face." 366 :group 'gnus-group) 367 368(defface gnus-group-news-2 369 '((t (:inherit gnus-group-news-2-empty :bold t))) 370 "Level 2 newsgroup face." 371 :group 'gnus-group) 372 373(defface gnus-group-news-3-empty 374 '((((class color) 375 (background dark)) 376 ()) 377 (((class color) 378 (background light)) 379 ()) 380 (t 381 ())) 382 "Level 3 empty newsgroup face." 383 :group 'gnus-group) 384 385(defface gnus-group-news-3 386 '((t (:inherit gnus-group-news-3-empty :bold t))) 387 "Level 3 newsgroup face." 388 :group 'gnus-group) 389 390(defface gnus-group-news-4-empty 391 '((((class color) 392 (background dark)) 393 ()) 394 (((class color) 395 (background light)) 396 ()) 397 (t 398 ())) 399 "Level 4 empty newsgroup face." 400 :group 'gnus-group) 401 402(defface gnus-group-news-4 403 '((t (:inherit gnus-group-news-4-empty :bold t))) 404 "Level 4 newsgroup face." 405 :group 'gnus-group) 406 407(defface gnus-group-news-5-empty 408 '((((class color) 409 (background dark)) 410 ()) 411 (((class color) 412 (background light)) 413 ()) 414 (t 415 ())) 416 "Level 5 empty newsgroup face." 417 :group 'gnus-group) 418 419(defface gnus-group-news-5 420 '((t (:inherit gnus-group-news-5-empty :bold t))) 421 "Level 5 newsgroup face." 422 :group 'gnus-group) 423 424(defface gnus-group-news-6-empty 425 '((((class color) 426 (background dark)) 427 ()) 428 (((class color) 429 (background light)) 430 ()) 431 (t 432 ())) 433 "Level 6 empty newsgroup face." 434 :group 'gnus-group) 435 436(defface gnus-group-news-6 437 '((t (:inherit gnus-group-news-6-empty :bold t))) 438 "Level 6 newsgroup face." 439 :group 'gnus-group) 440 441(defface gnus-group-news-low-empty 442 '((((class color) 443 (background dark)) 444 (:foreground "DarkTurquoise")) 445 (((class color) 446 (background light)) 447 (:foreground "DarkGreen")) 448 (t 449 ())) 450 "Low level empty newsgroup face." 451 :group 'gnus-group) 452 453(defface gnus-group-news-low 454 '((t (:inherit gnus-group-news-low-empty :bold t))) 455 "Low level newsgroup face." 456 :group 'gnus-group) 457 458(defface gnus-group-mail-1-empty 459 '((((class color) 460 (background dark)) 461 (:foreground "#e1ffe1")) 462 (((class color) 463 (background light)) 464 (:foreground "DeepPink3")) 465 (t 466 (:italic t))) 467 "Level 1 empty mailgroup face." 468 :group 'gnus-group) 469 470(defface gnus-group-mail-1 471 '((t (:inherit gnus-group-mail-1-empty :bold t))) 472 "Level 1 mailgroup face." 473 :group 'gnus-group) 474 475(defface gnus-group-mail-2-empty 476 '((((class color) 477 (background dark)) 478 (:foreground "DarkSeaGreen1")) 479 (((class color) 480 (background light)) 481 (:foreground "HotPink3")) 482 (t 483 (:italic t))) 484 "Level 2 empty mailgroup face." 485 :group 'gnus-group) 486 487(defface gnus-group-mail-2 488 '((t (:inherit gnus-group-mail-2-empty :bold t))) 489 "Level 2 mailgroup face." 490 :group 'gnus-group) 491 492(defface gnus-group-mail-3-empty 493 '((((class color) 494 (background dark)) 495 (:foreground "aquamarine1")) 496 (((class color) 497 (background light)) 498 (:foreground "magenta4")) 499 (t 500 ())) 501 "Level 3 empty mailgroup face." 502 :group 'gnus-group) 503 504(defface gnus-group-mail-3 505 '((t (:inherit gnus-group-mail-3-empty :bold t))) 506 "Level 3 mailgroup face." 507 :group 'gnus-group) 508 509(defface gnus-group-mail-low-empty 510 '((((class color) 511 (background dark)) 512 (:foreground "aquamarine2")) 513 (((class color) 514 (background light)) 515 (:foreground "DeepPink4")) 516 (t 517 (:bold t))) 518 "Low level empty mailgroup face." 519 :group 'gnus-group) 520 521(defface gnus-group-mail-low 522 '((t (:inherit gnus-group-mail-low-empty :bold t))) 523 "Low level mailgroup face." 524 :group 'gnus-group) 525 526;; Summary mode faces. 527 528(defface gnus-summary-selected '((t (:underline t :extend t))) 529 "Face used for selected articles." 530 :group 'gnus-summary) 531 532(defface gnus-summary-cancelled 533 '((((class color)) 534 (:foreground "yellow" :background "black" :extend t)) 535 (t (:extend t))) 536 "Face used for canceled articles." 537 :group 'gnus-summary) 538 539(defface gnus-summary-normal-ticked 540 '((((class color) 541 (background dark)) 542 (:foreground "pink" :extend t)) 543 (((class color) 544 (background light)) 545 (:foreground "firebrick" :extend t)) 546 (t 547 (:extend t))) 548 "Face used for normal interest ticked articles." 549 :group 'gnus-summary) 550 551(defface gnus-summary-high-ticked 552 '((t (:inherit gnus-summary-normal-ticked :bold t))) 553 "Face used for high interest ticked articles." 554 :group 'gnus-summary) 555 556(defface gnus-summary-low-ticked 557 '((t (:inherit gnus-summary-normal-ticked :italic t))) 558 "Face used for low interest ticked articles." 559 :group 'gnus-summary) 560 561(defface gnus-summary-normal-ancient 562 '((((class color) 563 (background dark)) 564 (:foreground "SkyBlue" :extend t)) 565 (((class color) 566 (background light)) 567 (:foreground "RoyalBlue" :extend t)) 568 (t 569 (:extend t))) 570 "Face used for normal interest ancient articles." 571 :group 'gnus-summary) 572 573(defface gnus-summary-high-ancient 574 '((t (:inherit gnus-summary-normal-ancient :bold t))) 575 "Face used for high interest ancient articles." 576 :group 'gnus-summary) 577 578(defface gnus-summary-low-ancient 579 '((t (:inherit gnus-summary-normal-ancient :italic t))) 580 "Face used for low interest ancient articles." 581 :group 'gnus-summary) 582 583(defface gnus-summary-normal-undownloaded 584 '((((class color) 585 (background light)) 586 (:foreground "cyan4" :bold nil :extend t)) 587 (((class color) (background dark)) 588 (:foreground "LightGray" :bold nil :extend t)) 589 (t (:inverse-video t :extend t))) 590 "Face used for normal interest uncached articles." 591 :group 'gnus-summary) 592 593(defface gnus-summary-high-undownloaded 594 '((t (:inherit gnus-summary-normal-undownloaded :bold t))) 595 "Face used for high interest uncached articles." 596 :group 'gnus-summary) 597 598(defface gnus-summary-low-undownloaded 599 '((t (:inherit gnus-summary-normal-undownloaded :italic t))) 600 "Face used for low interest uncached articles." 601 :group 'gnus-summary) 602 603(defface gnus-summary-normal-unread 604 '((t 605 (:extend t))) 606 "Face used for normal interest unread articles." 607 :group 'gnus-summary) 608 609(defface gnus-summary-high-unread 610 '((t (:inherit gnus-summary-normal-unread :bold t))) 611 "Face used for high interest unread articles." 612 :group 'gnus-summary) 613 614(defface gnus-summary-low-unread 615 '((t (:inherit gnus-summary-normal-unread :italic t))) 616 "Face used for low interest unread articles." 617 :group 'gnus-summary) 618 619(defface gnus-summary-normal-read 620 '((((class color) 621 (background dark)) 622 (:foreground "PaleGreen" :extend t)) 623 (((class color) 624 (background light)) 625 (:foreground "DarkGreen" :extend t)) 626 (t 627 (:extend t))) 628 "Face used for normal interest read articles." 629 :group 'gnus-summary) 630 631(defface gnus-summary-high-read 632 '((t (:inherit gnus-summary-normal-read :bold t))) 633 "Face used for high interest read articles." 634 :group 'gnus-summary) 635 636(defface gnus-summary-low-read 637 '((t (:inherit gnus-summary-normal-read :italic t))) 638 "Face used for low interest read articles." 639 :group 'gnus-summary) 640 641;;; Base gnus-mode 642 643(define-derived-mode gnus-mode special-mode nil 644 "Base mode from which all other gnus modes derive. 645This does nothing but derive from `special-mode', and should not 646be used directly.") 647 648;;; 649;;; Gnus buffers 650;;; 651 652(defvar gnus-buffers nil 653 "List of buffers handled by Gnus.") 654 655(defun gnus-get-buffer-create (name) 656 "Do the same as `get-buffer-create', but store the created buffer." 657 (or (get-buffer name) 658 (car (push (get-buffer-create name) gnus-buffers)))) 659 660(defun gnus-add-buffer () 661 "Add the current buffer to the list of Gnus buffers." 662 (gnus-prune-buffers) 663 (cl-pushnew (current-buffer) gnus-buffers)) 664 665(defmacro gnus-kill-buffer (buffer) 666 "Kill BUFFER and remove from the list of Gnus buffers." 667 `(let ((buf ,buffer)) 668 (when (gnus-buffer-live-p buf) 669 (kill-buffer buf) 670 (gnus-prune-buffers)))) 671 672(defun gnus-buffers () 673 "Return a list of live Gnus buffers." 674 (setq gnus-buffers (seq-filter #'buffer-live-p gnus-buffers))) 675 676(defalias 'gnus-prune-buffers #'gnus-buffers) 677 678;;; Splash screen. 679 680(defvar gnus-group-buffer "*Group*" 681 "Name of the Gnus group buffer.") 682 683(defface gnus-splash 684 '((((class color) 685 (background dark)) 686 (:foreground "#cccccc")) 687 (((class color) 688 (background light)) 689 (:foreground "#888888")) 690 (t 691 ())) 692 "Face for the splash screen." 693 :group 'gnus-start) 694 695(defun gnus-splash () 696 (save-excursion 697 (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) 698 (let ((buffer-read-only nil)) 699 (erase-buffer) 700 (unless gnus-inhibit-startup-message 701 (gnus-group-startup-message) 702 (sit-for 0))))) 703 704(defun gnus-indent-rigidly (start end arg) 705 "Indent rigidly using only spaces and no tabs." 706 (save-excursion 707 (save-restriction 708 (narrow-to-region start end) 709 (let ((tab-width 8)) 710 (indent-rigidly start end arg) 711 ;; We translate tabs into spaces -- not everybody uses 712 ;; an 8-character tab. 713 (goto-char (point-min)) 714 (while (search-forward "\t" nil t) 715 (replace-match " " t t)))))) 716 717;;(format "%02x%02x%02x" 114 66 20) "724214" 718 719(defvar gnus-logo-color-alist 720 '((flame "#cc3300" "#ff2200") 721 (pine "#c0cc93" "#f8ffb8") 722 (moss "#a1cc93" "#d2ffb8") 723 (irish "#04cc90" "#05ff97") 724 (sky "#049acc" "#05deff") 725 (tin "#6886cc" "#82b6ff") 726 (velvet "#7c68cc" "#8c82ff") 727 (grape "#b264cc" "#cf7df") 728 (labia "#cc64c2" "#fd7dff") 729 (berry "#cc6485" "#ff7db5") 730 (dino "#724214" "#1e3f03") 731 (oort "#cccccc" "#888888") 732 (storm "#666699" "#99ccff") 733 (pdino "#9999cc" "#99ccff") 734 (purp "#9999cc" "#666699") 735 (no "#ff0000" "#ffff00") 736 (neutral "#b4b4b4" "#878787") 737 (ma "#2020e0" "#8080ff") 738 (september "#bf9900" "#ffcc00")) 739 "Color alist used for the Gnus logo.") 740 741(defcustom gnus-logo-color-style 'ma 742 "Color styles used for the Gnus logo." 743 :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) 744 gnus-logo-color-alist)) 745 :group 'gnus-xmas) 746 747(defvar gnus-logo-colors 748 (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) 749 "Colors used for the Gnus logo.") 750 751(defvar image-load-path) 752(declare-function image-size "image.c" (spec &optional pixels frame)) 753 754(defun gnus-group-startup-message (&optional x y) 755 "Insert startup message in current buffer." 756 ;; Insert the message. 757 (erase-buffer) 758 (unless (and 759 (fboundp 'find-image) 760 (display-graphic-p) 761 ;; Make sure the library defining `image-load-path' is 762 ;; loaded (`find-image' is autoloaded) (and discard the 763 ;; result). Else, we may get "defvar ignored because 764 ;; image-load-path is let-bound" when calling `find-image' 765 ;; below. 766 (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) 767 (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) 768 (image-load-path (cond (data-directory 769 (list data-directory)) 770 ((boundp 'image-load-path) 771 (symbol-value 'image-load-path)) 772 (t load-path))) 773 (image (gnus-splash-svg-color-symbols (find-image 774 `((:type svg :file "gnus.svg" 775 :color-symbols 776 (("#bf9900" . ,(car gnus-logo-colors)) 777 ("#ffcc00" . ,(cadr gnus-logo-colors)))) 778 (:type xpm :file "gnus.xpm" 779 :color-symbols 780 (("thing" . ,(car gnus-logo-colors)) 781 ("shadow" . ,(cadr gnus-logo-colors)))) 782 (:type png :file "gnus.png") 783 (:type pbm :file "gnus.pbm" 784 ;; Account for the pbm's background. 785 :background ,(face-foreground 'gnus-splash) 786 :foreground ,(face-background 'default)) 787 (:type xbm :file "gnus.xbm" 788 ;; Account for the xbm's background. 789 :background ,(face-foreground 'gnus-splash) 790 :foreground ,(face-background 'default))))))) 791 (when image 792 (let ((size (image-size image))) 793 (insert-char ?\n (max 0 (round (- (window-height) 794 (or y (cdr size)) 1) 2))) 795 (insert-char ?\ (max 0 (round (- (window-width) 796 (or x (car size))) 2))) 797 (insert-image image)) 798 (goto-char (point-min)) 799 t))) 800 (insert 801 " 802 _ ___ _ _ 803 _ ___ __ ___ __ _ ___ 804 __ _ ___ __ ___ 805 _ ___ _ 806 _ _ __ _ 807 ___ __ _ 808 __ _ 809 _ _ _ 810 _ _ _ 811 _ _ _ 812 __ ___ 813 _ _ _ _ 814 _ _ 815 _ _ 816 _ _ 817 _ 818 __ 819 820") 821 ;; And then hack it. 822 (gnus-indent-rigidly (point-min) (point-max) 823 (/ (max (- (window-width) (or x 46)) 0) 2)) 824 (goto-char (point-min)) 825 (forward-line 1) 826 (let* ((pheight (count-lines (point-min) (point-max))) 827 (wheight (window-height)) 828 (rest (- wheight pheight))) 829 (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) 830 ;; Fontify some. 831 (put-text-property (point-min) (point-max) 'face 'gnus-splash) 832 (goto-char (point-min)) 833 (setq mode-line-buffer-identification (concat " " gnus-version)) 834 (set-buffer-modified-p t))) 835 836(defun gnus-splash-svg-color-symbols (list) 837 "Do color-symbol search-and-replace in svg file." 838 (let ((type (plist-get (cdr list) :type)) 839 (file (plist-get (cdr list) :file)) 840 (color-symbols (plist-get (cdr list) :color-symbols))) 841 (if (string= type "svg") 842 (let ((data (with-temp-buffer (insert-file-contents file) 843 (buffer-string)))) 844 (mapc (lambda (rule) 845 (setq data (replace-regexp-in-string 846 (concat "fill:" (car rule)) 847 (concat "fill:" (cdr rule)) data))) 848 color-symbols) 849 (cons (car list) (list :type type :data data))) 850 list))) 851 852;;; Do the rest. 853 854(require 'gnus-util) 855(require 'nnheader) 856 857(defcustom gnus-parameters nil 858 "Alist of group parameters. 859 860For example: 861 ((\"mail\\\\..*\" (gnus-show-threads nil) 862 (gnus-use-scoring nil) 863 (gnus-summary-line-format 864 \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\") 865 (gcc-self . t) 866 (display . all)) 867 (\"mail\\\\.me\" (gnus-use-scoring t)) 868 (\"list\\\\..*\" (total-expire . t) 869 (broken-reply-to . t)))" 870 :version "22.1" 871 :group 'gnus-group-various 872 :type '(repeat (cons regexp 873 (repeat sexp)))) 874 875(defcustom gnus-parameters-case-fold-search 'default 876 "If it is t, ignore case of group names specified in `gnus-parameters'. 877If it is nil, don't ignore case. If it is `default', which is for the 878backward compatibility, use the value of `case-fold-search'." 879 :version "22.1" 880 :group 'gnus-group-various 881 :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" 882 (const :tag "Use `case-fold-search'" default) 883 (const nil) 884 (const t))) 885 886(defvar gnus-group-parameters-more nil) 887 888(defmacro gnus-define-group-parameter (param &rest rest) 889 "Define a group parameter PARAM. 890REST is a plist of following: 891:type One of `bool', `list' or nil. 892:function The name of the function. 893:function-document The documentation of the function. 894:parameter-type The type for customizing the parameter. 895:parameter-document The documentation for the parameter. 896:variable The name of the variable. 897:variable-document The documentation for the variable. 898:variable-group The group for customizing the variable. 899:variable-type The type for customizing the variable. 900:variable-default The default value of the variable." 901 (let* ((type (plist-get rest :type)) 902 (parameter-type (plist-get rest :parameter-type)) 903 (parameter-document (plist-get rest :parameter-document)) 904 (function (or (plist-get rest :function) 905 (intern (format "gnus-parameter-%s" param)))) 906 (function-document (or (plist-get rest :function-document) "")) 907 (variable (or (plist-get rest :variable) 908 (intern (format "gnus-parameter-%s-alist" param)))) 909 (variable-document (or (plist-get rest :variable-document) "")) 910 (variable-group (plist-get rest :variable-group)) 911 (variable-type (or (plist-get rest :variable-type) 912 `(quote (repeat 913 (list (regexp :tag "Group") 914 ,(car (cdr parameter-type))))))) 915 (variable-default (plist-get rest :variable-default))) 916 (list 917 'progn 918 `(defcustom ,variable ,variable-default 919 ,variable-document 920 :group 'gnus-group-parameter 921 :group ',variable-group 922 :type ,variable-type) 923 `(setq gnus-group-parameters-more 924 (delq (assq ',param gnus-group-parameters-more) 925 gnus-group-parameters-more)) 926 `(add-to-list 'gnus-group-parameters-more 927 (list ',param 928 ,parameter-type 929 ,parameter-document)) 930 (if (eq type 'bool) 931 `(defun ,function (name) 932 ,function-document 933 (let ((params (gnus-group-find-parameter name)) 934 val) 935 (cond 936 ((memq ',param params) 937 t) 938 ((setq val (assq ',param params)) 939 (cdr val)) 940 ((stringp ,variable) 941 (string-match ,variable name)) 942 (,variable 943 (let ((alist ,variable) 944 elem value) 945 (while (setq elem (pop alist)) 946 (when (and name 947 (string-match (car elem) name)) 948 (setq alist nil 949 value (cdr elem)))) 950 (if (consp value) (car value) value)))))) 951 `(defun ,function (name) 952 ,function-document 953 (and name 954 (or (gnus-group-find-parameter name ',param ,(and type t)) 955 (let ((alist ,variable) 956 elem value) 957 (while (setq elem (pop alist)) 958 (when (and name 959 (string-match (car elem) name)) 960 (setq alist nil 961 value (cdr elem)))) 962 ,(if type 963 'value 964 '(if (consp value) (car value) value)))))))))) 965 966(defcustom gnus-home-directory "~/" 967 "Directory variable that specifies the \"home\" directory. 968All other Gnus file and directory variables are initialized from this variable. 969 970Note that Gnus is mostly loaded when the `.gnus.el' file is read. 971This means that other directory variables that are initialized 972from this variable won't be set properly if you set this variable 973in `.gnus.el'. Set this variable in `.emacs' instead." 974 :group 'gnus-files 975 :type 'directory) 976 977(defcustom gnus-directory (or (getenv "SAVEDIR") 978 (nnheader-concat gnus-home-directory "News/")) 979 "Directory variable from which all other Gnus file variables are derived. 980 981Note that Gnus is mostly loaded when the `.gnus.el' file is read. 982This means that other directory variables that are initialized from 983this variable won't be set properly if you set this variable in `.gnus.el'. 984Set this variable in `.emacs' instead." 985 :group 'gnus-files 986 :type 'directory) 987 988(defcustom gnus-default-directory nil 989 "Default directory for all Gnus buffers." 990 :group 'gnus-files 991 :type '(choice (const :tag "current" nil) 992 directory)) 993 994;; Site dependent variables. 995 996;; Should this be obsolete? 997(defcustom gnus-default-nntp-server nil 998 "The hostname of the default NNTP server. 999The empty string, or nil, means to use the local host. 1000You may wish to set this on a site-wide basis. 1001 1002If you want to change servers, you should use `gnus-select-method'." 1003 :group 'gnus-server 1004 :type '(choice (const :tag "local host" nil) 1005 (string :tag "host name"))) 1006 1007(defcustom gnus-nntpserver-file "/etc/nntpserver" 1008 "A file with only the name of the nntp server in it." 1009 :group 'gnus-files 1010 :group 'gnus-server 1011 :type 'file) 1012 1013(defun gnus-getenv-nntpserver () 1014 "Find default nntp server. 1015Check the NNTPSERVER environment variable and the 1016`gnus-nntpserver-file' file." 1017 (or (getenv "NNTPSERVER") 1018 (and (file-readable-p gnus-nntpserver-file) 1019 (with-temp-buffer 1020 (insert-file-contents gnus-nntpserver-file) 1021 (when (re-search-forward "[^ \t\n\r]+" nil t) 1022 (match-string 0)))))) 1023 1024;; `M-x customize-variable RET gnus-select-method RET' should work without 1025;; starting or even loading Gnus. 1026;;;###autoload(custom-autoload 'gnus-select-method "gnus") 1027 1028(defcustom gnus-select-method 1029 (list 'nntp (or (gnus-getenv-nntpserver) 1030 (when (and gnus-default-nntp-server 1031 (not (string= gnus-default-nntp-server ""))) 1032 gnus-default-nntp-server) 1033 "news")) 1034 "Default method for selecting a newsgroup. 1035This variable should be a list, where the first element is how the 1036news is to be fetched, the second is the address. 1037 1038For instance, if you want to get your news via \"flab.flab.edu\" using 1039NNTP, you could say: 1040 1041\(setq gnus-select-method \\='(nntp \"flab.flab.edu\")) 1042 1043If you want to use your local spool, say: 1044 1045\(setq gnus-select-method (list \\='nnspool (system-name))) 1046 1047If you use this variable, you must set `gnus-nntp-server' to nil. 1048 1049There is a lot more to know about select methods and virtual servers - 1050see the manual for details." 1051 ;; Emacs has set-after since 22.1. 1052 ;set-after '(gnus-default-nntp-server) 1053 :group 'gnus-server 1054 :group 'gnus-start 1055 :initialize 'custom-initialize-default 1056 :type 'gnus-select-method) 1057 1058(defcustom gnus-message-archive-method "archive" 1059 "Method used for archiving messages you've sent. 1060This should be a mail method. 1061 1062See also `gnus-update-message-archive-method'." 1063 :group 'gnus-server 1064 :group 'gnus-message 1065 :type '(choice (const :tag "Default archive method" "archive") 1066 gnus-select-method)) 1067 1068(defcustom gnus-update-message-archive-method nil 1069 "Non-nil means always update the saved \"archive\" method. 1070 1071The archive method is initially set according to the value of 1072`gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file 1073so that it may be used as a real method of the server which is named 1074\"archive\" ever since. If it once has been saved, it will never be 1075updated if the value of this variable is nil, even if you change the 1076value of `gnus-message-archive-method' afterward. If you want the 1077saved \"archive\" method to be updated whenever you change the value of 1078`gnus-message-archive-method', set this variable to a non-nil value." 1079 :version "23.1" 1080 :group 'gnus-server 1081 :group 'gnus-message 1082 :type 'boolean) 1083 1084(defcustom gnus-message-archive-group '((format-time-string "sent.%Y-%m")) 1085 "Name of the group in which to save the messages you've written. 1086This can either be a string; a list of strings; or an alist 1087of regexps/functions/forms to be evaluated to return a string (or a list 1088of strings). The functions are called with the name of the current 1089group (or nil) as a parameter. 1090 1091If you want to save your mail in one group and the news articles you 1092write in another group, you could say something like: 1093 1094 (setq gnus-message-archive-group 1095 \\='((if (message-news-p) 1096 \"misc-news\" 1097 \"misc-mail\"))) 1098 1099Normally the group names returned by this variable should be 1100unprefixed -- which implicitly means \"store on the archive server\". 1101However, you may wish to store the message on some other server. In 1102that case, just return a fully prefixed name of the group -- 1103\"nnml+private:mail.misc\", for instance." 1104 :version "24.1" 1105 :group 'gnus-message 1106 :type '(choice (const :tag "none" nil) 1107 (const :tag "Weekly" ((format-time-string "sent.%Yw%U"))) 1108 (const :tag "Monthly" ((format-time-string "sent.%Y-%m"))) 1109 (const :tag "Yearly" ((format-time-string "sent.%Y"))) 1110 function 1111 sexp 1112 string)) 1113 1114(defcustom gnus-secondary-servers nil 1115 "List of NNTP servers that the user can choose between interactively. 1116To make Gnus query you for a server, you have to give `gnus' a 1117non-numeric prefix - `\\[universal-argument] \\[gnus]', in short." 1118 :group 'gnus-server 1119 :type '(repeat string)) 1120(make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") 1121 1122(defcustom gnus-secondary-select-methods nil 1123 "A list of secondary methods that will be used for reading news. 1124This is a list where each element is a complete select method (see 1125`gnus-select-method'). 1126 1127If, for instance, you want to read your mail with the nnml back end, 1128you could set this variable: 1129 1130\(setq gnus-secondary-select-methods \\='((nnml \"\")))" 1131 :group 'gnus-server 1132 :type '(repeat gnus-select-method)) 1133 1134(defcustom gnus-local-domain nil 1135 "Local domain name without a host name. 1136The DOMAINNAME environment variable is used instead if it is defined. 1137If the function `system-name' returns the full Internet name, there is 1138no need to set this variable." 1139 :group 'gnus-message 1140 :type '(choice (const :tag "default" nil) 1141 string)) 1142(make-obsolete-variable 'gnus-local-domain nil "24.1") 1143 1144;; Customization variables 1145 1146(defcustom gnus-refer-article-method 'current 1147 "Preferred method for fetching an article by Message-ID. 1148The value of this variable must be a valid select method as discussed 1149in the documentation of `gnus-select-method'. 1150 1151It can also be a list of select methods, as well as the special symbol 1152`current', which means to use the current select method. If it is a 1153list, Gnus will try all the methods in the list until it finds a match." 1154 :version "24.1" 1155 :group 'gnus-server 1156 :type '(choice (const :tag "default" nil) 1157 (const current) 1158 (const :tag "Google" (nnweb "refer" (nnweb-type google))) 1159 gnus-select-method 1160 sexp 1161 (repeat :menu-tag "Try multiple" 1162 :tag "Multiple" 1163 :value (current (nnweb "refer" (nnweb-type google))) 1164 (choice :tag "Method" 1165 (const current) 1166 (const :tag "Google" 1167 (nnweb "refer" (nnweb-type google))) 1168 gnus-select-method)))) 1169 1170(defcustom gnus-use-cross-reference t 1171 "Non-nil means that cross referenced articles will be marked as read. 1172If nil, ignore cross references. If t, mark articles as read in 1173subscribed newsgroups. If neither t nor nil, mark as read in all 1174newsgroups." 1175 :group 'gnus-server 1176 :type '(choice (const :tag "off" nil) 1177 (const :tag "subscribed" t) 1178 (sexp :format "all" 1179 :value always))) 1180 1181(defcustom gnus-process-mark ?# 1182 "Process mark." 1183 :group 'gnus-group-visual 1184 :group 'gnus-summary-marks 1185 :type 'character) 1186 1187(defcustom gnus-process-mark-toggle t 1188 "If nil the process mark command only sets the process mark." 1189 :version "28.1" 1190 :group 'gnus-summary 1191 :group 'gnus-group-various 1192 :group 'gnus-group-topic 1193 :type 'boolean) 1194 1195(defcustom gnus-large-newsgroup 200 1196 "The number of articles which indicates a large newsgroup. 1197If the number of articles in a newsgroup is greater than this value, 1198confirmation is required for selecting the newsgroup. 1199If it is nil, no confirmation is required. 1200 1201Also see `gnus-large-ephemeral-newsgroup'." 1202 :group 'gnus-group-select 1203 :type '(choice (const :tag "No limit" nil) 1204 integer)) 1205 1206(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v))) 1207 "Non-nil means that the default file name to save articles in is the group name. 1208If it's nil, the directory form of the group name is used instead. 1209 1210If this variable is a list, and the list contains the element 1211`not-score', long file names will not be used for score files; if it 1212contains the element `not-save', long file names will not be used for 1213saving; and if it contains the element `not-kill', long file names 1214will not be used for kill files. 1215 1216Note that the default for this variable varies according to what system 1217type you're using. On `usg-unix-v' this variable defaults to nil while 1218on all other systems it defaults to t." 1219 :group 'gnus-start 1220 :type '(radio (sexp :format "Non-nil\n" 1221 :match (lambda (widget value) 1222 (and value (not (listp value)))) 1223 :value t) 1224 (const nil) 1225 (checklist (const :format "%v " not-score) 1226 (const :format "%v " not-save) 1227 (const not-kill)))) 1228 1229(defcustom gnus-kill-files-directory gnus-directory 1230 "Name of the directory where kill files will be stored (default \"~/News\")." 1231 :group 'gnus-score-files 1232 :group 'gnus-score-kill 1233 :type 'directory) 1234 1235(defcustom gnus-save-score nil 1236 "If non-nil, save group scoring info." 1237 :group 'gnus-score-various 1238 :group 'gnus-start 1239 :type 'boolean) 1240 1241(defcustom gnus-use-undo t 1242 "If non-nil, allow undoing in Gnus group mode buffers." 1243 :group 'gnus-meta 1244 :type 'boolean) 1245 1246(defcustom gnus-use-adaptive-scoring nil 1247 "If non-nil, use some adaptive scoring scheme. 1248If a list, then the values `word' and `line' are meaningful. The 1249former will perform adaption on individual words in the subject 1250header while `line' will perform adaption on several headers." 1251 :group 'gnus-meta 1252 :group 'gnus-score-adapt 1253 :type '(set (const word) (const line))) 1254 1255(defcustom gnus-use-cache 'passive 1256 "If nil, Gnus will ignore the article cache. 1257If `passive', it will allow entering (and reading) articles 1258explicitly entered into the cache. If anything else, use the 1259cache to the full extent of the law." 1260 :group 'gnus-meta 1261 :group 'gnus-cache 1262 :type '(choice (const :tag "off" nil) 1263 (const :tag "passive" passive) 1264 (const :tag "active" t))) 1265 1266(defcustom gnus-use-trees nil 1267 "If non-nil, display a thread tree buffer." 1268 :group 'gnus-meta 1269 :type 'boolean) 1270 1271(defcustom gnus-keep-backlog 20 1272 "If non-nil, Gnus will keep read articles for later re-retrieval. 1273If it is a number N, then Gnus will only keep the last N articles 1274read. If it is neither nil nor a number, Gnus will keep all read 1275articles. This is not a good idea." 1276 :group 'gnus-meta 1277 :type '(choice (const :tag "off" nil) 1278 integer 1279 (sexp :format "all" 1280 :value t))) 1281 1282(defcustom gnus-suppress-duplicates nil 1283 "If non-nil, Gnus will mark duplicate copies of the same article as read." 1284 :group 'gnus-meta 1285 :type 'boolean) 1286 1287(defcustom gnus-use-scoring t 1288 "If non-nil, enable scoring." 1289 :group 'gnus-meta 1290 :type 'boolean) 1291 1292(defcustom gnus-summary-prepare-exit-hook 1293 '(gnus-summary-expire-articles) 1294 "A hook called when preparing to exit from the summary buffer. 1295It calls `gnus-summary-expire-articles' by default." 1296 :group 'gnus-summary-exit 1297 :type 'hook) 1298 1299(defcustom gnus-novice-user t 1300 "Non-nil means that you are a Usenet novice. 1301If non-nil, verbose messages may be displayed and confirmations may be 1302required." 1303 :group 'gnus-meta 1304 :type 'boolean) 1305 1306(defcustom gnus-expert-user nil 1307 "Non-nil means that you will never be asked for confirmation about anything. 1308That doesn't mean *anything* anything; particularly destructive 1309commands will still require prompting." 1310 :group 'gnus-meta 1311 :type 'boolean) 1312 1313(defcustom gnus-interactive-catchup t 1314 "If non-nil, require your confirmation when catching up a group." 1315 :group 'gnus-group-select 1316 :type 'boolean) 1317 1318(defcustom gnus-interactive-exit t 1319 "If non-nil, require your confirmation when exiting Gnus. 1320If `quiet', update any active summary buffers automatically 1321first before exiting." 1322 :group 'gnus-exit 1323 :type '(choice boolean 1324 (const quiet))) 1325 1326(defcustom gnus-extract-address-components 'gnus-extract-address-components 1327 "Function for extracting address components from a From header. 1328Two pre-defined function exist: `gnus-extract-address-components', 1329which is the default, quite fast, and too simplistic solution, and 1330`mail-extract-address-components', which works much better, but is 1331slower." 1332 :group 'gnus-summary-format 1333 :type '(radio (function-item gnus-extract-address-components) 1334 (function-item mail-extract-address-components) 1335 (function :tag "Other"))) 1336 1337(defcustom gnus-shell-command-separator ";" 1338 "String used to separate shell commands." 1339 :group 'gnus-files 1340 :type 'string) 1341 1342(defcustom gnus-valid-select-methods 1343 '(("nntp" post address prompt-address physical-address cloud) 1344 ("nnspool" post address) 1345 ("nnvirtual" post-mail virtual prompt-address) 1346 ("nnmbox" mail respool address) 1347 ("nnml" post-mail respool address) 1348 ("nnmh" mail respool address) 1349 ("nndir" post-mail prompt-address physical-address) 1350 ("nneething" none address prompt-address physical-address) 1351 ("nndoc" none address prompt-address) 1352 ("nnbabyl" mail address respool) 1353 ("nndraft" post-mail) 1354 ("nnfolder" mail respool address) 1355 ("nngateway" post-mail address prompt-address physical-address) 1356 ("nnweb" none) 1357 ("nnrss" none global) 1358 ("nnagent" post-mail) 1359 ("nnimap" post-mail address prompt-address physical-address respool 1360 server-marks cloud) 1361 ("nnmaildir" mail respool address server-marks) 1362 ("nnnil" none)) 1363 "An alist of valid select methods. 1364The first element of each list lists should be a string with the name 1365of the select method. The other elements may be the category of 1366this method (i. e., `post', `mail', `none' or whatever) or other 1367properties that this method has (like being respoolable). 1368If you implement a new select method, all you should have to change is 1369this variable. I think." 1370 :group 'gnus-server 1371 :type '(repeat (group (string :tag "Name") 1372 (radio-button-choice (const :format "%v " post) 1373 (const :format "%v " mail) 1374 (const :format "%v " none) 1375 (const post-mail)) 1376 (checklist :inline t :greedy t 1377 (const :format "%v " address) 1378 (const cloud) 1379 (const global) 1380 (const :format "%v " prompt-address) 1381 (const :format "%v " physical-address) 1382 (const virtual) 1383 (const :format "%v " respool) 1384 (const server-marks)))) 1385 :version "24.1") 1386 1387(defun gnus-redefine-select-method-widget () 1388 "Recomputes the select-method widget based on the value of 1389`gnus-valid-select-methods'." 1390 (define-widget 'gnus-select-method 'list 1391 "Widget for entering a select method." 1392 :value '(nntp "") 1393 :tag "Select Method" 1394 :args `((choice :tag "Method" 1395 ,@(mapcar (lambda (entry) 1396 (list 'const :format "%v\n" 1397 (intern (car entry)))) 1398 gnus-valid-select-methods) 1399 (symbol :tag "other")) 1400 (string :tag "Address") 1401 (repeat :tag "Options" 1402 :inline t 1403 (list :format "%v" 1404 variable 1405 (sexp :tag "Value")))))) 1406 1407(gnus-redefine-select-method-widget) 1408 1409(defcustom gnus-updated-mode-lines '(group article summary tree) 1410 "List of buffers that should update their mode lines. 1411The list may contain the symbols `group', `article', `tree' and 1412`summary'. If the corresponding symbol is present, Gnus will keep 1413that mode line updated with information that may be pertinent. 1414If this variable is nil, screen refresh may be quicker." 1415 :group 'gnus-various 1416 :type '(set (const group) 1417 (const article) 1418 (const summary) 1419 (const tree))) 1420 1421(defcustom gnus-mode-non-string-length 30 1422 "Max length of mode-line non-string contents. 1423If this is nil, Gnus will take space as is needed, leaving the rest 1424of the mode line intact." 1425 :version "24.1" 1426 :group 'gnus-various 1427 :type '(choice (const nil) 1428 integer)) 1429 1430;; There should be special validation for this. 1431(define-widget 'gnus-email-address 'string 1432 "An email address.") 1433 1434(gnus-define-group-parameter 1435 to-address 1436 :function-document 1437 "Return GROUP's to-address." 1438 :variable-document 1439 "Alist of group regexps and correspondent to-addresses." 1440 :variable-group gnus-group-parameter 1441 :parameter-type '(gnus-email-address :tag "To Address") 1442 :parameter-document "\ 1443This will be used when doing followups and posts. 1444 1445This is primarily useful in mail groups that represent closed 1446mailing lists--mailing lists where it's expected that everybody that 1447writes to the mailing list is subscribed to it. Since using this 1448parameter ensures that the mail only goes to the mailing list itself, 1449it means that members won't receive two copies of your followups. 1450 1451Using `to-address' will actually work whether the group is foreign or 1452not. Let's say there's a group on the server that is called 1453`fa.4ad-l'. This is a real newsgroup, but the server has gotten the 1454articles from a mail-to-news gateway. Posting directly to this group 1455is therefore impossible--you have to send mail to the mailing list 1456address instead. 1457 1458The gnus-group-split mail splitting mechanism will behave as if this 1459address was listed in gnus-group-split Addresses (see below).") 1460 1461(gnus-define-group-parameter 1462 to-list 1463 :function-document 1464 "Return GROUP's to-list." 1465 :variable-document 1466 "Alist of group regexps and correspondent to-lists." 1467 :variable-group gnus-group-parameter 1468 :parameter-type '(gnus-email-address :tag "To List") 1469 :parameter-document "\ 1470This address will be used when doing a \\`a' in the group. 1471 1472It is totally ignored when doing a followup--except that if it is 1473present in a news group, you'll get mail group semantics when doing 1474\\`f'. 1475 1476The gnus-group-split mail splitting mechanism will behave as if this 1477address was listed in gnus-group-split Addresses (see below).") 1478 1479(gnus-define-group-parameter 1480 subscribed 1481 :type bool 1482 :function-document 1483 "Return GROUP's subscription status." 1484 :variable-document 1485 "Groups which are automatically considered subscribed." 1486 :variable-group gnus-group-parameter 1487 :parameter-type '(const :tag "Subscribed" t) 1488 :parameter-document "\ 1489Gnus assumed that you are subscribed to the To/List address. 1490 1491When constructing a list of subscribed groups using 1492`gnus-find-subscribed-addresses', Gnus includes the To address given 1493above, or the list address (if the To address has not been set).") 1494 1495(gnus-define-group-parameter 1496 auto-expire 1497 :type bool 1498 :function gnus-group-auto-expirable-p 1499 :function-document 1500 "Check whether GROUP is auto-expirable or not." 1501 :variable gnus-auto-expirable-newsgroups 1502 :variable-default nil 1503 :variable-document 1504 "Groups in which to automatically mark read articles as expirable. 1505If non-nil, this should be a regexp that should match all groups in 1506which to perform auto-expiry. This only makes sense for mail groups." 1507 :variable-group nnmail-expire 1508 :variable-type '(choice (const nil) 1509 regexp) 1510 :parameter-type '(const :tag "Automatic Expire" t) 1511 :parameter-document 1512 "All articles that are read will be marked as expirable.") 1513 1514(gnus-define-group-parameter 1515 total-expire 1516 :type bool 1517 :function gnus-group-total-expirable-p 1518 :function-document 1519 "Check whether GROUP is total-expirable or not." 1520 :variable gnus-total-expirable-newsgroups 1521 :variable-default nil 1522 :variable-document 1523 "Groups in which to perform expiry of all read articles. 1524Use with extreme caution. All groups that match this regexp will be 1525expiring - which means that all read articles will be deleted after 1526\(say) one week. (This only goes for mail groups and the like, of 1527course.)" 1528 :variable-group nnmail-expire 1529 :variable-type '(choice (const nil) 1530 regexp) 1531 :parameter-type '(const :tag "Total Expire" t) 1532 :parameter-document 1533 "All read articles will be put through the expiry process 1534 1535This happens even if they are not marked as expirable. 1536Use with caution.") 1537 1538(gnus-define-group-parameter 1539 charset 1540 :function-document 1541 "Return the default charset of GROUP." 1542 :variable gnus-group-charset-alist 1543 :variable-default 1544 '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5) 1545 ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312) 1546 ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2) 1547 ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit) 1548 ("\\(^\\|:\\)relcom\\>" koi8-r) 1549 ("\\(^\\|:\\)fido7\\>" koi8-r) 1550 ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) 1551 ("\\(^\\|:\\)israel\\>" iso-8859-1) 1552 ("\\(^\\|:\\)han\\>" euc-kr) 1553 ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5) 1554 ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr) 1555 ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)) 1556 :variable-document 1557 "Alist of regexps (to match group names) and charsets to be used when reading." 1558 :variable-group gnus-charset 1559 :variable-type '(repeat (list (regexp :tag "Group") 1560 (symbol :tag "Charset"))) 1561 :parameter-type '(symbol :tag "Charset") 1562 :parameter-document "\ 1563The default charset to use in the group.") 1564 1565(gnus-define-group-parameter 1566 post-method 1567 :type list 1568 :function-document 1569 "Return a posting method for GROUP." 1570 :variable gnus-post-method-alist 1571 :variable-document 1572 "Alist of regexps (to match group names) and method to be used when 1573posting an article." 1574 :variable-group gnus-group-foreign 1575 :parameter-type 1576 '(choice :tag "Posting Method" 1577 (const :tag "Use native server" native) 1578 (const :tag "Use current server" current) 1579 (list :convert-widget 1580 (lambda (widget) 1581 (list 'sexp :tag "Methods" 1582 :value gnus-select-method)))) 1583 :parameter-document 1584 "Posting method for this group.") 1585 1586(gnus-define-group-parameter 1587 large-newsgroup-initial 1588 :type integer 1589 :function-document 1590 "Return GROUP's initial input of the number of articles." 1591 :variable-document 1592 "Alist of group regexps and its initial input of the number of articles." 1593 :variable-group gnus-group-parameter 1594 :parameter-type '(choice :tag "Initial Input for Large Newsgroup" 1595 (const :tag "All" 'all) 1596 (integer)) 1597 :parameter-document "\ 1598 1599This number will be prompted as the initial value of the number of 1600articles to list when the group is a large newsgroup (see 1601`gnus-large-newsgroup'). If it is nil, the default value is the 1602total number of articles in the group.") 1603 1604;; The Gnus registry's ignored groups 1605(gnus-define-group-parameter 1606 registry-ignore 1607 :type list 1608 :function-document 1609 "Whether this group should be ignored by the registry." 1610 :variable gnus-registry-ignored-groups 1611 :variable-default (mapcar 1612 (lambda (g) (list g t)) 1613 '("delayed$" "drafts$" "queue$" "INBOX$" 1614 "^nnmairix:" "^nnselect:" "archive")) 1615 :variable-document 1616 "Groups in which the registry should be turned off." 1617 :variable-group gnus-registry 1618 :variable-type '(repeat 1619 (list 1620 (regexp :tag "Group Name Regular Expression") 1621 (boolean :tag "Ignored"))) 1622 1623 :parameter-type '(boolean :tag "Group Ignored by the Registry") 1624 :parameter-document 1625 "Whether the Gnus Registry should ignore this group.") 1626 1627;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com> 1628(defcustom gnus-install-group-spam-parameters t 1629 "Disable the group parameters for spam detection. 1630Enable if `G c' in XEmacs is giving you trouble, and make sure to 1631submit a bug report." 1632 :version "22.1" 1633 :type 'boolean 1634 :group 'gnus-start) 1635 1636(when gnus-install-group-spam-parameters 1637 (defvar gnus-group-spam-classification-spam t 1638 "Spam group classification (requires spam.el). 1639This group contains spam messages. On summary entry, unread messages 1640will be marked as spam. On summary exit, the specified spam 1641processors will be invoked on spam-marked messages, then those 1642messages will be expired, so the spam processor will only see a 1643spam-marked message once.") 1644 1645 (defvar gnus-group-spam-classification-ham 'ask 1646 "The ham value for the spam group parameter (requires spam.el). 1647On summary exit, the specified ham processors will be invoked on 1648ham-marked messages. Exercise caution, since the ham processor will 1649see the same message more than once because there is no ham message 1650registry.") 1651 1652 (gnus-define-group-parameter 1653 spam-contents 1654 :type list 1655 :function-document 1656 "The spam type (spam, ham, or neither) of the group." 1657 :variable gnus-spam-newsgroup-contents 1658 :variable-default nil 1659 :variable-document 1660 "Group classification (spam, ham, or neither). Only 1661meaningful when spam.el is loaded. If non-nil, this should be a 1662list of group name regexps associated with a classification for 1663each one. In spam groups, new articles are marked as spam on 1664summary entry. There is other behavior associated with ham and 1665no classification when spam.el is loaded - see the manual." 1666 :variable-group spam 1667 :variable-type '(repeat 1668 (list :tag "Group contents spam/ham classification" 1669 (regexp :tag "Group") 1670 (choice 1671 (variable-item gnus-group-spam-classification-spam) 1672 (variable-item gnus-group-spam-classification-ham) 1673 (const :tag "Unclassified" nil)))) 1674 1675 :parameter-type '(list :tag "Group contents spam/ham classification" 1676 (choice :tag "Group contents classification for spam sorting" 1677 (variable-item gnus-group-spam-classification-spam) 1678 (variable-item gnus-group-spam-classification-ham) 1679 (const :tag "Unclassified" nil))) 1680 :parameter-document 1681 "The spam classification (spam, ham, or neither) of this group. 1682When a spam group is entered, all unread articles are marked as 1683spam. There is other behavior associated with ham and no 1684classification when spam.el is loaded - see the manual.") 1685 1686 (gnus-define-group-parameter 1687 spam-resend-to 1688 :type list 1689 :function-document 1690 "The address to get spam resent (through spam-report-resend)." 1691 :variable gnus-spam-resend-to 1692 :variable-default nil 1693 :variable-document 1694 "The address to get spam resent (through spam-report-resend)." 1695 :variable-group spam 1696 :variable-type '(repeat 1697 (list :tag "Group address for resending spam" 1698 (regexp :tag "Group") 1699 (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"))) 1700 :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)" 1701 :parameter-document 1702 "The address to get spam resent (through spam-report-resend).") 1703 1704 (gnus-define-group-parameter 1705 ham-resend-to 1706 :type list 1707 :function-document 1708 "The address to get ham resent (through spam-report-resend)." 1709 :variable gnus-ham-resend-to 1710 :variable-default nil 1711 :variable-document 1712 "The address to get ham resent (through spam-report-resend)." 1713 :variable-group spam 1714 :variable-type '(repeat 1715 (list :tag "Group address for resending ham" 1716 (regexp :tag "Group") 1717 (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"))) 1718 :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)" 1719 :parameter-document 1720 "The address to get ham resent (through spam-report-resend).") 1721 1722 (defvar gnus-group-spam-exit-processor-ifile "ifile" 1723 "OBSOLETE: The ifile summary exit spam processor.") 1724 1725 (defvar gnus-group-spam-exit-processor-stat "stat" 1726 "OBSOLETE: The spam-stat summary exit spam processor.") 1727 1728 (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" 1729 "OBSOLETE: The Bogofilter summary exit spam processor.") 1730 1731 (defvar gnus-group-spam-exit-processor-blacklist "blacklist" 1732 "OBSOLETE: The Blacklist summary exit spam processor.") 1733 1734 (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" 1735 "OBSOLETE: The Gmane reporting summary exit spam processor. 1736Only applicable to NNTP groups with articles from Gmane. See spam-report.el") 1737 1738 (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam" 1739 "OBSOLETE: The spamoracle summary exit spam processor.") 1740 1741 (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" 1742 "OBSOLETE: The ifile summary exit ham processor. 1743Only applicable to non-spam (unclassified and ham) groups.") 1744 1745 (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham" 1746 "OBSOLETE: The Bogofilter summary exit ham processor. 1747Only applicable to non-spam (unclassified and ham) groups.") 1748 1749 (defvar gnus-group-ham-exit-processor-stat "stat-ham" 1750 "OBSOLETE: The spam-stat summary exit ham processor. 1751Only applicable to non-spam (unclassified and ham) groups.") 1752 1753 (defvar gnus-group-ham-exit-processor-whitelist "whitelist" 1754 "OBSOLETE: The whitelist summary exit ham processor. 1755Only applicable to non-spam (unclassified and ham) groups.") 1756 1757 (defvar gnus-group-ham-exit-processor-BBDB "bbdb" 1758 "OBSOLETE: The BBDB summary exit ham processor. 1759Only applicable to non-spam (unclassified and ham) groups.") 1760 1761 (defvar gnus-group-ham-exit-processor-copy "copy" 1762 "OBSOLETE: The ham copy exit ham processor. 1763Only applicable to non-spam (unclassified and ham) groups.") 1764 1765 (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham" 1766 "OBSOLETE: The spamoracle summary exit ham processor. 1767Only applicable to non-spam (unclassified and ham) groups.") 1768 1769 (gnus-define-group-parameter 1770 spam-process 1771 :type list 1772 :parameter-type 1773 '(choice 1774 :tag "Spam Summary Exit Processor" 1775 :value nil 1776 (list :tag "Spam Summary Exit Processor Choices" 1777 (set 1778 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) 1779 (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) 1780 (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) 1781 (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) 1782 (const :tag "Spam: Resend Message"(spam spam-use-resend)) 1783 (const :tag "Spam: ifile" (spam spam-use-ifile)) 1784 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) 1785 (const :tag "Spam: Spam-stat" (spam spam-use-stat)) 1786 (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin)) 1787 (const :tag "Spam: CRM114" (spam spam-use-crm114)) 1788 (const :tag "Ham: BBDB" (ham spam-use-BBDB)) 1789 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) 1790 (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) 1791 (const :tag "Ham: Copy" (ham spam-use-ham-copy)) 1792 (const :tag "Ham: Resend Message" (ham spam-use-resend)) 1793 (const :tag "Ham: ifile" (ham spam-use-ifile)) 1794 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) 1795 (const :tag "Ham: Spam-stat" (ham spam-use-stat)) 1796 (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) 1797 (const :tag "Ham: CRM114" (ham spam-use-crm114)) 1798 (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) 1799 (variable-item gnus-group-spam-exit-processor-ifile) 1800 (variable-item gnus-group-spam-exit-processor-stat) 1801 (variable-item gnus-group-spam-exit-processor-bogofilter) 1802 (variable-item gnus-group-spam-exit-processor-blacklist) 1803 (variable-item gnus-group-spam-exit-processor-spamoracle) 1804 (variable-item gnus-group-spam-exit-processor-report-gmane) 1805 (variable-item gnus-group-ham-exit-processor-bogofilter) 1806 (variable-item gnus-group-ham-exit-processor-ifile) 1807 (variable-item gnus-group-ham-exit-processor-stat) 1808 (variable-item gnus-group-ham-exit-processor-whitelist) 1809 (variable-item gnus-group-ham-exit-processor-BBDB) 1810 (variable-item gnus-group-ham-exit-processor-spamoracle) 1811 (variable-item gnus-group-ham-exit-processor-copy)))) 1812 :function-document 1813 "Which spam or ham processors will be applied when the summary is exited." 1814 :variable gnus-spam-process-newsgroups 1815 :variable-default nil 1816 :variable-document 1817 "Groups in which to automatically process spam or ham articles with 1818a backend on summary exit. If non-nil, this should be a list of group 1819name regexps that should match all groups in which to do automatic 1820spam processing, associated with the appropriate processor." 1821 :variable-group spam 1822 :variable-type 1823 '(repeat :tag "Spam/Ham Processors" 1824 (list :tag "Spam Summary Exit Processor Choices" 1825 (regexp :tag "Group Regexp") 1826 (set 1827 :tag "Spam/Ham Summary Exit Processor" 1828 (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) 1829 (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) 1830 (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) 1831 (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) 1832 (const :tag "Spam: Resend Message"(spam spam-use-resend)) 1833 (const :tag "Spam: ifile" (spam spam-use-ifile)) 1834 (const :tag "Spam: Spam-stat" (spam spam-use-stat)) 1835 (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) 1836 (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin)) 1837 (const :tag "Spam: CRM114" (spam spam-use-crm114)) 1838 (const :tag "Ham: BBDB" (ham spam-use-BBDB)) 1839 (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) 1840 (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) 1841 (const :tag "Ham: Copy" (ham spam-use-ham-copy)) 1842 (const :tag "Ham: Resend Message" (ham spam-use-resend)) 1843 (const :tag "Ham: ifile" (ham spam-use-ifile)) 1844 (const :tag "Ham: Spam-stat" (ham spam-use-stat)) 1845 (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) 1846 (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) 1847 (const :tag "Ham: CRM114" (ham spam-use-crm114)) 1848 (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) 1849 (variable-item gnus-group-spam-exit-processor-ifile) 1850 (variable-item gnus-group-spam-exit-processor-stat) 1851 (variable-item gnus-group-spam-exit-processor-bogofilter) 1852 (variable-item gnus-group-spam-exit-processor-blacklist) 1853 (variable-item gnus-group-spam-exit-processor-spamoracle) 1854 (variable-item gnus-group-spam-exit-processor-report-gmane) 1855 (variable-item gnus-group-ham-exit-processor-bogofilter) 1856 (variable-item gnus-group-ham-exit-processor-ifile) 1857 (variable-item gnus-group-ham-exit-processor-stat) 1858 (variable-item gnus-group-ham-exit-processor-whitelist) 1859 (variable-item gnus-group-ham-exit-processor-BBDB) 1860 (variable-item gnus-group-ham-exit-processor-spamoracle) 1861 (variable-item gnus-group-ham-exit-processor-copy)))) 1862 1863 :parameter-document 1864 "Which spam or ham processors will be applied when the summary is exited.") 1865 1866 (gnus-define-group-parameter 1867 spam-autodetect 1868 :type list 1869 :parameter-type 1870 '(boolean :tag "Spam autodetection") 1871 :function-document 1872 "Should spam be autodetected (with spam-split) in this group?" 1873 :variable gnus-spam-autodetect 1874 :variable-default nil 1875 :variable-document 1876 "Groups in which spam should be autodetected when they are entered. 1877 Only unseen articles will be examined, unless 1878 spam-autodetect-recheck-messages is set." 1879 :variable-group spam 1880 :variable-type 1881 '(repeat 1882 :tag "Autodetection setting" 1883 (list 1884 (regexp :tag "Group Regexp") 1885 boolean)) 1886 :parameter-document 1887 "Spam autodetection. 1888Only unseen articles will be examined, unless 1889spam-autodetect-recheck-messages is set.") 1890 1891 (gnus-define-group-parameter 1892 spam-autodetect-methods 1893 :type list 1894 :parameter-type 1895 '(choice :tag "Spam autodetection-specific methods" 1896 (const none) 1897 (const default) 1898 (set :tag "Use specific methods" 1899 (variable-item spam-use-blacklist) 1900 (variable-item spam-use-gmane-xref) 1901 (variable-item spam-use-regex-headers) 1902 (variable-item spam-use-regex-body) 1903 (variable-item spam-use-whitelist) 1904 (variable-item spam-use-BBDB) 1905 (variable-item spam-use-ifile) 1906 (variable-item spam-use-spamoracle) 1907 (variable-item spam-use-crm114) 1908 (variable-item spam-use-spamassassin) 1909 (variable-item spam-use-spamassassin-headers) 1910 (variable-item spam-use-bsfilter) 1911 (variable-item spam-use-bsfilter-headers) 1912 (variable-item spam-use-stat) 1913 (variable-item spam-use-blackholes) 1914 (variable-item spam-use-hashcash) 1915 (variable-item spam-use-bogofilter-headers) 1916 (variable-item spam-use-bogofilter))) 1917 :function-document 1918 "Methods to be used for autodetection in each group" 1919 :variable gnus-spam-autodetect-methods 1920 :variable-default nil 1921 :variable-document 1922 "Methods for autodetecting spam per group. 1923Requires the spam-autodetect parameter. Only unseen articles 1924will be examined, unless spam-autodetect-recheck-messages is 1925set." 1926 :variable-group spam 1927 :variable-type 1928 '(repeat 1929 :tag "Autodetection methods" 1930 (list 1931 (regexp :tag "Group Regexp") 1932 (choice 1933 (const none) 1934 (const default) 1935 (set :tag "Use specific methods" 1936 (variable-item spam-use-blacklist) 1937 (variable-item spam-use-gmane-xref) 1938 (variable-item spam-use-regex-headers) 1939 (variable-item spam-use-regex-body) 1940 (variable-item spam-use-whitelist) 1941 (variable-item spam-use-BBDB) 1942 (variable-item spam-use-ifile) 1943 (variable-item spam-use-spamoracle) 1944 (variable-item spam-use-crm114) 1945 (variable-item spam-use-stat) 1946 (variable-item spam-use-blackholes) 1947 (variable-item spam-use-hashcash) 1948 (variable-item spam-use-spamassassin) 1949 (variable-item spam-use-spamassassin-headers) 1950 (variable-item spam-use-bsfilter) 1951 (variable-item spam-use-bsfilter-headers) 1952 (variable-item spam-use-bogofilter-headers) 1953 (variable-item spam-use-bogofilter))))) 1954 :parameter-document 1955 "Spam autodetection methods. 1956Requires the spam-autodetect parameter. Only unseen articles 1957will be examined, unless spam-autodetect-recheck-messages is 1958set.") 1959 1960 (gnus-define-group-parameter 1961 spam-process-destination 1962 :type list 1963 :parameter-type 1964 '(choice :tag "Destination for spam-processed articles at summary exit" 1965 (string :tag "Move to a group") 1966 (repeat :tag "Move to multiple groups" 1967 (string :tag "Destination group")) 1968 (const :tag "Expire" nil)) 1969 :function-document 1970 "Where spam-processed articles will go at summary exit." 1971 :variable gnus-spam-process-destinations 1972 :variable-default nil 1973 :variable-document 1974 "Groups in which to explicitly send spam-processed articles to 1975another group, or expire them (the default). If non-nil, this should 1976be a list of group name regexps that should match all groups in which 1977to do spam-processed article moving, associated with the destination 1978group or nil for explicit expiration. This only makes sense for 1979mail groups." 1980 :variable-group spam 1981 :variable-type 1982 '(repeat 1983 :tag "Spam-processed articles destination" 1984 (list 1985 (regexp :tag "Group Regexp") 1986 (choice 1987 :tag "Destination for spam-processed articles at summary exit" 1988 (string :tag "Move to a group") 1989 (repeat :tag "Move to multiple groups" 1990 (string :tag "Destination group")) 1991 (const :tag "Expire" nil)))) 1992 :parameter-document 1993 "Where spam-processed articles will go at summary exit.") 1994 1995 (gnus-define-group-parameter 1996 ham-process-destination 1997 :type list 1998 :parameter-type 1999 '(choice 2000 :tag "Destination for ham articles at summary exit from a spam group" 2001 (string :tag "Move to a group") 2002 (repeat :tag "Move to multiple groups" 2003 (string :tag "Destination group")) 2004 (const :tag "Respool" respool) 2005 (const :tag "Do nothing" nil)) 2006 :function-document 2007 "Where ham articles will go at summary exit from a spam group." 2008 :variable gnus-ham-process-destinations 2009 :variable-default nil 2010 :variable-document 2011 "Groups in which to explicitly send ham articles to 2012another group, or do nothing (the default). If non-nil, this should 2013be a list of group name regexps that should match all groups in which 2014to do ham article moving, associated with the destination 2015group or nil for explicit ignoring. This only makes sense for 2016mail groups, and only works in spam groups." 2017 :variable-group spam 2018 :variable-type 2019 '(repeat 2020 :tag "Ham articles destination" 2021 (list 2022 (regexp :tag "Group Regexp") 2023 (choice 2024 :tag "Destination for ham articles at summary exit from spam group" 2025 (string :tag "Move to a group") 2026 (repeat :tag "Move to multiple groups" 2027 (string :tag "Destination group")) 2028 (const :tag "Respool" respool) 2029 (const :tag "Expire" nil)))) 2030 :parameter-document 2031 "Where ham articles will go at summary exit from a spam group.") 2032 2033 (gnus-define-group-parameter 2034 ham-marks 2035 :type 'list 2036 :parameter-type '(list :tag "Ham mark choices" 2037 (set 2038 (variable-item gnus-del-mark) 2039 (variable-item gnus-read-mark) 2040 (variable-item gnus-ticked-mark) 2041 (variable-item gnus-killed-mark) 2042 (variable-item gnus-kill-file-mark) 2043 (variable-item gnus-low-score-mark))) 2044 2045 :parameter-document 2046 "Marks considered ham (positively not spam). Such articles will be 2047processed as ham (non-spam) on group exit. When nil, the global 2048spam-ham-marks variable takes precedence." 2049 :variable-default '((".*" ((gnus-del-mark 2050 gnus-read-mark 2051 gnus-killed-mark 2052 gnus-kill-file-mark 2053 gnus-low-score-mark)))) 2054 :variable-group spam 2055 :variable-document 2056 "Groups in which to explicitly set the ham marks to some value.") 2057 2058 (gnus-define-group-parameter 2059 spam-marks 2060 :type 'list 2061 :parameter-type '(list :tag "Spam mark choices" 2062 (set 2063 (variable-item gnus-spam-mark) 2064 (variable-item gnus-killed-mark) 2065 (variable-item gnus-kill-file-mark) 2066 (variable-item gnus-low-score-mark))) 2067 2068 :parameter-document 2069 "Marks considered spam. 2070Such articles will be processed as spam on group exit. When nil, the global 2071spam-spam-marks variable takes precedence." 2072 :variable-default '((".*" ((gnus-spam-mark)))) 2073 :variable-group spam 2074 :variable-document 2075 "Groups in which to explicitly set the spam marks to some value.")) 2076 2077(defcustom gnus-group-uncollapsed-levels 1 2078 "Number of group name elements to leave alone when making a short group name." 2079 :group 'gnus-group-visual 2080 :type 'integer) 2081 2082(defcustom gnus-group-use-permanent-levels nil 2083 "If non-nil, once you set a level, Gnus will use this level." 2084 :group 'gnus-group-levels 2085 :type 'boolean) 2086 2087;; Hooks. 2088 2089(defcustom gnus-load-hook nil 2090 "A hook run while Gnus is loaded." 2091 :group 'gnus-start 2092 :type 'hook) 2093 2094(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file) 2095 "A hook called to apply kill files to a group. 2096This hook is intended to apply a kill file to the selected newsgroup. 2097The function `gnus-apply-kill-file' is called by default. 2098 2099Since a general kill file is too heavy to use only for a few 2100newsgroups, I recommend you to use a lighter hook function. For 2101example, if you'd like to apply a kill file to articles which contains 2102a string `rmgroup' in subject in newsgroup `control', you can use the 2103following hook: 2104 2105 (setq gnus-apply-kill-hook 2106 (list 2107 (lambda () 2108 (cond ((string-match \"control\" gnus-newsgroup-name) 2109 (gnus-kill \"Subject\" \"rmgroup\") 2110 (gnus-expunge \"X\"))))))" 2111 :group 'gnus-score-kill 2112 :options '(gnus-apply-kill-file) 2113 :type 'hook) 2114 2115(defcustom gnus-group-change-level-function nil 2116 "Function run when a group level is changed. 2117It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." 2118 :group 'gnus-group-levels 2119 :type '(choice (const nil) 2120 function)) 2121 2122;;; Face thingies. 2123 2124(defcustom gnus-visual 2125 '(summary-highlight group-highlight article-highlight 2126 mouse-face 2127 summary-menu group-menu article-menu 2128 tree-highlight menu highlight 2129 browse-menu server-menu 2130 page-marker tree-menu binary-menu pick-menu) 2131 "Enable visual features. 2132If `visual' is disabled, there will be no menus and few faces. Most of 2133the visual customization options below will be ignored. Gnus will use 2134less space and be faster as a result. 2135 2136This variable can also be a list of visual elements to switch on. For 2137instance, to switch off all visual things except menus, you can say: 2138 2139 (setq gnus-visual \\='(menu)) 2140 2141Valid elements include `summary-highlight', `group-highlight', 2142`article-highlight', `mouse-face', `summary-menu', `group-menu', 2143`article-menu', `tree-highlight', `menu', `highlight', 2144`browse-menu', `server-menu', `page-marker', `tree-menu', 2145`binary-menu', and `pick-menu'." 2146 :group 'gnus-meta 2147 :group 'gnus-visual 2148 :type '(set (const summary-highlight) 2149 (const group-highlight) 2150 (const article-highlight) 2151 (const mouse-face) 2152 (const summary-menu) 2153 (const group-menu) 2154 (const article-menu) 2155 (const tree-highlight) 2156 (const menu) 2157 (const highlight) 2158 (const browse-menu) 2159 (const server-menu) 2160 (const page-marker) 2161 (const tree-menu) 2162 (const binary-menu) 2163 (const pick-menu))) 2164 2165;; Byte-compiler warning. 2166(defvar gnus-visual) 2167;; Find out whether the gnus-visual TYPE is wanted. 2168(defun gnus-visual-p (&optional type class) 2169 (and gnus-visual ; Has to be non-nil, at least. 2170 (if (not type) ; We don't care about type. 2171 gnus-visual 2172 (if (listp gnus-visual) ; It's a list, so we check it. 2173 (or (memq type gnus-visual) 2174 (memq class gnus-visual)) 2175 t)))) 2176 2177(defcustom gnus-mouse-face 2178 (condition-case () 2179 (if (gnus-visual-p 'mouse-face 'highlight) 2180 (if (boundp 'gnus-mouse-face) 2181 (or gnus-mouse-face 'highlight) 2182 'highlight) 2183 'default) 2184 (error 'highlight)) 2185 "Face used for group or summary buffer mouse highlighting. 2186The line beneath the mouse pointer will be highlighted with this 2187face." 2188 :group 'gnus-visual 2189 :type 'face) 2190 2191(defcustom gnus-article-save-directory gnus-directory 2192 "Name of the directory articles will be saved in (default \"~/News\")." 2193 :group 'gnus-article-saving 2194 :type 'directory) 2195 2196(defvar gnus-plugged t 2197 "Whether Gnus is plugged or not.") 2198 2199(defcustom gnus-agent-cache t 2200 "Controls use of the agent cache while plugged. 2201When set, Gnus will prefer using the locally stored content rather 2202than re-fetching it from the server. You also need to enable 2203`gnus-agent' for this to have any affect." 2204 :version "22.1" 2205 :group 'gnus-agent 2206 :type 'boolean) 2207 2208(defcustom gnus-default-charset 'undecided 2209 "Default charset assumed to be used when viewing non-ASCII characters. 2210This variable is overridden on a group-to-group basis by the 2211`gnus-group-charset-alist' variable and is only used on groups not 2212covered by that variable." 2213 :type 'symbol 2214 :group 'gnus-charset) 2215 2216;; Fixme: Doc reference to agent. 2217(defcustom gnus-agent t 2218 "Whether we want to use the Gnus agent or not. 2219 2220You may customize `gnus-agent' to disable its use. However, some 2221back ends have started to use the agent as a client-side cache. 2222Disabling the agent may result in noticeable loss of performance." 2223 :version "22.1" 2224 :group 'gnus-agent 2225 :type 'boolean) 2226 2227(defcustom gnus-other-frame-function #'gnus 2228 "Function called by the command `gnus-other-frame' when starting Gnus." 2229 :group 'gnus-start 2230 :type '(choice (function-item gnus) 2231 (function-item gnus-no-server) 2232 (function-item gnus-child) 2233 (function-item gnus-child-no-server))) 2234 2235(declare-function gnus-group-get-new-news "gnus-group") 2236 2237(defcustom gnus-other-frame-resume-function #'gnus-group-get-new-news 2238 "Function called by the command `gnus-other-frame' when resuming Gnus." 2239 :version "24.4" 2240 :group 'gnus-start 2241 :type '(choice (function-item gnus) 2242 (function-item gnus-group-get-new-news) 2243 (function-item gnus-no-server) 2244 (function-item gnus-child) 2245 (function-item gnus-child-no-server))) 2246 2247(defcustom gnus-other-frame-parameters nil 2248 "Frame parameters used by `gnus-other-frame' to create a Gnus frame." 2249 :group 'gnus-start 2250 :type '(repeat (cons :format "%v" 2251 (symbol :tag "Parameter") 2252 (sexp :tag "Value")))) 2253 2254(defcustom gnus-user-agent '(emacs gnus type) 2255 "Which information should be exposed in the User-Agent header. 2256 2257Can be a list of symbols or a string. Valid symbols are `gnus' 2258\(show Gnus version) and `emacs' \(show Emacs version). In 2259addition to the Emacs version, you can add `codename' \(show 2260\(S)XEmacs codename) or either `config' \(show system 2261configuration) or `type' \(show system type). If you set it to 2262a string, be sure to use a valid format, see RFC 2616." 2263 2264 :version "22.1" 2265 :group 'gnus-message 2266 :type '(choice (list (set :inline t 2267 (const gnus :tag "Gnus version") 2268 (const emacs :tag "Emacs version") 2269 (choice :tag "system" 2270 (const type :tag "system type") 2271 (const config :tag "system configuration")) 2272 (const codename :tag "Emacs codename"))) 2273 (string))) 2274 2275;; Convert old (< 2005-01-10) symbol type values: 2276(when (symbolp gnus-user-agent) 2277 (setq gnus-user-agent 2278 (cond ((eq gnus-user-agent 'emacs-gnus-config) 2279 '(emacs gnus config)) 2280 ((eq gnus-user-agent 'emacs-gnus-type) 2281 '(emacs gnus type)) 2282 ((eq gnus-user-agent 'emacs-gnus) 2283 '(emacs gnus)) 2284 ((eq gnus-user-agent 'gnus) 2285 '(gnus)) 2286 (t gnus-user-agent))) 2287 (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent) 2288 (sit-for 1) 2289 (if (get 'gnus-user-agent 'saved-value) 2290 (customize-save-variable 'gnus-user-agent gnus-user-agent) 2291 (gnus-message 1 "Edit your init file to make this change permanent.") 2292 (sit-for 2))) 2293 2294(defcustom gnus-agent-eagerly-store-articles t 2295 "If non-nil, cache articles eagerly. 2296 2297When using the Gnus Agent and reading an agentized newsgroup, 2298automatically cache the article in the agent cache." 2299 :type 'boolean 2300 :version "28.1") 2301 2302 2303;;; Internal variables 2304 2305(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") 2306(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") 2307(defvar gnus-agent-method-p-cache nil 2308 ; Reset each time gnus-agent-covered-methods is changed else 2309 ; gnus-agent-method-p may mis-report a methods status. 2310 ) 2311(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") 2312(defvar gnus-draft-meta-information-header "X-Draft-From") 2313(defvar gnus-group-get-parameter-function #'gnus-group-get-parameter) 2314(defvar gnus-original-article-buffer " *Original Article*") 2315(defvar gnus-newsgroup-name nil) 2316(defvar gnus-ephemeral-servers nil) 2317(defvar gnus-server-method-cache nil) 2318(defvar gnus-extended-servers nil) 2319 2320;; The carpal mode has been removed, but define the variable for 2321;; backwards compatibility. 2322(defvar gnus-carpal nil) 2323(make-obsolete-variable 'gnus-carpal nil "24.1") 2324 2325(defvar gnus-agent-fetching nil 2326 "Whether Gnus agent is in fetching mode.") 2327 2328(defvar gnus-agent-covered-methods nil 2329 "A list of servers, NOT methods, showing which servers are covered by the agent.") 2330 2331(defvar gnus-command-method nil 2332 "Dynamically bound variable that says what the current back end is.") 2333 2334(defvar gnus-current-select-method nil 2335 "The current method for selecting a newsgroup.") 2336 2337(defvar gnus-tree-buffer "*Tree*" 2338 "Buffer where Gnus thread trees are displayed.") 2339 2340;; Variable holding the user answers to all method prompts. 2341(defvar gnus-method-history nil) 2342 2343;; Variable holding the user answers to all mail method prompts. 2344(defvar gnus-mail-method-history nil) 2345 2346;; Variable holding the user answers to all group prompts. 2347(defvar gnus-group-history nil) 2348 2349(defvar gnus-server-alist nil 2350 "Servers created by Gnus, or via the server buffer. 2351Servers defined in the user's config files do not appear here. 2352This variable is persisted in the user's .newsrc.eld file.") 2353 2354(defcustom gnus-cache-directory 2355 (nnheader-concat gnus-directory "cache/") 2356 "The directory where cached articles will be stored." 2357 :group 'gnus-cache 2358 :type 'directory) 2359 2360(defvar gnus-predefined-server-alist 2361 `(("cache" 2362 nnspool "cache" 2363 (nnspool-spool-directory ,gnus-cache-directory) 2364 (nnspool-nov-directory ,gnus-cache-directory) 2365 (nnspool-active-file 2366 ,(nnheader-concat gnus-cache-directory "active")))) 2367 "List of predefined (convenience) servers.") 2368 2369(defconst gnus-article-mark-lists 2370 '((marked . tick) (replied . reply) 2371 (expirable . expire) (killed . killed) 2372 (bookmarks . bookmark) (dormant . dormant) 2373 (scored . score) (saved . save) 2374 (cached . cache) (downloadable . download) 2375 (unsendable . unsend) (forwarded . forward) 2376 (seen . seen) (unexist . unexist))) 2377 2378(defconst gnus-article-special-mark-lists 2379 '((seen range) 2380 (unexist range) 2381 (killed range) 2382 (bookmark tuple) 2383 (uid tuple) 2384 (active tuple) 2385 (score tuple))) 2386 2387;; Propagate flags to server, with the following exceptions: 2388;; `seen' is private to each gnus installation 2389;; `cache' is an internal gnus flag for each gnus installation 2390;; `download' is an agent flag private to each gnus installation 2391;; `unsend' are for nndraft groups only 2392;; `score' is not a proper mark 2393;; `bookmark': don't propagate it, or fix the bug in update-mark. 2394(defconst gnus-article-unpropagated-mark-lists 2395 '(seen cache download unsend score bookmark unexist) 2396 "Marks that shouldn't be propagated to back ends. 2397Typical marks are those that make no sense in a standalone back end, 2398such as a mark that says whether an article is stored in the cache 2399\(which doesn't make sense in a standalone back end).") 2400 2401(defvar gnus-headers-retrieved-by nil) 2402(defvar gnus-article-reply nil) 2403(defvar gnus-override-method nil) 2404(defvar gnus-opened-servers nil) 2405 2406(defvar gnus-current-kill-article nil) 2407 2408(defvar gnus-have-read-active-file nil) 2409 2410(defconst gnus-maintainer 2411 "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" 2412 "The mail address of the Gnus maintainers.") 2413 2414(defconst gnus-bug-package 2415 "emacs,gnus" 2416 "The package to use in the bug submission.") 2417 2418(defvar gnus-info-nodes 2419 '((gnus-group-mode "(gnus)Group Buffer") 2420 (gnus-summary-mode "(gnus)Summary Buffer") 2421 (gnus-article-mode "(gnus)Article Buffer") 2422 (gnus-server-mode "(gnus)Server Buffer") 2423 (gnus-browse-mode "(gnus)Browse Foreign Server") 2424 (gnus-tree-mode "(gnus)Tree Display")) 2425 "Alist of major modes and related Info nodes.") 2426 2427(defvar gnus-summary-buffer "*Summary*") 2428(defvar gnus-article-buffer "*Article*") 2429(defvar gnus-server-buffer "*Server*") 2430 2431(defvar gnus-child nil 2432 "Whether this Gnus is a child or not.") 2433 2434(defvar gnus-batch-mode nil 2435 "Whether this Gnus is running in batch mode or not.") 2436 2437(defvar gnus-variable-list 2438 '(gnus-newsrc-options gnus-newsrc-options-n 2439 gnus-newsrc-last-checked-date 2440 gnus-newsrc-alist gnus-server-alist 2441 gnus-killed-list gnus-zombie-list 2442 gnus-topic-topology gnus-topic-alist 2443 gnus-cloud-sequence 2444 gnus-cloud-covered-servers 2445 gnus-cloud-file-timestamps) 2446 "Gnus variables saved in the quick startup file.") 2447 2448(defvar gnus-newsrc-alist nil 2449 "Assoc list of read articles. 2450`gnus-newsrc-hashtb' should be kept so that both hold the same information.") 2451 2452(defvar gnus-registry-alist nil 2453 "Assoc list of registry data. 2454gnus-registry.el will populate this if it's loaded.") 2455 2456(defvar gnus-newsrc-hashtb nil 2457 "Hash table of `gnus-newsrc-alist'.") 2458 2459(defvar gnus-group-list nil 2460 "Ordered list of group names as strings. 2461This variable only exists to provide easy access to the ordering 2462of `gnus-newsrc-alist'.") 2463 2464(defvar gnus-killed-list nil 2465 "List of killed newsgroups.") 2466 2467(defvar gnus-killed-hashtb nil 2468 "Hash table equivalent of `gnus-killed-list'. 2469This is a hash table purely for the fast membership test: values 2470are always t.") 2471 2472(defvar gnus-zombie-list nil 2473 "List of almost dead newsgroups.") 2474 2475(defvar gnus-description-hashtb nil 2476 "Hash table mapping group names to their descriptions.") 2477 2478(defvar gnus-list-of-killed-groups nil 2479 "List of newsgroups that have recently been killed by the user.") 2480 2481(defvar gnus-active-hashtb nil 2482 "Hash table mapping group names to their active entry.") 2483 2484(defvar gnus-moderated-hashtb nil 2485 "Hash table of moderated groups. 2486This is a hash table purely for the fast membership test: values 2487are always t.") 2488 2489;; Save window configuration. 2490(defvar gnus-prev-winconf nil) 2491 2492(defvar gnus-reffed-article-number nil) 2493 2494(defvar gnus-dead-summary nil) 2495 2496(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" 2497 "Regexp matching invalid groups.") 2498 2499(defvar gnus-other-frame-object nil 2500 "A frame object which will be created by `gnus-other-frame'.") 2501 2502;;; End of variables. 2503 2504;; Define some autoload functions Gnus might use. 2505(eval-and-compile 2506 2507 ;; This little mapcar goes through the list below and marks the 2508 ;; symbols in question as autoloaded functions. 2509 (mapc 2510 (lambda (package) 2511 (let ((interactive (nth 1 (memq ':interactive package)))) 2512 (mapcar 2513 (lambda (function) 2514 (let (type) 2515 (when (consp function) 2516 (setq type (cadr function)) 2517 (setq function (car function))) 2518 (unless (fboundp function) 2519 (autoload function (car package) nil interactive type)))) 2520 (if (eq (nth 1 package) ':interactive) 2521 (nthcdr 3 package) 2522 (cdr package))))) 2523 '(("info" :interactive t Info-goto-node) 2524 ("qp" quoted-printable-decode-region quoted-printable-decode-string) 2525 ("ps-print" ps-print-preprint) 2526 ("message" :interactive (message-mode) 2527 message-send-and-exit message-yank-original) 2528 ("babel" babel-as-string) 2529 ("nnmail" nnmail-split-fancy nnmail-article-group) 2530 ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) 2531 ("gnus-xmas" gnus-xmas-splash) 2532 ("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score) 2533 ("gnus-mh" gnus-summary-save-article-folder 2534 gnus-Folder-save-name gnus-folder-save-name) 2535 ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) 2536 ("gnus-demon" gnus-demon-add-scanmail 2537 gnus-demon-add-rescan gnus-demon-add-scan-timestamps 2538 gnus-demon-add-disconnection gnus-demon-add-handler 2539 gnus-demon-remove-handler) 2540 ("gnus-demon" :interactive t 2541 gnus-demon-init gnus-demon-cancel) 2542 ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from 2543 gnus-convert-image-to-gray-x-face gnus-convert-face-to-png 2544 gnus-face-from-file) 2545 ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree 2546 gnus-tree-open gnus-tree-close) 2547 ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info 2548 gnus-server-server-name) 2549 ("gnus-srvr" gnus-browse-foreign-server) 2550 ("gnus-cite" :interactive (gnus-article-mode gnus-summary-mode) 2551 gnus-article-highlight-citation gnus-article-hide-citation-maybe 2552 gnus-article-hide-citation gnus-article-fill-cited-article 2553 gnus-article-hide-citation-in-followups 2554 gnus-article-fill-cited-long-lines) 2555 ("gnus-kill" gnus-kill gnus-apply-kill-file-internal 2556 gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author 2557 gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) 2558 ("gnus-registry" gnus-try-warping-via-registry 2559 gnus-registry-handle-action) 2560 ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers 2561 gnus-cache-possibly-remove-articles gnus-cache-request-article 2562 gnus-cache-retrieve-headers gnus-cache-possibly-alter-active 2563 gnus-cache-enter-remove-article gnus-cached-article-p 2564 gnus-cache-open gnus-cache-close gnus-cache-update-article 2565 gnus-cache-articles-in-group) 2566 ("gnus-cache" :interactive (gnus-summary-mode) 2567 gnus-summary-insert-cached-articles gnus-cache-enter-article 2568 gnus-cache-remove-article gnus-summary-insert-cached-articles) 2569 ("gnus-cache" :interactive t gnus-jog-cache) 2570 ("gnus-score" :interactive t 2571 gnus-score-flush-cache gnus-score-close) 2572 ("gnus-score" :interactive (gnus-summary-mode) 2573 gnus-summary-increase-score gnus-summary-set-score 2574 gnus-summary-raise-thread gnus-summary-raise-same-subject 2575 gnus-summary-raise-score gnus-summary-raise-same-subject-and-select 2576 gnus-summary-lower-thread gnus-summary-lower-same-subject 2577 gnus-summary-lower-score gnus-summary-lower-same-subject-and-select 2578 gnus-summary-current-score gnus-score-delta-default 2579 gnus-possibly-score-headers gnus-score-followup-article 2580 gnus-score-followup-thread) 2581 ("gnus-score" 2582 (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers 2583 gnus-current-score-file-nondirectory gnus-score-adaptive 2584 gnus-score-find-trace gnus-score-file-name) 2585 ("gnus-cus" :interactive (gnus-group-mode) gnus-group-customize) 2586 ("gnus-cus" :interactive (gnus-summary-mode) gnus-score-customize) 2587 ("gnus-topic" :interactive (gnus-group-mode) gnus-topic-mode) 2588 ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters 2589 gnus-subscribe-topics) 2590 ("gnus-salt" :interactive (gnus-summary-mode) 2591 gnus-pick-mode gnus-binary-mode) 2592 ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) 2593 ("gnus-uu" :interactive (gnus-article-mode gnus-summary-mode) 2594 gnus-uu-digest-mail-forward gnus-uu-digest-post-forward 2595 gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer 2596 gnus-uu-mark-by-regexp gnus-uu-mark-all 2597 gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu 2598 gnus-uu-decode-uu-and-save gnus-uu-decode-unshar 2599 gnus-uu-decode-unshar-and-save gnus-uu-decode-save 2600 gnus-uu-decode-binhex gnus-uu-decode-uu-view 2601 gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view 2602 gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view 2603 gnus-uu-decode-binhex-view gnus-uu-unmark-thread 2604 gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable 2605 gnus-uu-decode-postscript-and-save-view 2606 gnus-uu-decode-postscript-view gnus-uu-decode-postscript-and-save 2607 gnus-uu-decode-yenc gnus-uu-unmark-by-regexp gnus-uu-unmark-region 2608 gnus-uu-decode-postscript) 2609 ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) 2610 ("gnus-msg" (gnus-summary-send-map keymap) 2611 gnus-article-mail gnus-copy-article-buffer gnus-extended-version) 2612 ("gnus-msg" :interactive (gnus-group-mode) 2613 gnus-group-post-news gnus-group-mail gnus-group-news) 2614 ("gnus-msg" :interactive (gnus-summary-mode) 2615 gnus-summary-post-news gnus-summary-news-other-window 2616 gnus-summary-followup gnus-summary-followup-with-original 2617 gnus-summary-cancel-article gnus-summary-supersede-article 2618 gnus-summary-reply gnus-summary-reply-with-original 2619 gnus-summary-mail-forward gnus-summary-mail-other-window 2620 gnus-summary-resend-message gnus-summary-resend-bounced-mail 2621 gnus-summary-wide-reply gnus-summary-followup-to-mail 2622 gnus-summary-followup-to-mail-with-original gnus-bug 2623 gnus-summary-wide-reply-with-original 2624 gnus-summary-post-forward gnus-summary-wide-reply-with-original 2625 gnus-summary-post-forward) 2626 ("gnus-msg" gnus-post-news) 2627 ("gnus-picon" :interactive (gnus-article-mode gnus-summary-mode) 2628 gnus-treat-from-picon) 2629 ("smiley" :interactive t smiley-region) 2630 ("gnus-win" gnus-configure-windows gnus-add-configuration) 2631 ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group 2632 gnus-list-of-unread-articles gnus-list-of-read-articles 2633 gnus-offer-save-summaries gnus-make-thread-indent-array 2634 gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject 2635 gnus-summary-skip-intangible gnus-summary-article-number 2636 gnus-data-header gnus-data-find) 2637 ("gnus-group" gnus-group-insert-group-line gnus-group-quit 2638 gnus-group-list-groups gnus-group-first-unread-group 2639 gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc 2640 gnus-group-setup-buffer gnus-group-get-new-news 2641 gnus-group-make-help-group gnus-group-update-group 2642 gnus-group-iterate gnus-group-group-name) 2643 ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article 2644 gnus-backlog-remove-article) 2645 ("gnus-art" gnus-article-read-summary-keys gnus-article-save 2646 gnus-article-prepare gnus-article-set-window-start 2647 gnus-article-next-page gnus-article-prev-page 2648 gnus-request-article-this-buffer gnus-article-mode 2649 gnus-article-setup-buffer gnus-narrow-to-page 2650 gnus-article-delete-invisible-text gnus-treat-article) 2651 ("gnus-art" :interactive (gnus-summary-mode gnus-article-mode) 2652 gnus-article-hide-headers gnus-article-hide-boring-headers 2653 gnus-article-treat-overstrike 2654 gnus-article-remove-cr gnus-article-remove-trailing-blank-lines 2655 gnus-article-emojize-symbols 2656 gnus-article-display-x-face gnus-article-de-quoted-unreadable 2657 gnus-article-de-base64-unreadable 2658 gnus-article-decode-HZ 2659 gnus-article-wash-html 2660 gnus-article-unsplit-urls 2661 gnus-article-hide-pem gnus-article-hide-signature 2662 gnus-article-strip-leading-blank-lines gnus-article-date-local 2663 gnus-article-date-original gnus-article-date-lapsed 2664 gnus-article-edit-mode gnus-article-edit-article 2665 gnus-article-edit-done gnus-article-decode-encoded-words 2666 gnus-start-date-timer gnus-stop-date-timer 2667 gnus-mime-view-all-parts gnus-article-pipe-part 2668 gnus-article-inline-part gnus-article-encrypt-body 2669 gnus-article-browse-html-article gnus-article-view-part-externally 2670 gnus-article-view-part-as-charset gnus-article-copy-part 2671 gnus-article-jump-to-part gnus-article-view-part-as-type 2672 gnus-article-delete-part gnus-article-replace-part 2673 gnus-article-save-part-and-strip gnus-article-save-part 2674 gnus-article-remove-leading-whitespace gnus-article-strip-trailing-space 2675 gnus-article-strip-leading-space gnus-article-strip-all-blank-lines 2676 gnus-article-strip-blank-lines gnus-article-strip-multiple-blank-lines 2677 gnus-article-date-user gnus-article-date-iso8601 2678 gnus-article-date-english gnus-article-date-ut 2679 gnus-article-decode-charset gnus-article-decode-mime-words 2680 gnus-article-toggle-fonts gnus-article-show-images 2681 gnus-article-remove-images gnus-article-display-face 2682 gnus-article-treat-fold-newsgroups gnus-article-treat-unfold-headers 2683 gnus-article-treat-fold-headers gnus-article-highlight-signature 2684 gnus-article-highlight-headers gnus-article-highlight 2685 gnus-article-strip-banner gnus-article-hide-list-identifiers 2686 gnus-article-hide gnus-article-outlook-rearrange-citation 2687 gnus-article-treat-non-ascii gnus-article-treat-smartquotes 2688 gnus-article-verify-x-pgp-sig gnus-article-strip-headers-in-body 2689 gnus-treat-smiley gnus-article-treat-ansi-sequences 2690 gnus-article-capitalize-sentences gnus-article-toggle-truncate-lines 2691 gnus-article-fill-long-lines gnus-article-emphasize 2692 gnus-article-add-buttons-to-head gnus-article-add-button 2693 gnus-article-babel gnus-sticky-article gnus-article-view-part 2694 gnus-article-add-buttons) 2695 ("gnus-int" gnus-request-type) 2696 ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 2697 gnus-dribble-enter gnus-read-init-file gnus-dribble-touch 2698 gnus-check-reasonable-setup) 2699 ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article 2700 gnus-dup-enter-articles) 2701 ("gnus-eform" gnus-edit-form) 2702 ("gnus-logic" gnus-score-advanced) 2703 ("gnus-undo" gnus-undo-mode gnus-undo-register) 2704 ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next 2705 gnus-async-prefetch-article gnus-async-prefetch-remove-group 2706 gnus-async-halt-prefetch) 2707 ("gnus-agent" gnus-open-agent gnus-agent-get-function 2708 gnus-agent-save-active gnus-agent-method-p 2709 gnus-agent-get-undownloaded-list gnus-agent-fetch-session 2710 gnus-summary-set-agent-mark gnus-agent-save-group-info 2711 gnus-agent-request-article gnus-agent-retrieve-headers 2712 gnus-agent-store-article gnus-agent-group-covered-p) 2713 ("gnus-agent" :interactive t 2714 gnus-unplugged gnus-agentize gnus-agent-batch) 2715 ("gnus-vm" :interactive (gnus-summary-mode) gnus-summary-save-in-vm 2716 gnus-summary-save-article-vm) 2717 ("compface" uncompface) 2718 ("gnus-draft" :interactive (gnus-summary-mode) gnus-draft-mode) 2719 ("gnus-draft" :interactive t gnus-group-send-queue) 2720 ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) 2721 ("gnus-mlspl" :interactive (gnus-group-mode) gnus-group-split-setup 2722 gnus-group-split-update) 2723 ("gnus-delay" gnus-delay-initialize)))) 2724 2725;;; gnus-sum.el thingies 2726 2727 2728(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" 2729 "The format specification of the lines in the summary buffer. 2730 2731It works along the same lines as a normal formatting string, 2732with some simple extensions. 2733 2734%N Article number, left padded with spaces (string) 2735%S Subject (string) 2736%s Subject if it is at the root of a thread, and \"\" 2737 otherwise (string) 2738%n Name of the poster (string) 2739%a Extracted name of the poster (string) 2740%A Extracted address of the poster (string) 2741%F Contents of the From: header (string) 2742%f Contents of the From: or To: headers (string) 2743%x Contents of the Xref: header (string) 2744%D Contents of the Date: header article (string) 2745%d Date of the article (string) in DD-MMM format 2746%o Date of the article (string) in YYYYMMDD`T'HHMMSS 2747 format 2748%M Message-id of the article (string) 2749%r References of the article (string) 2750%c Number of characters in the article (integer) 2751%k Pretty-printed version of the above (string) 2752 For example, \"1.2k\" or \"0.4M\". 2753%L Number of lines in the article (integer) 2754%Z RSV of the article; nil if not in an nnselect group (integer) 2755%G Originating group name for the article; nil if not 2756 in an nnselect group (string) 2757%g Short from of the originating group name for the article; 2758 nil if not in an nnselect group (string) 2759%I Indentation based on thread level (a string of 2760 spaces) 2761%B A complex trn-style thread tree (string) 2762 The variables `gnus-sum-thread-*' can be used for 2763 customization. 2764%T A string with two possible values: 80 spaces if the 2765 article is on thread level two or larger and 0 spaces 2766 on level one 2767%R \"A\" if this article has been replied to, \" \" 2768 otherwise (character) 2769%U \"Read\" status of this article. 2770 See Info node `(gnus)Marking Articles' 2771%[ Opening bracket (character, \"[\" or \"<\") 2772%] Closing bracket (character, \"]\" or \">\") 2773%> Spaces of length thread-level (string) 2774%< Spaces of length (- 20 thread-level) (string) 2775%i Article score (number) 2776%z Article zcore (character) 2777%t Number of articles under the current thread (number). 2778%e Whether the thread is empty or not (character). 2779%V Total thread score (number). 2780%P The line number (number). 2781%O Download mark (character). 2782%* If present, indicates desired cursor position 2783 (instead of after first colon). 2784%u User defined specifier. The next character in the 2785 format string should be a letter. Gnus will call the 2786 function gnus-user-format-function-X, where X is the 2787 letter following %u. The function will be passed the 2788 current header as argument. The function should 2789 return a string, which will be inserted into the 2790 summary just like information from any other summary 2791 specifier. 2792&user-date; Age sensitive date format. Various date format is 2793 defined in `gnus-user-date-format-alist'. 2794 2795 2796The %U (status), %R (replied) and %z (zcore) specs have to be handled 2797with care. For reasons of efficiency, Gnus will compute what column 2798these characters will end up in, and \"hard-code\" that. This means that 2799it is invalid to have these specs after a variable-length spec. Well, 2800you might not be arrested, but your summary buffer will look strange, 2801which is bad enough. 2802 2803The smart choice is to have these specs as far to the left as 2804possible. 2805 2806This restriction may disappear in later versions of Gnus. 2807 2808General format specifiers can also be used. 2809See Info node `(gnus)Formatting Variables'." 2810 :link '(custom-manual "(gnus)Formatting Variables") 2811 :type 'string 2812 :group 'gnus-summary-format) 2813 2814;;; 2815;;; Skeleton keymaps 2816;;; 2817 2818(defun gnus-suppress-keymap (keymap) 2819 (suppress-keymap keymap) 2820 (let ((keys '([delete] "\177" "\M-u"))) ;[mouse-2] 2821 (while keys 2822 (define-key keymap (pop keys) 'undefined)))) 2823 2824(defvar gnus-article-mode-map 2825 (let ((keymap (make-sparse-keymap))) 2826 (gnus-suppress-keymap keymap) 2827 keymap)) 2828(defvar gnus-summary-mode-map 2829 (let ((keymap (make-keymap))) 2830 (gnus-suppress-keymap keymap) 2831 keymap)) 2832(defvar gnus-group-mode-map 2833 (let ((keymap (make-keymap))) 2834 (gnus-suppress-keymap keymap) 2835 keymap)) 2836 2837 2838 2839;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. 2840;; If you want the cursor to go somewhere else, set these two 2841;; functions in some startup hook to whatever you want. 2842(defalias 'gnus-summary-position-point 'gnus-goto-colon) 2843(defalias 'gnus-group-position-point 'gnus-goto-colon) 2844 2845;;; Various macros and substs. 2846 2847(defun gnus-header-from (header) 2848 (mail-header-from header)) 2849 2850(defmacro gnus-group-unread (group) 2851 "Get the currently computed number of unread articles in GROUP." 2852 `(car (gethash ,group gnus-newsrc-hashtb))) 2853 2854(defmacro gnus-group-entry (group) 2855 "Get the newsrc entry for GROUP." 2856 `(gethash ,group gnus-newsrc-hashtb)) 2857 2858(defmacro gnus-active (group) 2859 "Get active info on GROUP." 2860 `(gethash ,group gnus-active-hashtb)) 2861 2862(defmacro gnus-set-active (group active) 2863 "Set GROUP's active info." 2864 `(puthash ,group ,active gnus-active-hashtb)) 2865 2866;; Info access macros. 2867 2868(cl-defstruct (gnus-info 2869 (:constructor gnus-info-make 2870 (group rank read &optional marks method params)) 2871 (:constructor nil) 2872 ;; FIXME: gnus-newsrc-alist contains a list of those, 2873 ;; so changing them to a real struct will take more work! 2874 (:type list)) 2875 group rank read marks method params) 2876 2877(defsubst gnus-info-level (info) 2878 (declare (gv-setter gnus-info--set-level)) 2879 (let ((rank (gnus-info-rank info))) 2880 (if (consp rank) 2881 (car rank) 2882 rank))) 2883(defsubst gnus-info-score (info) 2884 (declare (gv-setter gnus-info--set-score)) 2885 (let ((rank (gnus-info-rank info))) 2886 (or (and (consp rank) (cdr rank)) 0))) 2887 2888(defsubst gnus-info-set-marks (info marks &optional extend) 2889 (if extend (gnus-info--grow-entry info 3)) 2890 (setf (gnus-info-marks info) marks)) 2891(defsubst gnus-info-set-method (info method &optional extend) 2892 (if extend (gnus-info--grow-entry info 4)) 2893 (setf (gnus-info-method info) method)) 2894(defsubst gnus-info-set-params (info params &optional extend) 2895 (if extend (gnus-info--grow-entry info 5)) 2896 (setf (gnus-info-params info) params)) 2897 2898(defun gnus-info--grow-entry (info number) 2899 ;; Extend the info until we have enough elements. 2900 (while (<= (length info) number) 2901 (nconc info (list nil)))) 2902 2903(defsubst gnus-info--set-level (info level) 2904 (let ((rank (gnus-info-rank info))) 2905 (if (consp rank) 2906 (setcar rank level) 2907 (setf (gnus-info-rank info) level)))) 2908(defsubst gnus-info--set-score (info score) 2909 (let ((rank (gnus-info-rank info))) 2910 (if (consp rank) 2911 (setcdr rank score) 2912 (setf (gnus-info-rank info) (cons rank score))))) 2913 2914(defsubst gnus-get-info (group) 2915 (nth 1 (gethash group gnus-newsrc-hashtb))) 2916 2917(defun gnus-set-info (group info) 2918 (setcdr (gethash group gnus-newsrc-hashtb) 2919 (list info))) 2920 2921 2922;;; 2923;;; Shutdown 2924;;; 2925 2926(defvar gnus-shutdown-alist nil) 2927 2928(defun gnus-add-shutdown (function &rest symbols) 2929 "Run FUNCTION whenever one of SYMBOLS is shut down." 2930 (push (cons function symbols) gnus-shutdown-alist)) 2931 2932(defun gnus-shutdown (symbol) 2933 "Shut down everything that waits for SYMBOL." 2934 (dolist (entry gnus-shutdown-alist) 2935 (when (memq symbol (cdr entry)) 2936 (funcall (car entry))))) 2937 2938 2939;;; 2940;;; Gnus Utility Functions 2941;;; 2942 2943(defun gnus-find-subscribed-addresses () 2944 "Return a regexp matching the addresses of all subscribed mail groups. 2945It consists of the `to-address' or `to-list' parameter of all groups 2946with a `subscribed' parameter." 2947 (let (group address addresses) 2948 (dolist (entry (cdr gnus-newsrc-alist)) 2949 (setq group (car entry)) 2950 (when (gnus-parameter-subscribed group) 2951 (setq address (mail-strip-quoted-names 2952 (or (gnus-group-fast-parameter group 'to-address) 2953 (gnus-group-fast-parameter group 'to-list)))) 2954 (when address 2955 (cl-pushnew address addresses :test #'equal)))) 2956 (when addresses 2957 (list (mapconcat #'regexp-quote addresses "\\|"))))) 2958 2959(defmacro gnus-string-or (&rest strings) 2960 "Return the first element of STRINGS that is a non-blank string. 2961STRINGS will be evaluated in normal `or' order." 2962 `(gnus-string-or-1 (list ,@strings))) 2963 2964(defun gnus-string-or-1 (strings) 2965 (let (string) 2966 (while strings 2967 (setq string (pop strings)) 2968 (if (string-match "^[ \t]*$" string) 2969 (setq string nil) 2970 (setq strings nil))) 2971 string)) 2972 2973(defun gnus-version (&optional arg) 2974 "Version number of this version of Gnus. 2975If ARG, insert string at point." 2976 (interactive "P") 2977 (if arg 2978 (insert (message gnus-version)) 2979 (message gnus-version))) 2980 2981(defun gnus-continuum-version (&optional version) 2982 "Return VERSION as a floating point number." 2983 (unless version 2984 (setq version gnus-version)) 2985 (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) 2986 (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) 2987 (let ((alpha (and (match-beginning 1) (match-string 1 version))) 2988 (number (match-string 2 version)) 2989 major minor least) 2990 (unless (string-match 2991 "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) 2992 (error "Invalid version string: %s" version)) 2993 (setq major (string-to-number (match-string 1 number)) 2994 minor (string-to-number (match-string 2 number)) 2995 least (if (match-beginning 3) 2996 (string-to-number (match-string 3 number)) 2997 0)) 2998 (string-to-number 2999 (if (zerop major) 3000 (format "%1.2f00%02d%02d" 3001 (if (member alpha '("(ding)" "d")) 3002 4.99 3003 (+ 5 (* 0.02 3004 (abs 3005 (- (aref (downcase alpha) 0) ?t))) 3006 -0.01)) 3007 minor least) 3008 (format "%d.%02d%02d" major minor least)))))) 3009 3010(defvar gnus-info-buffer) 3011 3012(defun gnus-info-find-node (&optional nodename) 3013 "Find Info documentation of Gnus." 3014 (interactive) 3015 ;; Enlarge info window if needed. 3016 (let (gnus-info-buffer) 3017 (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes)))) 3018 (setq gnus-info-buffer (current-buffer)) 3019 (gnus-configure-windows 'info))) 3020 3021;;; 3022;;; gnus-interactive 3023;;; 3024 3025(defvar gnus-current-prefix-symbol nil 3026 "Current prefix symbol.") 3027 3028(defvar gnus-current-prefix-symbols nil 3029 "List of current prefix symbols.") 3030 3031(defun gnus-interactive (string) 3032 "Return a list that can be fed to `interactive'. 3033See `interactive' for full documentation. 3034 3035Adds the following specs: 3036 3037y -- The current symbolic prefix. 3038Y -- A list of the current symbolic prefix(es). 3039A -- Article number. 3040H -- Article header. 3041g -- Group name." 3042 (let ((i 0) 3043 out c prompt) 3044 (while (< i (length string)) 3045 (string-match ".\\([^\n]*\\)\n?" string i) 3046 (setq c (aref string i)) 3047 (when (match-end 1) 3048 (setq prompt (match-string 1 string))) 3049 (setq i (match-end 0)) 3050 ;; We basically emulate just about everything that 3051 ;; `interactive' does, but add the specs listed above. 3052 (push 3053 (cond 3054 ((= c ?a) 3055 (completing-read prompt obarray 'fboundp t)) 3056 ((= c ?b) 3057 (read-buffer prompt (current-buffer) t)) 3058 ((= c ?B) 3059 (read-buffer prompt (other-buffer (current-buffer)))) 3060 ((= c ?c) 3061 (read-char)) 3062 ((= c ?C) 3063 (completing-read prompt obarray 'commandp t)) 3064 ((= c ?d) 3065 (point)) 3066 ((= c ?D) 3067 (read-directory-name prompt nil default-directory 'lambda)) 3068 ((= c ?f) 3069 (read-file-name prompt nil nil 'lambda)) 3070 ((= c ?F) 3071 (read-file-name prompt)) 3072 ((= c ?k) 3073 (read-key-sequence prompt)) 3074 ((= c ?K) 3075 (error "Not implemented spec")) 3076 ((= c ?e) 3077 (error "Not implemented spec")) 3078 ((= c ?m) 3079 (mark)) 3080 ((= c ?N) 3081 (error "Not implemented spec")) 3082 ((= c ?n) 3083 (string-to-number (read-from-minibuffer prompt))) 3084 ((= c ?p) 3085 (prefix-numeric-value current-prefix-arg)) 3086 ((= c ?P) 3087 current-prefix-arg) 3088 ((= c ?r) 3089 'gnus-prefix-nil) 3090 ((= c ?s) 3091 (read-string prompt)) 3092 ((= c ?S) 3093 (intern (read-string prompt))) 3094 ((= c ?v) 3095 (read-variable prompt)) 3096 ((= c ?x) 3097 (read-minibuffer prompt)) 3098 ((= c ?x) 3099 (eval-minibuffer prompt)) 3100 ;; And here the new specs come. 3101 ((= c ?y) 3102 gnus-current-prefix-symbol) 3103 ((= c ?Y) 3104 gnus-current-prefix-symbols) 3105 ((= c ?g) 3106 (gnus-group-group-name)) 3107 ((= c ?A) 3108 (gnus-summary-skip-intangible) 3109 (or (get-text-property (point) 'gnus-number) 3110 (gnus-summary-last-subject))) 3111 ((= c ?H) 3112 (gnus-data-header (gnus-data-find (gnus-summary-article-number)))) 3113 (t 3114 (error "Non-implemented spec"))) 3115 out) 3116 (cond 3117 ((= c ?r) 3118 (push (if (< (point) (mark)) (point) (mark)) out) 3119 (push (if (> (point) (mark)) (point) (mark)) out)))) 3120 (setq out (delq 'gnus-prefix-nil out)) 3121 (nreverse out))) 3122 3123(defun gnus-symbolic-argument () 3124 "Read a symbolic argument and a command, and then execute command." 3125 (interactive) 3126 (let* ((in-command (this-command-keys)) 3127 (command in-command) 3128 gnus-current-prefix-symbols 3129 gnus-current-prefix-symbol 3130 syms) 3131 (while (equal in-command command) 3132 (message "%s-" (key-description (this-command-keys))) 3133 (push (intern (char-to-string (read-char))) syms) 3134 (setq command (read-key-sequence nil t))) 3135 (setq gnus-current-prefix-symbols (nreverse syms) 3136 gnus-current-prefix-symbol (car gnus-current-prefix-symbols)) 3137 (call-interactively (key-binding command t)))) 3138 3139;;; More various functions. 3140 3141(defsubst gnus-check-backend-function (func group) 3142 "Check whether GROUP supports function FUNC. 3143GROUP can either be a string (a group name) or a select method." 3144 (ignore-errors 3145 (when-let ((method (if (stringp group) 3146 (car (gnus-find-method-for-group group)) 3147 group))) 3148 (unless (featurep method) 3149 (require method)) 3150 (fboundp (intern (format "%s-%s" method func)))))) 3151 3152(defun gnus-group-read-only-p (&optional group) 3153 "Check whether GROUP supports editing or not. 3154If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note 3155that that variable is buffer-local to the summary buffers." 3156 (let ((group (or group gnus-newsgroup-name))) 3157 (not (gnus-check-backend-function 'request-replace-article group)))) 3158 3159(defun gnus-virtual-group-p (group) 3160 "Say whether GROUP is virtual or not." 3161 (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) 3162 gnus-valid-select-methods))) 3163 3164(defun gnus-news-group-p (group &optional article) 3165 "Return non-nil if GROUP (and ARTICLE) come from a news server." 3166 (cond ((gnus-member-of-valid 'post group) ;Ordinary news group 3167 t) ;is news of course. 3168 ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. 3169 nil) ;must be mail then. 3170 ((mail-header-p article) ;Has header info. 3171 (eq (gnus-request-type group (mail-header-id article)) 'news)) 3172 ((null article) ;Hasn't header info 3173 (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) 3174 ((< article 0) ;Virtual message 3175 nil) ;we don't know, guess mail. 3176 (t ;Has positive number 3177 (eq (gnus-request-type group article) 'news)))) ;use it. 3178 3179;; Check whether to use long file names. 3180(defun gnus-use-long-file-name (symbol) 3181 ;; The variable has to be set... 3182 (and gnus-use-long-file-name 3183 ;; If it isn't a list, then we return t. 3184 (or (not (listp gnus-use-long-file-name)) 3185 ;; If it is a list, and the list contains `symbol', we 3186 ;; return nil. 3187 (not (memq symbol gnus-use-long-file-name))))) 3188 3189;; Generate a unique new group name. 3190(defun gnus-generate-new-group-name (leaf) 3191 (let ((name leaf) 3192 (num 0)) 3193 (while (gnus-group-entry name) 3194 (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) 3195 name)) 3196 3197(defun gnus-ephemeral-group-p (group) 3198 "Say whether GROUP is ephemeral or not." 3199 (gnus-group-get-parameter group 'quit-config t)) 3200 3201(defun gnus-group-quit-config (group) 3202 "Return the quit-config of GROUP." 3203 (gnus-group-get-parameter group 'quit-config t)) 3204 3205(defun gnus-kill-ephemeral-group (group) 3206 "Remove ephemeral GROUP from relevant structures." 3207 (remhash group gnus-newsrc-hashtb) 3208 (setq gnus-newsrc-alist 3209 (delq (assoc group gnus-newsrc-alist) 3210 gnus-newsrc-alist))) 3211 3212(defun gnus-simplify-mode-line () 3213 "Make mode lines a bit simpler." 3214 (setq mode-line-modified "--") 3215 (when (listp mode-line-format) 3216 (setq-local mode-line-format (copy-sequence mode-line-format)) 3217 (when (equal (nth 3 mode-line-format) " ") 3218 (setcar (nthcdr 3 mode-line-format) " ")))) 3219 3220;;; Servers and groups. 3221 3222(defsubst gnus-server-add-address (method) 3223 (let ((method-name (symbol-name (car method)))) 3224 (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) 3225 (not (assq (intern (concat method-name "-address")) method)) 3226 (memq 'physical-address (assq (car method) 3227 gnus-valid-select-methods))) 3228 (append method (list (list (intern (concat method-name "-address")) 3229 (nth 1 method)))) 3230 method))) 3231 3232(defsubst gnus-method-to-server (method &optional nocache no-enter-cache) 3233 (catch 'server-name 3234 (setq method (or method gnus-select-method)) 3235 3236 ;; Perhaps it is already in the cache. 3237 (unless nocache 3238 (mapc (lambda (name-method) 3239 (if (equal (cdr name-method) method) 3240 (throw 'server-name (car name-method)))) 3241 gnus-server-method-cache)) 3242 3243 (dolist (server-alist 3244 (list gnus-server-alist 3245 gnus-predefined-server-alist)) 3246 (mapc (lambda (name-method) 3247 (when (gnus-methods-equal-p (cdr name-method) method) 3248 (unless (member name-method gnus-server-method-cache) 3249 (push name-method gnus-server-method-cache)) 3250 (throw 'server-name (car name-method)))) 3251 server-alist)) 3252 3253 (let* ((name (if (member (cadr method) '(nil "")) 3254 (format "%s" (car method)) 3255 (format "%s:%s" (car method) (cadr method)))) 3256 (name-method (cons name method))) 3257 (unless (or no-enter-cache 3258 (member name-method gnus-server-method-cache) 3259 (assoc (car name-method) gnus-server-method-cache)) 3260 (push name-method gnus-server-method-cache)) 3261 name))) 3262 3263(defsubst gnus-server-to-method (server) 3264 "Map virtual server names to select methods." 3265 (or (and server (listp server) server) 3266 (cdr (assoc server gnus-server-method-cache)) 3267 (let ((result 3268 (or 3269 ;; Perhaps this is the native server? 3270 (and (equal server "native") gnus-select-method) 3271 ;; It should be in the server alist. 3272 (cdr (assoc server gnus-server-alist)) 3273 ;; It could be in the predefined server alist. 3274 (cdr (assoc server gnus-predefined-server-alist)) 3275 ;; If not, we look through all the opened server 3276 ;; to see whether we can find it there. 3277 (let ((opened gnus-opened-servers)) 3278 (while (and opened 3279 (not (equal server (format "%s:%s" (caaar opened) 3280 (cadaar opened))))) 3281 (pop opened)) 3282 (caar opened)) 3283 ;; It could be a named method, search all servers 3284 (let ((servers gnus-secondary-select-methods)) 3285 (while (and servers 3286 (not (equal server (format "%s:%s" (caar servers) 3287 (cadar servers))))) 3288 (pop servers)) 3289 (car servers)) 3290 ;; This could be some sort of foreign server that I 3291 ;; simply haven't opened (yet). Do a brute-force scan 3292 ;; of the entire gnus-newsrc-alist for the server name 3293 ;; of every method. As a side-effect, loads the 3294 ;; gnus-server-method-cache so this only happens once, 3295 ;; if at all. 3296 (let ((alist (cdr gnus-newsrc-alist)) 3297 method match) 3298 (while alist 3299 (setq method (gnus-info-method (pop alist))) 3300 (when (and (not (stringp method)) 3301 (equal server 3302 (gnus-method-to-server method nil t))) 3303 (setq match method 3304 alist nil))) 3305 match)))) 3306 (when (and result 3307 (not (assoc server gnus-server-method-cache))) 3308 (push (cons server result) gnus-server-method-cache)) 3309 result))) 3310 3311(defsubst gnus-server-get-method (group method) 3312 ;; Input either a server name, and extended server name, or a 3313 ;; select method, and return a select method. 3314 (cond ((stringp method) 3315 (gnus-server-to-method method)) 3316 ((equal method gnus-select-method) 3317 gnus-select-method) 3318 ((and group (stringp (car method))) 3319 (gnus-server-extend-method group method)) 3320 ((and method 3321 (not group) 3322 (equal (cadr method) "")) 3323 method) 3324 (t 3325 (gnus-server-add-address method)))) 3326 3327(defmacro gnus-method-equal (ss1 ss2) 3328 "Say whether two servers are equal." 3329 `(let ((s1 ,ss1) 3330 (s2 ,ss2)) 3331 (or (equal s1 s2) 3332 (and (= (length s1) (length s2)) 3333 (progn 3334 (while (and s1 (member (car s1) s2)) 3335 (setq s1 (cdr s1))) 3336 (null s1)))))) 3337 3338(defun gnus-methods-equal-p (m1 m2) 3339 (let ((m1 (or m1 gnus-select-method)) 3340 (m2 (or m2 gnus-select-method))) 3341 (or (equal m1 m2) 3342 (and (eq (car m1) (car m2)) 3343 (or (not (memq 'address (assoc (symbol-name (car m1)) 3344 gnus-valid-select-methods))) 3345 (equal (nth 1 m1) (nth 1 m2))))))) 3346 3347(defsubst gnus-sloppily-equal-method-parameters (m1 m2) 3348 ;; Check parameters for sloppy equality. 3349 (let ((p1 (copy-sequence (cddr m1))) 3350 (p2 (copy-sequence (cddr m2))) 3351 e1 e2) 3352 (cl-block nil 3353 (while (setq e1 (pop p1)) 3354 (unless (setq e2 (assq (car e1) p2)) 3355 ;; The parameter doesn't exist in p2. 3356 (cl-return nil)) 3357 (setq p2 (delq e2 p2)) 3358 (unless (equal e1 e2) 3359 (if (not (and (stringp (cadr e1)) 3360 (stringp (cadr e2)))) 3361 (cl-return nil) 3362 ;; Special-case string parameter comparison so that we 3363 ;; can uniquify them. 3364 (let ((s1 (cadr e1)) 3365 (s2 (cadr e2))) 3366 (when (string-match "/\\'" s1) 3367 (setq s1 (directory-file-name s1))) 3368 (when (string-match "/\\'" s2) 3369 (setq s2 (directory-file-name s2))) 3370 (unless (equal s1 s2) 3371 (cl-return nil)))))) 3372 ;; If p2 now is empty, they were equal. 3373 (null p2)))) 3374 3375(defun gnus-method-ephemeral-p (method) 3376 (let ((equal nil)) 3377 (dolist (ephemeral gnus-ephemeral-servers) 3378 (when (gnus-sloppily-equal-method-parameters method ephemeral) 3379 (setq equal t))) 3380 equal)) 3381 3382(defun gnus-methods-sloppily-equal (m1 m2) 3383 ;; Same method. 3384 (or 3385 (eq m1 m2) 3386 ;; Type and name are equal. 3387 (and 3388 (eq (car m1) (car m2)) 3389 (equal (cadr m1) (cadr m2)) 3390 (gnus-sloppily-equal-method-parameters m1 m2)))) 3391 3392(defun gnus-server-equal (m1 m2) 3393 "Say whether two methods are equal." 3394 (let ((m1 (cond ((null m1) gnus-select-method) 3395 ((stringp m1) (gnus-server-to-method m1)) 3396 (t m1))) 3397 (m2 (cond ((null m2) gnus-select-method) 3398 ((stringp m2) (gnus-server-to-method m2)) 3399 (t m2)))) 3400 (gnus-method-equal m1 m2))) 3401 3402(defun gnus-servers-using-backend (backend) 3403 "Return a list of known servers using BACKEND." 3404 (let ((opened gnus-opened-servers) 3405 out) 3406 (while opened 3407 (when (eq backend (caaar opened)) 3408 (push (caar opened) out)) 3409 (pop opened)) 3410 out)) 3411 3412(defun gnus-archive-server-wanted-p () 3413 "Say whether the user wants to use the archive server." 3414 (cond 3415 ((or (not gnus-message-archive-method) 3416 (not gnus-message-archive-group)) 3417 nil) 3418 ((and gnus-message-archive-method gnus-message-archive-group) 3419 t) 3420 (t 3421 (let ((active (cadr (assq 'nnfolder-active-file 3422 gnus-message-archive-method)))) 3423 (and active 3424 (file-exists-p active)))))) 3425 3426(defsubst gnus-method-to-server-name (method) 3427 (concat 3428 (format "%s" (car method)) 3429 (when (and 3430 (or (assoc (format "%s" (car method)) 3431 (gnus-methods-using 'address)) 3432 (gnus-server-equal method gnus-message-archive-method)) 3433 (nth 1 method) 3434 (not (string= (nth 1 method) ""))) 3435 (concat "+" (nth 1 method))))) 3436 3437(defsubst gnus-method-to-full-server-name (method) 3438 (format "%s+%s" (car method) (nth 1 method))) 3439 3440(defun gnus-group-prefixed-name (group method &optional full) 3441 "Return the whole name from GROUP and METHOD. 3442Call with full set to get the fully qualified group name (even if the 3443server is native)." 3444 (when (stringp method) 3445 (setq method (gnus-server-to-method method))) 3446 (if (or (not method) 3447 (and (not full) (gnus-server-equal method "native")) 3448 ;;;!!! This might not be right. We'll see... 3449 ;(string-match ":" group) 3450 ) 3451 group 3452 (concat (gnus-method-to-server-name method) ":" group))) 3453 3454(defun gnus-group-full-name (group method) 3455 "Return the full name from GROUP and METHOD, even if the method is native." 3456 (gnus-group-prefixed-name group method t)) 3457 3458(defun gnus-group-guess-full-name-from-command-method (group) 3459 "Guess the full name from GROUP, even if the method is native." 3460 (if (gnus-group-prefixed-p group) 3461 group 3462 (gnus-group-full-name group gnus-command-method))) 3463 3464(defun gnus-group-real-prefix (group) 3465 "Return the prefix of the current group name." 3466 (if (stringp group) 3467 (if (string-match "^[^:]+:" group) 3468 (substring group 0 (match-end 0)) 3469 "") 3470 nil)) 3471 3472(defun gnus-group-short-name (group) 3473 "Return the short group name." 3474 (let ((prefix (gnus-group-real-prefix group))) 3475 (if (< 0 (length prefix)) 3476 (substring group (length prefix) nil) 3477 group))) 3478 3479(defun gnus-group-prefixed-p (group) 3480 "Return the prefix of the current group name." 3481 (< 0 (length (gnus-group-real-prefix group)))) 3482 3483(defun gnus-summary-buffer-name (group) 3484 "Return the summary buffer name of GROUP." 3485 (concat "*Summary " group "*")) 3486 3487(defun gnus-group-method (group) 3488 "Return the server or method used for selecting GROUP. 3489You should probably use `gnus-find-method-for-group' instead." 3490 (let ((prefix (gnus-group-real-prefix group))) 3491 (if (equal prefix "") 3492 gnus-select-method 3493 (let ((servers gnus-opened-servers) 3494 (server "") 3495 backend possible found) 3496 (if (string-match "^[^\\+]+\\+" prefix) 3497 (setq backend (intern (substring prefix 0 (1- (match-end 0)))) 3498 server (substring prefix (match-end 0) (1- (length prefix)))) 3499 (setq backend (intern (substring prefix 0 (1- (length prefix)))))) 3500 (while servers 3501 (when (eq (caaar servers) backend) 3502 (setq possible (caar servers)) 3503 (when (equal (cadaar servers) server) 3504 (setq found (caar servers)))) 3505 (pop servers)) 3506 (or (car (rassoc found gnus-server-alist)) 3507 found 3508 (car (rassoc possible gnus-server-alist)) 3509 possible 3510 (list backend server)))))) 3511 3512(defsubst gnus-native-method-p (method) 3513 "Return whether METHOD is the native select method." 3514 (gnus-method-equal method gnus-select-method)) 3515 3516(defsubst gnus-secondary-method-p (method) 3517 "Return whether METHOD is a secondary select method." 3518 (let ((methods gnus-secondary-select-methods) 3519 (gmethod (inline (gnus-server-get-method nil method)))) 3520 (while (and methods 3521 (not (gnus-method-equal 3522 (inline (gnus-server-get-method nil (car methods))) 3523 gmethod))) 3524 (setq methods (cdr methods))) 3525 methods)) 3526 3527(defun gnus-method-simplify (method) 3528 "Return the shortest uniquely identifying string or method for METHOD." 3529 (cond ((stringp method) 3530 method) 3531 ((gnus-native-method-p method) 3532 nil) 3533 ((gnus-secondary-method-p method) 3534 (format "%s:%s" (nth 0 method) (nth 1 method))) 3535 (t 3536 method))) 3537 3538(defun gnus-groups-from-server (server) 3539 "Return a list of all groups that are fetched from SERVER." 3540 (let ((alist (cdr gnus-newsrc-alist)) 3541 info groups) 3542 (while (setq info (pop alist)) 3543 (when (gnus-server-equal (gnus-info-method info) server) 3544 (push (gnus-info-group info) groups))) 3545 (sort groups #'string<))) 3546 3547(defun gnus-group-foreign-p (group) 3548 "Say whether a group is foreign or not." 3549 (and (not (gnus-group-native-p group)) 3550 (not (gnus-group-secondary-p group)))) 3551 3552(defun gnus-group-native-p (group) 3553 "Say whether the group is native or not." 3554 (not (string-search ":" group))) 3555 3556(defun gnus-group-secondary-p (group) 3557 "Say whether the group is secondary or not." 3558 (gnus-secondary-method-p (gnus-find-method-for-group group))) 3559 3560(defun gnus-parameters-get-parameter (group) 3561 "Return the group parameters for GROUP from `gnus-parameters'." 3562 (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default) 3563 case-fold-search 3564 gnus-parameters-case-fold-search)) 3565 params-list) 3566 (dolist (elem gnus-parameters) 3567 (when (string-match (car elem) group) 3568 (setq params-list 3569 (nconc (gnus-expand-group-parameters 3570 (car elem) (cdr elem) group) 3571 params-list)))) 3572 params-list)) 3573 3574(defun gnus-expand-group-parameter (match value group) 3575 "Use MATCH to expand VALUE in GROUP." 3576 (let ((start (string-match match group))) 3577 (if start 3578 (let ((matched-string (substring group start (match-end 0)))) 3579 ;; Build match groups 3580 (string-match match matched-string) 3581 (replace-match value nil nil matched-string)) 3582 group))) 3583 3584(defun gnus-expand-group-parameters (match parameters group) 3585 "Go through PARAMETERS and expand them according to the match data." 3586 (let (new) 3587 (dolist (elem parameters) 3588 (cond 3589 ((and (stringp (cdr elem)) 3590 (string-match "\\\\[0-9&]" (cdr elem))) 3591 (push (cons (car elem) 3592 (gnus-expand-group-parameter match (cdr elem) group)) 3593 new)) 3594 ;; For `sieve' group parameters, perform substitutions for every 3595 ;; string within the match rule. This allows for parameters such 3596 ;; as: 3597 ;; ("list\\.\\(.*\\)" 3598 ;; (sieve header :is "list-id" "<\\1.domain.org>")) 3599 ((eq 'sieve (car elem)) 3600 (push (mapcar (lambda (sieve-elem) 3601 (if (and (stringp sieve-elem) 3602 (string-match "\\\\[0-9&]" sieve-elem)) 3603 (gnus-expand-group-parameter match sieve-elem 3604 group) 3605 sieve-elem)) 3606 (cdr elem)) 3607 new)) 3608 (t 3609 (push elem new)))) 3610 new)) 3611 3612(defun gnus-group-fast-parameter (group symbol &optional allow-list) 3613 "For GROUP, return the value of SYMBOL. 3614 3615You should call this in the `gnus-group-buffer' buffer. 3616The function `gnus-group-find-parameter' will do that for you." 3617 ;; The speed trick: No cons'ing and quit early. 3618 (let* ((params (funcall gnus-group-get-parameter-function group)) 3619 ;; Start easy, check the "real" group parameters. 3620 (simple-results 3621 (gnus-group-parameter-value params symbol allow-list t))) 3622 (if simple-results 3623 ;; Found results; return them. 3624 (car simple-results) 3625 ;; We didn't find it there, try `gnus-parameters'. 3626 (let ((result nil) 3627 (head nil) 3628 (tail gnus-parameters)) 3629 ;; A good old-fashioned non-cl loop. 3630 (while tail 3631 (setq head (car tail) 3632 tail (cdr tail)) 3633 ;; The car is regexp matching for matching the group name. 3634 (when (string-match (car head) group) 3635 ;; The cdr is the parameters. 3636 (let ((this-result 3637 (gnus-group-parameter-value (cdr head) symbol allow-list t))) 3638 (when this-result 3639 (setq result (car this-result)) 3640 ;; Expand if necessary. 3641 (cond 3642 ((and (stringp result) (string-match "\\\\[0-9&]" result)) 3643 (setq result (gnus-expand-group-parameter 3644 (car head) result group))) 3645 ;; For `sieve' group parameters, perform substitutions 3646 ;; for every string within the match rule (see above). 3647 ((eq symbol 'sieve) 3648 (setq result 3649 (mapcar (lambda (elem) 3650 (if (stringp elem) 3651 (gnus-expand-group-parameter (car head) 3652 elem group) 3653 elem)) 3654 result)))))))) 3655 ;; Done. 3656 result)))) 3657 3658(defun gnus-group-find-parameter (group &optional symbol allow-list) 3659 "Return the group parameters for GROUP. 3660If SYMBOL, return the value of that symbol in the group parameters. 3661 3662If you call this function inside a loop, consider using the faster 3663`gnus-group-fast-parameter' instead." 3664 (with-current-buffer (or (gnus-buffer-live-p gnus-group-buffer) 3665 (current-buffer)) 3666 (if symbol 3667 (gnus-group-fast-parameter group symbol allow-list) 3668 (nconc 3669 (copy-sequence 3670 (funcall gnus-group-get-parameter-function group)) 3671 (gnus-parameters-get-parameter group))))) 3672 3673(defun gnus-group-get-parameter (group &optional symbol allow-list) 3674 "Return the group parameters for GROUP. 3675If SYMBOL, return the value of that symbol in the group 3676parameters. If ALLOW-LIST, also allow list as a result. Most 3677functions should use `gnus-group-find-parameter', which also 3678examines the topic parameters. GROUP can also be an info structure." 3679 (let ((params (gnus-info-params (if (listp group) group 3680 (gnus-get-info group))))) 3681 (if symbol 3682 (gnus-group-parameter-value params symbol allow-list) 3683 params))) 3684 3685(defun gnus-group-parameter-value (params symbol &optional 3686 allow-list present-p) 3687 "Return the value of SYMBOL in group PARAMS. 3688If ALLOW-LIST, also allow list as a result." 3689 ;; We only wish to return group parameters (dotted lists) and 3690 ;; not local variables, which may have the same names. 3691 ;; But first we handle single elements... 3692 (or (car (memq symbol params)) 3693 ;; Handle alist. 3694 (let (elem) 3695 (catch 'found 3696 (while (setq elem (pop params)) 3697 (when (and (consp elem) 3698 (eq (car elem) symbol) 3699 (or allow-list 3700 (atom (cdr elem)))) 3701 (throw 'found (if present-p (list (cdr elem)) 3702 (cdr elem))))))))) 3703 3704(defun gnus-group-add-parameter (group param) 3705 "Add parameter PARAM to GROUP." 3706 (let ((info (gnus-get-info group))) 3707 (when info 3708 (gnus-group-remove-parameter group (if (consp param) (car param) param)) 3709 ;; Cons the new param to the old one and update. 3710 (gnus-group-set-info (cons param (gnus-info-params info)) 3711 group 'params)))) 3712 3713(defun gnus-group-set-parameter (group name value) 3714 "Set parameter NAME to VALUE in GROUP. 3715GROUP can also be an INFO structure." 3716 (let ((info (if (listp group) 3717 group 3718 (gnus-get-info group)))) 3719 (when info 3720 (gnus-group-remove-parameter group name) 3721 (let ((old-params (gnus-info-params info)) 3722 (new-params (list (cons name value)))) 3723 (while old-params 3724 (when (or (not (listp (car old-params))) 3725 (not (eq (caar old-params) name))) 3726 (setq new-params (append new-params (list (car old-params))))) 3727 (setq old-params (cdr old-params))) 3728 (if (listp group) 3729 (gnus-info-set-params info new-params t) 3730 (gnus-group-set-info new-params (gnus-info-group info) 'params)))))) 3731 3732(defun gnus-group-remove-parameter (group name) 3733 "Remove parameter NAME from GROUP. 3734GROUP can also be an INFO structure." 3735 (let ((info (if (listp group) 3736 group 3737 (gnus-get-info group)))) 3738 (when info 3739 (let ((params (gnus-info-params info))) 3740 (when params 3741 (setq params (delq name params)) 3742 (while (assq name params) 3743 (gnus-alist-pull name params)) 3744 (setf (gnus-info-params info) params)))))) 3745 3746(defun gnus-group-add-score (group &optional score) 3747 "Add SCORE to the GROUP score. 3748If SCORE is nil, add 1 to the score of GROUP." 3749 (let ((info (gnus-get-info group))) 3750 (when info 3751 (setf (gnus-info-score info) (+ (gnus-info-score info) (or score 1)))))) 3752 3753(defun gnus-short-group-name (group &optional levels) 3754 "Collapse GROUP name LEVELS. 3755Select methods are stripped and any remote host name is stripped down to 3756just the host name." 3757 (let* ((foreign "") 3758 (depth 0) 3759 (skip 1) 3760 (levels (or levels 3761 gnus-group-uncollapsed-levels 3762 (progn 3763 (while (string-match "\\." group skip) 3764 (setq skip (match-end 0) 3765 depth (+ depth 1))) 3766 depth)))) 3767 ;; Separate foreign select method from group name and collapse. 3768 ;; If method contains a server, collapse to non-domain server name, 3769 ;; otherwise collapse to select method. 3770 (let* ((colon (string-search ":" group)) 3771 (server (and colon (substring group 0 colon))) 3772 (plus (and server (string-search "+" server)))) 3773 (when server 3774 (if plus 3775 (setq foreign (substring server (+ 1 plus) 3776 (string-search "." server)) 3777 group (substring group (+ 1 colon))) 3778 (setq foreign server 3779 group (substring group (+ 1 colon)))) 3780 (setq foreign (concat foreign ":"))) 3781 ;; Remove braces from name (common in IMAP groups). 3782 (setq group (replace-regexp-in-string "[][]+" "" group)) 3783 ;; Collapse group name leaving LEVELS uncollapsed elements 3784 (let* ((slist (split-string group "/")) 3785 (slen (length slist)) 3786 (dlist (split-string group "\\.")) 3787 (dlen (length dlist)) 3788 glist 3789 glen 3790 gsep 3791 res) 3792 (if (> slen dlen) 3793 (setq glist slist 3794 glen slen 3795 gsep "/") 3796 (setq glist dlist 3797 glen dlen 3798 gsep ".")) 3799 (setq levels (- glen levels)) 3800 (dolist (g glist) 3801 (push (if (>= (cl-decf levels) 0) 3802 (if (zerop (length g)) 3803 "" 3804 (substring g 0 1)) 3805 g) 3806 res)) 3807 (concat foreign (mapconcat #'identity (nreverse res) gsep)))))) 3808 3809(defun gnus-narrow-to-body () 3810 "Narrow to the body of an article." 3811 (narrow-to-region 3812 (progn 3813 (goto-char (point-min)) 3814 (or (search-forward "\n\n" nil t) 3815 (point-max))) 3816 (point-max))) 3817 3818 3819;;; 3820;;; Kill file handling. 3821;;; 3822 3823(defun gnus-apply-kill-file () 3824 "Apply a kill file to the current newsgroup. 3825Returns the number of articles marked as read." 3826 (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) 3827 (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) 3828 (gnus-apply-kill-file-internal) 3829 0)) 3830 3831(defun gnus-kill-save-kill-buffer () 3832 (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) 3833 (when (get-file-buffer file) 3834 (with-current-buffer (get-file-buffer file) 3835 (when (buffer-modified-p) 3836 (save-buffer)) 3837 (kill-buffer (current-buffer)))))) 3838 3839(defcustom gnus-kill-file-name "KILL" 3840 "Suffix of the kill files." 3841 :group 'gnus-score-kill 3842 :group 'gnus-score-files 3843 :type 'string) 3844 3845(defun gnus-newsgroup-kill-file (newsgroup) 3846 "Return the name of a kill file name for NEWSGROUP. 3847If NEWSGROUP is nil, return the global kill file name instead." 3848 (cond 3849 ;; The global KILL file is placed at top of the directory. 3850 ((or (null newsgroup) 3851 (string-equal newsgroup "")) 3852 (expand-file-name gnus-kill-file-name 3853 gnus-kill-files-directory)) 3854 ;; Append ".KILL" to newsgroup name. 3855 ((gnus-use-long-file-name 'not-kill) 3856 (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) 3857 "." gnus-kill-file-name) 3858 gnus-kill-files-directory)) 3859 ;; Place "KILL" under the hierarchical directory. 3860 (t 3861 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) 3862 "/" gnus-kill-file-name) 3863 gnus-kill-files-directory)))) 3864 3865;;; Server things. 3866 3867(defun gnus-member-of-valid (symbol group) 3868 "Find out if GROUP has SYMBOL as part of its \"valid\" spec." 3869 (memq symbol (assoc 3870 (symbol-name (car (gnus-find-method-for-group group))) 3871 gnus-valid-select-methods))) 3872 3873(defun gnus-method-option-p (method option) 3874 "Return non-nil if select METHOD has OPTION as a parameter." 3875 (when (stringp method) 3876 (setq method (gnus-server-to-method method))) 3877 (memq option (assoc (format "%s" (car method)) 3878 gnus-valid-select-methods))) 3879 3880(defun gnus-similar-server-opened (method) 3881 "Return non-nil if we have a similar server opened. 3882This is defined as a server with the same name, but different 3883parameters." 3884 (let ((opened gnus-opened-servers) 3885 open) 3886 (while (and method opened) 3887 (setq open (car (pop opened))) 3888 ;; Type and name are the same... 3889 (when (and (equal (car method) (car open)) 3890 (equal (cadr method) (cadr open)) 3891 ;; ... but the rest of the parameters differ. 3892 (not (gnus-methods-sloppily-equal method open))) 3893 (setq method nil))) 3894 (not method))) 3895 3896(defun gnus-server-extend-method (group method) 3897 ;; This function "extends" a virtual server. If the server is 3898 ;; "hello", and the select method is ("hello" (my-var "something")) 3899 ;; in the group "alt.alt", this will result in a new virtual server 3900 ;; called "hello+alt.alt". 3901 (if (or (not (inline (gnus-similar-server-opened method))) 3902 (not (cddr method))) 3903 method 3904 (let ((address-slot 3905 (intern (format "%s-address" (car method))))) 3906 (setq method 3907 (if (assq address-slot (cddr method)) 3908 `(,(car method) ,(concat (cadr method) "+" group) 3909 ,@(cddr method)) 3910 `(,(car method) ,(concat (cadr method) "+" group) 3911 (,address-slot ,(cadr method)) 3912 ,@(cddr method)))) 3913 (push method gnus-extended-servers) 3914 method))) 3915 3916(defun gnus-server-status (method) 3917 "Return the status of METHOD." 3918 (nth 1 (assoc method gnus-opened-servers))) 3919 3920(defun gnus-group-name-to-method (group) 3921 "Guess a select method based on GROUP." 3922 (if (string-match ":" group) 3923 (let ((server (substring group 0 (match-beginning 0)))) 3924 (if (string-match "\\+" server) 3925 (list (intern (substring server 0 (match-beginning 0))) 3926 (substring server (match-end 0))) 3927 (list (intern server) ""))) 3928 gnus-select-method)) 3929 3930(defun gnus-server-string (server) 3931 "Return a readable string that describes SERVER." 3932 (let* ((server (gnus-server-to-method server)) 3933 (address (nth 1 server))) 3934 (if (and address 3935 (not (zerop (length address)))) 3936 (format "%s using %s" address (car server)) 3937 (format "%s" (car server))))) 3938 3939(defun gnus-same-method-different-name (method) 3940 (let ((slot (intern (concat (symbol-name (car method)) "-address")))) 3941 (unless (assq slot (cddr method)) 3942 (setq method 3943 (append method (list (list slot (nth 1 method))))))) 3944 (let ((methods gnus-extended-servers) 3945 open found) 3946 (while (and (not found) 3947 (setq open (pop methods))) 3948 (when (and (eq (car method) (car open)) 3949 (gnus-sloppily-equal-method-parameters method open)) 3950 (setq found open))) 3951 found)) 3952 3953(defun gnus-find-method-for-group (group &optional info) 3954 "Find the select method that GROUP uses." 3955 (or gnus-override-method 3956 (and (not group) 3957 gnus-select-method) 3958 (and (not (gnus-group-entry group)) 3959 ;; Killed or otherwise unknown group. 3960 (or 3961 ;; If we know a virtual server by that name, return its method. 3962 (gnus-server-to-method (gnus-group-server group)) 3963 ;; Guess a new method as last resort. 3964 (gnus-group-name-to-method group))) 3965 (let ((info (or info (gnus-get-info group))) 3966 method) 3967 (if (or (not info) 3968 (not (setq method (gnus-info-method info))) 3969 (equal method "native")) 3970 gnus-select-method 3971 (setq method 3972 (cond ((stringp method) 3973 (inline (gnus-server-to-method method))) 3974 ((stringp (cadr method)) 3975 (or 3976 (inline 3977 (gnus-same-method-different-name method)) 3978 (inline (gnus-server-extend-method group method)))) 3979 (t 3980 method))) 3981 (cond ((equal (cadr method) "") 3982 method) 3983 ((null (cadr method)) 3984 (list (car method) "")) 3985 (t 3986 (gnus-server-add-address method))))))) 3987 3988(defun gnus-methods-using (feature) 3989 "Find all methods that have FEATURE." 3990 (let ((valids gnus-valid-select-methods) 3991 outs) 3992 (while valids 3993 (when (memq feature (car valids)) 3994 (push (car valids) outs)) 3995 (setq valids (cdr valids))) 3996 outs)) 3997 3998(autoload 'message-y-or-n-p "message" nil nil 'macro) 3999 4000(defun gnus-read-group (prompt &optional default) 4001 "Prompt the user for a group name. 4002Disallow invalid group names." 4003 (let ((prefix "") 4004 group) 4005 (while (not group) 4006 (when (string-match 4007 gnus-invalid-group-regexp 4008 (setq group (read-string (concat prefix prompt) 4009 (cons (or default "") 0) 4010 'gnus-group-history))) 4011 (let ((match (match-string 0 group))) 4012 ;; Might be okay (e.g. for nnimap), so ask the user: 4013 (unless (and (not (string-match "^$\\|:" match)) 4014 (message-y-or-n-p 4015 "Proceed and create group anyway? " t 4016"The group name \"" group "\" contains a forbidden character: \"" match "\". 4017 4018Usually, it's dangerous to create a group with this name, because it's not 4019supported by all back ends and servers. On IMAP servers it should work, 4020though. If you are really sure, you can proceed anyway and create the group. 4021 4022You may customize the variable `gnus-invalid-group-regexp', which currently is 4023set to \"" gnus-invalid-group-regexp 4024"\", if you want to get rid of this query permanently.")) 4025 (setq prefix (format "Invalid group name: \"%s\". " group) 4026 group nil))))) 4027 group)) 4028 4029(defun gnus-read-method (prompt) 4030 "Prompt the user for a method. 4031Allow completion over sensible values." 4032 (let* ((open-servers 4033 (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i)) 4034 gnus-opened-servers)) 4035 (valid-methods 4036 (let (methods) 4037 (dolist (method gnus-valid-select-methods) 4038 (if (or (memq 'prompt-address method) 4039 (not (assoc (format "%s:" (car method)) open-servers))) 4040 (push method methods))) 4041 methods)) 4042 (servers 4043 (append valid-methods 4044 open-servers 4045 gnus-predefined-server-alist 4046 gnus-server-alist)) 4047 (method 4048 (gnus-completing-read 4049 prompt (mapcar #'car servers) 4050 t nil 'gnus-method-history))) 4051 (cond 4052 ((equal method "") 4053 (setq method gnus-select-method)) 4054 ((assoc method gnus-valid-select-methods) 4055 (let ((address (if (memq 'prompt-address 4056 (assoc method gnus-valid-select-methods)) 4057 (read-string "Address: ") 4058 ""))) 4059 (or (cadr (assoc (format "%s:%s" method address) open-servers)) 4060 (list (intern method) address)))) 4061 ((assoc method servers) 4062 method) 4063 (t 4064 (list (intern method) ""))))) 4065 4066;;; Agent functions 4067 4068(defun gnus-agent-method-p (method-or-server) 4069 "Say whether METHOD is covered by the agent." 4070 (or (eq (car gnus-agent-method-p-cache) method-or-server) 4071 (let* ((method (if (stringp method-or-server) 4072 (gnus-server-to-method method-or-server) 4073 method-or-server)) 4074 (server (gnus-method-to-server method t))) 4075 (setq gnus-agent-method-p-cache 4076 (cons method-or-server 4077 (member server gnus-agent-covered-methods))))) 4078 (cdr gnus-agent-method-p-cache)) 4079 4080(defun gnus-online (method) 4081 (not 4082 (if gnus-plugged 4083 (eq (cadr (assoc method gnus-opened-servers)) 'offline) 4084 (gnus-agent-method-p method)))) 4085 4086;;; User-level commands. 4087 4088;;;###autoload 4089(defun gnus-child-no-server (&optional arg) 4090 "Read network news as a child, without connecting to the local server." 4091 (interactive "P") 4092 (gnus-no-server arg t)) 4093 4094;;;###autoload 4095(defun gnus-slave-no-server (&optional arg) 4096 "Read network news as a child, without connecting to the local server." 4097 (interactive "P") 4098 (gnus-no-server arg t)) 4099(make-obsolete 'gnus-slave-no-server 'gnus-child-no-server "28.1") 4100 4101;;;###autoload 4102(defun gnus-no-server (&optional arg child) 4103 "Read network news. 4104If ARG is a positive number, Gnus will use that as the startup level. 4105If ARG is nil, Gnus will be started at level 2. If ARG is non-nil 4106and not a positive number, Gnus will prompt the user for the name of 4107an NNTP server to use. 4108As opposed to `gnus', this command will not connect to the local 4109server." 4110 (interactive "P") 4111 (gnus-no-server-1 arg child)) 4112 4113;;;###autoload 4114(defun gnus-child (&optional arg) 4115 "Read news as a child." 4116 (interactive "P") 4117 (gnus arg nil 'child)) 4118 4119;;;###autoload 4120(defun gnus-slave (&optional arg) 4121 "Read news as a child." 4122 (interactive "P") 4123 (gnus arg nil 'child)) 4124(make-obsolete 'gnus-slave 'gnus-child "28.1") 4125 4126(defun gnus-delete-gnus-frame () 4127 "Delete gnus frame unless it is the only one. 4128Used for `gnus-exit-gnus-hook' in `gnus-other-frame'." 4129 (when (and (frame-live-p gnus-other-frame-object) 4130 (cdr (frame-list))) 4131 (delete-frame gnus-other-frame-object)) 4132 (setq gnus-other-frame-object nil)) 4133 4134;;;###autoload 4135(defun gnus-other-frame (&optional arg display) 4136 "Pop up a frame to read news. 4137This will call one of the Gnus commands which is specified by the user 4138option `gnus-other-frame-function' (default `gnus') with the argument 4139ARG if Gnus is not running, otherwise pop up a Gnus frame and run the 4140command specified by `gnus-other-frame-resume-function'. 4141The optional second argument DISPLAY should be a standard display string 4142such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is 4143omitted or the function `make-frame-on-display' is not available, the 4144current display is used." 4145 (interactive "P") 4146 (if (fboundp 'make-frame-on-display) 4147 (unless display 4148 (setq display (gnus-frame-or-window-display-name (selected-frame)))) 4149 (setq display nil)) 4150 (let ((alive (gnus-alive-p))) 4151 (unless (and alive 4152 (catch 'found 4153 (walk-windows 4154 (lambda (window) 4155 (when (and (or (not display) 4156 (equal display 4157 (gnus-frame-or-window-display-name 4158 window))) 4159 (with-current-buffer (window-buffer window) 4160 (string-match "\\`gnus-" 4161 (symbol-name major-mode)))) 4162 (select-frame-set-input-focus 4163 (setq gnus-other-frame-object (window-frame window))) 4164 (select-window window) 4165 (throw 'found t))) 4166 'ignore t))) 4167 (select-frame-set-input-focus 4168 (setq gnus-other-frame-object 4169 (if display 4170 (make-frame-on-display display gnus-other-frame-parameters) 4171 (make-frame gnus-other-frame-parameters)))) 4172 (if alive 4173 (progn (switch-to-buffer gnus-group-buffer) 4174 (funcall gnus-other-frame-resume-function arg)) 4175 (funcall gnus-other-frame-function arg) 4176 (add-hook 'gnus-exit-gnus-hook #'gnus-delete-gnus-frame) 4177 ;; One might argue that `gnus-delete-gnus-frame' should not be called 4178 ;; from `gnus-suspend-gnus-hook', but, on the other hand, one might 4179 ;; argue that it should. No matter what you think, for the sake of 4180 ;; those who want it to be called from it, please keep (defun 4181 ;; gnus-delete-gnus-frame) even if you remove the next `add-hook'. 4182 (add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame))))) 4183 4184;;;###autoload 4185(defun gnus (&optional arg dont-connect child) 4186 "Read network news. 4187If ARG is non-nil and a positive number, Gnus will use that as the 4188startup level. If ARG is non-nil and not a positive number, Gnus will 4189prompt the user for the name of an NNTP server to use." 4190 (interactive "P") 4191 ;; When using the development version of Gnus, load the gnus-load 4192 ;; file. 4193 (unless (string-match "^Gnus" gnus-version) 4194 (load "gnus-load" nil t)) 4195 (unless (or (byte-code-function-p (symbol-function 'gnus)) 4196 (subr-native-elisp-p (symbol-function 'gnus))) 4197 (message "You should compile Gnus") 4198 (sit-for 2)) 4199 (let ((gnus-action-message-log (list nil))) 4200 (gnus-1 arg dont-connect child) 4201 (gnus-final-warning))) 4202 4203(declare-function debbugs-gnu "ext:debbugs-gnu" 4204 (severities &optional packages archivedp suppress tags)) 4205 4206(defun gnus-list-debbugs () 4207 "List all open Gnus bug reports." 4208 (interactive) 4209 (require 'debbugs-gnu) 4210 (debbugs-gnu nil "gnus")) 4211 4212(provide 'gnus) 4213 4214;;; gnus.el ends here 4215
