cgit.sxemacs.org Git - gnus/blob - lisp/gnus-vis.el

   1 ;;; gnus-visual: display-oriented parts of Gnus.
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'gnus)
  28 (require (if gnus-xemacs 'auc-menu 'easymenu))
  29
  30 (defvar gnus-summary-selected-face 'underline
  31   "*Face used for highlighting the current article in the summary buffer.")
  32
  33 (defvar gnus-visual-summary-highlight
  34   '(((> score default) . bold)
  35     ((< score default) . italic))
  36   "*Alist of `(FORM . FACE)'.
  37 Summary lines are highlighted with the FACE for the first FORM which
  38 evaluate to a non-nil value.
  39
  40 Point will be at the beginning of the line when FORM is evaluated.
  41 The following can be used for convenience:
  42
  43 score:   (gnus-summary-article-score)
  44 default: gnus-summary-default-score
  45 below:   gnus-summary-mark-below
  46
  47 To check for marks, e.g. to underline replied articles, use
  48 `gnus-summary-article-mark':
  49
  50    ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)")
  51
  52 (eval-and-compile
  53   (autoload 'nnkiboze-generate-groups "nnkiboze"))
  54
  55 ;; Newsgroup buffer
  56
  57 ;; Make a menu bar item.
  58 (defun gnus-group-make-menu-bar ()
  59   (easy-menu-define
  60    gnus-group-reading-menu
  61    gnus-group-mode-map
  62    ""
  63    '("Group"
  64      ["Read" gnus-group-read-group t]
  65      ["Select" gnus-group-select-group t]
  66      ["Catch up" gnus-group-catchup-current t]
  67      ["Catch up all articles" gnus-group-catchup-current-all t]
  68      ["Check for new articles" gnus-group-get-new-news-this-group t]
  69      ["Toggle subscription" gnus-group-unsubscribe-current-group t]
  70      ["Kill" gnus-group-kill-group t]
  71      ["Yank" gnus-group-yank-group t]
  72      ["Describe" gnus-group-describe-group t]
  73      ["Fetch FAQ" gnus-group-fetch-faq t]
  74      ["Edit kill file" gnus-group-edit-local-kill t]
  75      ["Expire articles" gnus-group-expire-articles t]
  76      ["Set group level" gnus-group-set-current-level t]
  77      ))
  78
  79   (easy-menu-define
  80    gnus-group-group-menu
  81    gnus-group-mode-map
  82    ""
  83    '("Groups"
  84      ("Listing"
  85       ["List subscribed groups" gnus-group-list-groups t]
  86       ["List all groups" gnus-group-list-all-groups t]
  87       ["List groups matching..." gnus-group-list-matching t]
  88       ["List killed groups" gnus-group-list-killed t]
  89       ["List zombie groups" gnus-group-list-zombies t]
  90       ["Describe all groups" gnus-group-describe-all-groups t]
  91       ["Group apropos" gnus-group-apropos t]
  92       ["Group and description apropos" gnus-group-description-apropos t]
  93       ["List groups matching..." gnus-group-list-matching t])
  94      ("Subscribe"
  95       ["Subscribe to random group" gnus-group-unsubscribe-group t]
  96       ["Kill all newsgroups in region" gnus-group-kill-region t]
  97       ["Kill all zombie groups" gnus-group-kill-all-zombies t])
  98      ("Foreign groups"
  99       ["Make a foreign group" gnus-group-make-group t]
 100       ["Edit a group entry" gnus-group-edit-group t]
 101       ["Add a directory group" gnus-group-make-directory-group t]
 102       ["Add the help group" gnus-group-make-help-group t]
 103       ["Add the archive group" gnus-group-make-archive-group t]
 104       ["Make a kiboze group" gnus-group-make-kiboze-group t])
 105      ["Jump to group" gnus-group-jump-to-group t]
 106      ["Best unread group" gnus-group-best-unread-group t]
 107      ))
 108
 109   (easy-menu-define
 110    gnus-group-post-menu
 111    gnus-group-mode-map
 112    ""
 113    '("Post"
 114      ["Send a mail" gnus-group-mail t]
 115      ["Post an article" gnus-group-post-news t]
 116      ))
 117
 118   (easy-menu-define
 119    gnus-group-misc-menu
 120    gnus-group-mode-map
 121    ""
 122    '("Misc"
 123      ["Check for new news" gnus-group-get-new-news t]
 124      ["Delete bogus groups" gnus-group-check-bogus-groups t]
 125      ["Find new newsgroups" gnus-find-new-newsgroups t]
 126      ["Restart Gnus" gnus-group-restart t]
 127      ["Read init file" gnus-group-read-init-file t]
 128      ["Browse foreign server" gnus-group-browse-foreign-server t]
 129      ["Edit the global kill file" gnus-group-edit-global-kill t]
 130      ["Expire all expirable articles" gnus-group-expire-all-groups t]
 131      ["Generate any kiboze groups" nnkiboze-generate-groups t]
 132      ["Gnus version" gnus-version t]
 133      ["Save .newsrc files" gnus-group-save-newsrc t]
 134      ["Suspend Gnus" gnus-group-suspend t]
 135      ["Clear dribble buffer" gnus-group-clear-dribble t]
 136      ["Exit from Gnus" gnus-group-exit t]
 137      ["Exit without saving" gnus-group-quit t]
 138      ["Sort group buffer" gnus-group-sort-groups t]
 139      ["Edit global KILL file" gnus-group-edit-global-kill t]
 140      ))
 141
 142   )
 143
 144 ;; Summary buffer
 145 (defun gnus-summary-make-menu-bar ()
 146
 147   (easy-menu-define
 148    gnus-summary-mark-menu
 149    gnus-summary-mode-map
 150    ""
 151    '("Mark"
 152      ("Read"
 153       ["Mark as read" gnus-summary-mark-as-read-forward t]
 154       ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t]
 155       ["Mark same subject" gnus-summary-kill-same-subject t]
 156       ["Catchup" gnus-summary-catchup t]
 157       ["Catchup all" gnus-summary-catchup-all t]
 158       ["Catchup to here" gnus-summary-catchup-to-here t]
 159       ["Catchup region" gnus-summary-mark-region-as-read t])
 160      ("Various"
 161       ["Tick" gnus-summary-tick-article-forward t]
 162       ["Mark as dormant" gnus-summary-mark-as-dormant t]
 163       ["Remove marks" gnus-summary-clear-mark-forward t]
 164       ["Set expirable mark" gnus-summary-mark-as-expirable t]
 165       ["Set bookmark" gnus-summary-set-bookmark t]
 166       ["Remove bookmark" gnus-summary-remove-bookmark t])
 167      ("Score"
 168       ["Raise score" gnus-summary-raise-score t]
 169       ["Lower score" gnus-summary-lower-score t]
 170       ["Set score" gnus-summary-set-score t])
 171      ("Display"
 172       ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t]
 173       ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t]
 174       ["Show dormant articles" gnus-summary-show-all-dormant t]
 175       ["Hide dormant articles" gnus-summary-hide-all-dormant t]
 176       ["Show expunged articles" gnus-summary-show-all-expunged t])
 177      ("Process mark"
 178       ["Set mark" gnus-summary-mark-as-processable t]
 179       ["Remove mark" gnus-summary-unmark-as-processable t]
 180       ["Remove all marks" gnus-summary-unmark-all-processable t]
 181       ["Mark series" gnus-uu-mark-series t]
 182       ["Mark region" gnus-uu-mark-region t]
 183       ["Mark by regexp" gnus-uu-mark-by-regexp t]
 184       ["Mark all" gnus-uu-mark-all t]
 185       ["Mark sparse" gnus-uu-mark-sparse t]
 186       ["Mark thread" gnus-uu-mark-thread t]
 187       )
 188      ))
 189
 190   (easy-menu-define
 191    gnus-summary-move-menu
 192    gnus-summary-mode-map
 193    ""
 194    '("Move"
 195      ["Scroll article forwards" gnus-summary-next-page t]
 196      ["Next unread article" gnus-summary-next-unread-article t]
 197      ["Previous unread article" gnus-summary-prev-unread-article t]
 198      ["Next article" gnus-summary-next-article t]
 199      ["Previous article" gnus-summary-prev-article t]
 200      ["Next article same subject" gnus-summary-next-same-subject t]
 201      ["Previous article same subject" gnus-summary-prev-same-subject t]
 202      ["First unread article" gnus-summary-first-unread-article t]
 203      ["Go to subject number..." gnus-summary-goto-subject t]
 204      ["Go to the last article" gnus-summary-goto-last-article t]
 205      ["Pop article off history" gnus-summary-pop-article t]
 206      ))
 207
 208   (easy-menu-define
 209    gnus-summary-article-menu
 210    gnus-summary-mode-map
 211    ""
 212    '("Article"
 213      ("Hide"
 214       ("Date"
 215        ["Local" gnus-article-date-local t]
 216        ["UT" gnus-article-date-local t]
 217        ["Lapsed" gnus-article-date-local t])
 218       ["Headers" gnus-article-hide-headers t]
 219       ["Signature" gnus-article-hide-signature t]
 220       ["Citation" gnus-article-hide-citation t]
 221       ["Overstrike" gnus-article-treat-overstrike t]
 222       ["Word wrap" gnus-article-word-wrap t]
 223       ["CR" gnus-article-remove-cr t]
 224       ["Show X-Face" gnus-article-display-x-face t]
 225       ["Quoted-Printable" gnus-article-de-quoted-unreadable t])
 226      ("Extract"
 227       ["Uudecode" gnus-uu-decode-uu t]
 228       ["Uudecode and save" gnus-uu-decode-uu-and-save t]
 229       ["Unshar" gnus-uu-decode-unshar t]
 230       ["Unshar and save" gnus-uu-decode-unshar-and-save t]
 231       ["Save" gnus-uu-decode-save t]
 232       ["Binhex" gnus-uu-decode-binhex t])
 233      ["Enter digest buffer" gnus-summary-enter-digest-group t]
 234      ["Isearch article" gnus-summary-isearch-article t]
 235      ["Search all articles" gnus-summary-search-article-forward t]
 236      ["Beginning of the article" gnus-summary-beginning-of-article t]
 237      ["End of the article" gnus-summary-end-of-article t]
 238      ["Fetch parent of article" gnus-summary-refer-parent-article t]
 239      ["Fetch article with id..." gnus-summary-refer-article t]
 240      ["Stop page breaking" gnus-summary-stop-page-breaking t]
 241      ["Caesar rotate" gnus-summary-caesar-message t]
 242      ["Redisplay" gnus-summary-show-article t]
 243      ["Toggle header" gnus-summary-toggle-header t]
 244      ["Toggle MIME" gnus-summary-toggle-mime t]
 245      ["Save" gnus-summary-save-article t]
 246      ["Save in mail format" gnus-summary-save-article-mail t]
 247      ["Pipe through a filter" gnus-summary-pipe-output t]
 248      ("Mail articles"
 249       ["Respool article" gnus-summary-respool-article t]
 250       ["Move article" gnus-summary-move-article t]
 251       ["Edit article" gnus-summary-edit-article t]
 252       ["Delete article" gnus-summary-delete-article t])
 253      ))
 254
 255   (easy-menu-define
 256    gnus-summary-thread-menu
 257    gnus-summary-mode-map
 258    ""
 259    '("Threads"
 260      ["Toggle threading" gnus-summary-toggle-threads t]
 261      ["Display hidden thread" gnus-summary-show-thread t]
 262      ["Hide thread" gnus-summary-hide-thread t]
 263      ["Go to next thread" gnus-summary-next-thread t]
 264      ["Go to previous thread" gnus-summary-prev-thread t]
 265      ["Go down thread" gnus-summary-down-thread t]
 266      ["Go up thread" gnus-summary-up-thread t]
 267      ["Mark thread as read" gnus-summary-kill-thread t]
 268      ["Lower thread score" gnus-summary-lower-thread t]
 269      ["Raise thread score" gnus-summary-raise-thread t]
 270      ))
 271
 272   (easy-menu-define
 273    gnus-summary-misc-menu
 274    gnus-summary-mode-map
 275    ""
 276    '("Misc"
 277      ("Sort"
 278       ["Sort by number" gnus-summary-sort-by-number t]
 279       ["Sort by author" gnus-summary-sort-by-author t]
 280       ["Sort by subject" gnus-summary-sort-by-subject t]
 281       ["Sort by date" gnus-summary-sort-by-date t])
 282      ("Exit"
 283       ["Catchup and exit" gnus-summary-catchup-and-exit t]
 284       ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
 285       ["Exit group" gnus-summary-exit t]
 286       ["Exit group without updating" gnus-summary-quit t]
 287       ["Reselect group" gnus-summary-reselect-current-group t]
 288       ["Rescan group" gnus-summary-rescan-group t])
 289      ["Fetch group FAQ" gnus-summary-fetch-faq t]
 290      ["Filter articles" gnus-summary-execute-command t]
 291      ["Toggle line truncation" gnus-summary-toggle-truncation t]
 292      ["Expire expirable articles" gnus-summary-expire-articles t]
 293      ["Describe group" gnus-summary-describe-group t]
 294      ["Edit local kill file" gnus-summary-edit-local-kill t]
 295      ["Edit global kill file" gnus-summary-edit-global-kill t]
 296      ))
 297
 298   (easy-menu-define
 299    gnus-summary-post-menu
 300    gnus-summary-mode-map
 301    ""
 302    '("Post"
 303      ["Post an article" gnus-summary-post-news t]
 304      ["Followup" gnus-summary-followup t]
 305      ["Followup and yank" gnus-summary-followup-with-original t]
 306      ["Supersede article" gnus-summary-supersede-article t]
 307      ["Cancel article" gnus-summary-cancel-article t]
 308      ["Reply" gnus-summary-reply t]
 309      ["Reply and yank" gnus-summary-reply-with-original t]
 310      ["Mail forward" gnus-summary-mail-forward t]
 311      ["Post forward" gnus-summary-post-forward t]
 312      ["Digest and mail" gnus-uu-digest-mail-forward t]
 313      ["Digest and post" gnus-uu-digest-post-forward t]
 314      ["Send a mail" gnus-summary-mail-other-window t]
 315      ["Reply & followup" gnus-summary-followup-and-reply t]
 316      ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t]
 317      ["Uuencode and post" gnus-uu-post-news t]
 318      ))
 319
 320   (easy-menu-define
 321    gnus-summary-kill-menu
 322    gnus-summary-mode-map
 323    ""
 324    '("Score"
 325      ("Score file"
 326       ["Switch current score file" gnus-score-change-score-file t]
 327       ["Set mark below" gnus-score-set-mark-below t]
 328       ["Set expunge below" gnus-score-set-expunge-below t]
 329       ["Edit current score file" gnus-score-edit-alist t]
 330       ["Edit score file" gnus-score-edit-file t])
 331      ["Raise score with current subject"
 332       gnus-summary-temporarily-raise-by-subject t]
 333      ["Raise score with current author"
 334       gnus-summary-temporarily-raise-by-author t]
 335      ["Raise score with current thread"
 336       gnus-summary-temporarily-raise-by-thread t]
 337      ["Raise score with current crossposting"
 338       gnus-summary-temporarily-raise-by-xref t]
 339      ["Permanently raise score with current subject"
 340       gnus-summary-raise-by-subject t]
 341      ["Permanently raise score with current author"
 342       gnus-summary-raise-by-author t]
 343      ["Permanently raise score with current crossposting"
 344       gnus-summary-raise-by-xref t]
 345      ["Permanently raise score for followups to current author"
 346       gnus-summary-raise-followups-to-author t]
 347      ["Lower score with current subject"
 348       gnus-summary-temporarily-lower-by-subject t]
 349      ["Lower score with current author"
 350       gnus-summary-temporarily-lower-by-author t]
 351      ["Lower score with current thread"
 352       gnus-summary-temporarily-lower-by-thread t]
 353      ["Lower score with current crossposting"
 354       gnus-summary-temporarily-lower-by-xref t]
 355      ["Permanently lower score with current subject"
 356       gnus-summary-lower-by-subject t]
 357      ["Permanently lower score with current author"
 358       gnus-summary-lower-by-author t]
 359      ["Permanently lower score with current crossposting"
 360       gnus-summary-lower-by-xref t]
 361      ["Permanently lower score for followups to current author"
 362       gnus-summary-lower-followups-to-author t]
 363      ))
 364   )
 365
 366 ;; Article buffer
 367 (defun gnus-article-make-menu-bar ()
 368
 369  (easy-menu-define
 370    gnus-article-article-menu
 371    gnus-article-mode-map
 372    ""
 373    '("Article"
 374      ["Scroll forwards" gnus-article-next-page t]
 375      ["Scroll backwards" gnus-article-prev-page t]
 376      ["Show summary" gnus-article-show-summary t]
 377      ["Fetch Message-ID at point" gnus-article-refer-article t]
 378      ["Mail to address at point" gnus-article-mail t]
 379      ["Mail to address at point and include original"
 380       gnus-article-mail-with-original t]
 381      ))
 382
 383  (easy-menu-define
 384    gnus-article-treatment-menu
 385    gnus-article-mode-map
 386    ""
 387    '("Treatment"
 388      ["Hide headers" gnus-article-hide-headers t]
 389      ["Hide signature" gnus-article-hide-signature t]
 390      ["Hide citation" gnus-article-hide-citation t]
 391      ["Treat overstrike" gnus-article-treat-overstrike t]
 392      ["Remove carriage return" gnus-article-remove-cr t]
 393      ["Remove quoted-unreadble" gnus-article-de-quoted-unreadable t]
 394      ))
 395  )
 396
 397 (if gnus-xemacs
 398     (defun gnus-visual-highlight-selected-summary ()
 399       (if gnus-summary-selected-face
 400           (save-excursion
 401             (let* ((beg (progn (beginning-of-line) (point)))
 402                    (end (progn (end-of-line) (point)))
 403                    (from (or
 404                           (next-single-property-change beg 'mouse-face nil end)
 405                           beg))
 406                    (to (or (next-single-property-change from 'mouse-face nil end)
 407                            end)))
 408               (if gnus-newsgroup-selected-overlay
 409                   (move-overlay gnus-newsgroup-selected-overlay
 410                                 from to (current-buffer))
 411                 (setq gnus-newsgroup-selected-overlay (make-overlay from to))
 412                 (overlay-put gnus-newsgroup-selected-overlay 'face
 413                              gnus-summary-selected-face))))))
 414
 415 (defun gnus-visual-highlight-selected-summary ()
 416     ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 417     ;; Highlight selected article in summary buffer
 418     (if gnus-summary-selected-face
 419         (save-excursion
 420           (let* ((beg (progn (beginning-of-line) (point)))
 421                  (end (progn (end-of-line) (point)))
 422                  (to (max 1 (1- (previous-single-property-change
 423                                  end 'mouse-face nil beg))))
 424                  (from (1+ (next-single-property-change
 425                             beg 'mouse-face nil end))))
 426             (if (< to beg)
 427                 (progn
 428                   (setq from beg)
 429                   (setq to end)))
 430             (if gnus-newsgroup-selected-overlay
 431                 (move-overlay gnus-newsgroup-selected-overlay
 432                               from to (current-buffer))
 433               (setq gnus-newsgroup-selected-overlay (make-overlay from to))
 434               (overlay-put gnus-newsgroup-selected-overlay 'face
 435                            gnus-summary-selected-face))))))
 436 )
 437
 438
 439 ;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
 440 (defun gnus-visual-summary-highlight-line ()
 441   "Highlight current line according to `gnus-visual-summary-highlight'."
 442   (let* ((list gnus-visual-summary-highlight)
 443          (p (point))
 444          (end (progn (end-of-line) (point)))
 445          ;; now find out where the line starts and leave point there.
 446          (beg (progn (beginning-of-line) (point)))
 447          (score (or (cdr (assq (or (car (get-text-property beg 'gnus))
 448                                    gnus-current-article)
 449                                gnus-newsgroup-scored))
 450                     gnus-summary-default-score 0))
 451          (default gnus-summary-default-score)
 452          (mark (get-text-property beg 'gnus-mark))
 453          (inhibit-read-only t))
 454     (while (and list (not (eval (car (car list)))))
 455       (setq list (cdr list)))
 456     (let ((face (and list (cdr (car list)))))
 457       ;; BUG! For some reason the text properties of the first
 458       ;; characters get mangled.
 459       (or (eq face (get-text-property (+ beg 10) 'face))
 460           (put-text-property beg end 'face face)))
 461     (goto-char p)))
 462
 463 (defvar mode-motion-hook nil)
 464 (defun gnus-install-mouse-tracker ()
 465   (require 'mode-motion)
 466   (setq mode-motion-hook 'mode-motion-highlight-line))
 467
 468 (if (not gnus-xemacs)
 469     ()
 470   (setq gnus-group-mode-hook
 471         (cons
 472          (lambda ()
 473            (easy-menu-add gnus-group-reading-menu)
 474            (easy-menu-add gnus-group-group-menu)
 475            (easy-menu-add gnus-group-post-menu)
 476            (easy-menu-add gnus-group-misc-menu)
 477            (gnus-install-mouse-tracker))
 478          gnus-group-mode-hook))
 479   (setq gnus-summary-mode-hook
 480         (cons
 481          (lambda ()
 482            (easy-menu-add gnus-summary-mark-menu)
 483            (easy-menu-add gnus-summary-move-menu)
 484            (easy-menu-add gnus-summary-article-menu)
 485            (easy-menu-add gnus-summary-thread-menu)
 486            (easy-menu-add gnus-summary-misc-menu)
 487            (easy-menu-add gnus-summary-post-menu)
 488            (easy-menu-add gnus-summary-kill-menu)
 489            (gnus-install-mouse-tracker))
 490          gnus-summary-mode-hook))
 491   (setq gnus-article-mode-hook
 492         (cons
 493          (lambda ()
 494            (easy-menu-add gnus-article-article-menu)
 495            (easy-menu-add gnus-article-treatment-menu))
 496          gnus-article-mode-hook)))
 497
 498 (provide 'gnus-vis)
 499
 500 ;;; gnus-visual.el ends here