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

   1 ;;; gnus-visual: display-oriented parts of Gnus.
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars 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 'easymenu)
  29
  30 (defvar gnus-summary-selected-face 'underline
  31   "Face used for highlighting the selected 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 non-nil.
  39
  40 When FORM is evaluated point will be at the beginning of the line, and
  41 the following free variable can be used for convenience:
  42
  43 score:   (gnus-summary-interest)
  44 default: gnus-summary-default-interest
  45 below:   gnus-summary-mark-below
  46
  47 To check for marks, e.g. to underline replied articles, use `looking-at':
  48
  49    ((looking-at \".R\") . underline)
  50
  51 This will match all lines where the second character is `R'.
  52 The `.' will match any character.")
  53
  54 ;; Newsgroup buffer
  55
  56 ;; Make a menu bar item.
  57 (defun gnus-group-make-menu-bar ()
  58   (easy-menu-define
  59    gnus-group-reading-menu
  60    gnus-group-mode-map
  61    ""
  62    '("Group"
  63      ["Read" gnus-group-read-group t]
  64      ["Select" gnus-group-select-group t]
  65      ["Mark unread articles as read" gnus-group-catchup-current t]
  66      ["Mark all unread articles as read" gnus-group-catchup-current-all t]
  67      ["Check for new articles" gnus-group-get-new-news-this-group t]
  68      ["Toggle subscription" gnus-group-unsubscribe-current-group t]
  69      ["Kill" gnus-group-kill-group t]
  70      ["Yank" gnus-group-yank-group t]
  71      ["Describe" gnus-group-describe-group t]
  72      ["Edit kill file" gnus-group-edit-local-kill t]
  73      ["Expire expirable articles" gnus-group-expire-articles t]
  74      ["Set group level" gnus-group-set-current-level t]
  75      ))
  76
  77   (easy-menu-define
  78    gnus-group-group-menu
  79    gnus-group-mode-map
  80    ""
  81    '("Groups"
  82      ["Jump to group" gnus-group-jump-to-group t]
  83      ["List subscribed groups" gnus-group-list-groups t]
  84      ["List all groups" gnus-group-list-all-groups t]
  85      ["List groups matching..." gnus-group-list-matching t]
  86      ["Subscribe to random group" gnus-group-unsubscribe-group t]
  87      ["Describe all groups" gnus-group-describe-all-groups t]
  88      ["Group apropos" gnus-group-apropos t]
  89      ["Group and description apropos" gnus-group-description-apropos t]
  90      ["Add a foreign group" gnus-group-add-newsgroup t]
  91      ["Edit a group entry" gnus-group-edit-newsgroup t]
  92      ["Kill all newsgroups in region" gnus-group-kill-region t]
  93      ["Kill all zombie groups" gnus-group-kill-all-zombies t]
  94      ["List killed groups" gnus-group-list-killed t]
  95      ["List zombie groups" gnus-group-list-zombies t]
  96      ["Edit global KILL file" gnus-group-edit-global-kill t]
  97      ))
  98
  99   (easy-menu-define
 100    gnus-group-post-menu
 101    gnus-group-mode-map
 102    ""
 103    '("Post"
 104      ["Send a mail" gnus-group-mail t]
 105      ["Post an article" gnus-group-post-news t]
 106      ))
 107
 108   (easy-menu-define
 109    gnus-group-misc-menu
 110    gnus-group-mode-map
 111    ""
 112    '("Misc"
 113      ["Check for new news" gnus-group-get-new-news t]
 114      ["Delete bogus groups" gnus-group-check-bogus-groups t]
 115      ["Find new newsgroups" gnus-find-new-newsgroups t]
 116      ["Restart Gnus" gnus-group-restart t]
 117      ["Read init file" gnus-group-read-init-file t]
 118      ["Browse foreign server" gnus-group-browse-foreign-server t]
 119      ["Edit the global kill file" gnus-group-edit-global-kill t]
 120      ["Expire expirable articles in all groups" gnus-group-expire-all-groups t]
 121      ["Gnus version" gnus-version t]
 122      ["Save .newsrc files" gnus-group-save-newsrc t]
 123      ["Suspend Gnus" gnus-group-suspend t]
 124      ["Clear dribble buffer" gnus-group-clear-dribble t]
 125      ["Exit from Gnus" gnus-group-exit t]
 126      ["Exit from Gnus without updating .newsrc" gnus-group-quit t]
 127      ))
 128
 129   )
 130
 131 ;; Summary buffer
 132 (defun gnus-summary-make-menu-bar ()
 133
 134   (easy-menu-define
 135    gnus-summary-mark-menu
 136    gnus-summary-mode-map
 137    ""
 138    '("Mark"
 139      ["Set process mark" gnus-summary-mark-as-processable t]
 140      ["Remove process mark" gnus-summary-unmark-as-processable t]
 141      ["Remove all process marks" gnus-summary-unmark-all-processable t]
 142      ["Tick" gnus-summary-tick-article-forward t]
 143      ["Mark as read" gnus-summary-mark-as-read-forward t]
 144      ["Mark as unread" gnus-summary-clear-mark-forward t]
 145      ["Mark all articles with the current subject as read and select"
 146       gnus-summary-kill-same-subject-and-select t]
 147      ["Mark all articles with the current subject as read"
 148       gnus-summary-kill-same-subject t]
 149      ["Delete all subjects marked as read" gnus-summary-delete-marked-as-read t]
 150      ["Delete all subjects marked with..." gnus-summary-delete-marked-with t]
 151      ["Set expirable mark" gnus-summary-mark-as-expirable t]
 152      ["Remove expirable mark" gnus-summary-unmark-as-expirable t]
 153      ["Set bookmark" gnus-summary-set-bookmark t]
 154      ["Remove bookmark" gnus-summary-remove-bookmark t]
 155      ["Raise score" gnus-summary-raise-score t]
 156      ["Lower score" gnus-summary-lower-score t]
 157      ["Set score" gnus-summary-set-score t]
 158      ))
 159
 160   (easy-menu-define
 161    gnus-summary-move-menu
 162    gnus-summary-mode-map
 163    ""
 164    '("Move"
 165      ["Scroll article forwards" gnus-summary-next-page t]
 166      ["Next unread article" gnus-summary-next-unread-article t]
 167      ["Previous unread article" gnus-summary-prev-unread-article t]
 168      ["Next article" gnus-summary-next-article t]
 169      ["Previous article" gnus-summary-prev-article t]
 170      ["Next article with the same subject" gnus-summary-next-same-subject t]
 171      ["Previous article with the same subject" gnus-summary-prev-same-subject t]
 172      ["Go to the first unread article" gnus-summary-first-unread-article t]
 173      ["Go to subject number..." gnus-summary-goto-subject t]
 174      ["Go to the previous article" gnus-summary-goto-last-article t]
 175      ))
 176
 177   (easy-menu-define
 178    gnus-summary-article-menu
 179    gnus-summary-mode-map
 180    ""
 181    '("Article"
 182      ["Interactive search in the article" gnus-summary-isearch-article t]
 183      ["Search for an regexp in articles" gnus-summary-search-article-forward t]
 184      ["Beginning of the article" gnus-summary-beginning-of-article t]
 185      ["End of the article" gnus-summary-end-of-article t]
 186      ["Fetch the parent of the article" gnus-summary-refer-parent-article t]
 187      ["Fetch an article with Message-ID..." gnus-summary-refer-article t]
 188      ["Stop page breaking" gnus-summary-stop-page-breaking t]
 189      ["Caesar rotate" gnus-summary-caesar-message t]
 190      ["Redisplay" gnus-summary-show-article t]
 191      ["Toggle header" gnus-summary-toggle-header t]
 192      ["Toggle MIME" gnus-summary-toggle-mime t]
 193      ["Save" gnus-summary-save-article t]
 194      ["Save in rmail format" gnus-summary-save-article-rmail t]
 195      ["Pipe through a filter" gnus-summary-pipe-output t]
 196      ["Respool article" gnus-summary-respool-article t]
 197      ["Move article" gnus-summary-move-article t]
 198      ))
 199
 200   (easy-menu-define
 201    gnus-summary-thread-menu
 202    gnus-summary-mode-map
 203    ""
 204    '("Threads"
 205      ["Toggle threading" gnus-summary-toggle-threads t]
 206      ["Display hidden thread" gnus-summary-show-thread t]
 207      ["Hide thread" gnus-summary-hide-thread t]
 208      ["Go to next thread" gnus-summary-next-thread t]
 209      ["Go to previous thread" gnus-summary-prev-thread t]
 210      ["Go down thread" gnus-summary-down-thread t]
 211      ["Go up thread" gnus-summary-up-thread t]
 212      ["Mark thread as read" gnus-summary-kill-thread t]
 213      ))
 214
 215   (easy-menu-define
 216    gnus-summary-misc-menu
 217    gnus-summary-mode-map
 218    ""
 219    '("Misc"
 220      ["Sort by number" gnus-summary-sort-by-number t]
 221      ["Sort by author" gnus-summary-sort-by-author t]
 222      ["Sort by subject" gnus-summary-sort-by-subject t]
 223      ["Sort by date" gnus-summary-sort-by-date t]
 224      ["Filter articles" gnus-summary-execute-command t]
 225      ["Mark all articles as read and exit" gnus-summary-catchup-and-exit t]
 226      ["Toggle line truncation" gnus-summary-toggle-truncation t]
 227      ["Expire expirable articles" gnus-summary-expire-articles t]
 228      ["Delete a mail article" gnus-summary-delete-article t]
 229      ["Show all dormant articles" gnus-summary-show-all-dormant t]
 230      ["Show all expunged articles" gnus-summary-show-all-expunged t]
 231      ["Reselect group" gnus-summary-reselect-current-group t]
 232      ["Rescan group" gnus-summary-rescan-group t]
 233      ["Describe group" gnus-summary-describe-group t]
 234      ["Exit group" gnus-summary-exit t]
 235      ["Exit group without updating" gnus-summary-quit t]
 236      ))
 237
 238   (easy-menu-define
 239    gnus-summary-post-menu
 240    gnus-summary-mode-map
 241    ""
 242    '("Post"
 243      ["Post an article" gnus-summary-post-news t]
 244      ["Followup an article" gnus-summary-followup t]
 245      ["Followup an article and include original"
 246       gnus-summary-followup-with-original t]
 247      ["Supersede article" gnus-summary-supersede-article t]
 248      ["Cancel article" gnus-summary-cancel-article t]
 249      ["Mail a reply" gnus-summary-reply t]
 250      ["Mail a reply and include original" gnus-summary-reply-with-original t]
 251      ["Forward an article via mail" gnus-summary-mail-forward t]
 252      ["Send a mail" gnus-summary-mail-other-window t]
 253      ))
 254
 255   (easy-menu-define
 256    gnus-summary-kill-menu
 257    gnus-summary-mode-map
 258    ""
 259    '("Kill"
 260      ["Edit local kill file" gnus-summary-edit-local-kill t]
 261      ["Edit global kill file" gnus-summary-edit-global-kill t]
 262      ["Expunge with score below..." gnus-kill-file-set-expunge-below t]
 263      ["Set mark with score below..." gnus-kill-file-set-mark-below t]
 264      ["Raise score with current subject"
 265       gnus-summary-temporarily-raise-by-subject t]
 266      ["Raise score with current author"
 267       gnus-summary-temporarily-raise-by-author t]
 268      ["Raise score with current thread"
 269       gnus-summary-temporarily-raise-by-thread t]
 270      ["Raise score with current crossposting"
 271       gnus-summary-temporarily-raise-by-xref t]
 272      ["Permanently raise score with current subject"
 273       gnus-summary-raise-by-subject t]
 274      ["Permanently raise score with current author"
 275       gnus-summary-raise-by-author t]
 276      ["Permanently raise score with current crossposting"
 277       gnus-summary-raise-by-xref t]
 278      ["Permanently raise score for followups to current author"
 279       gnus-summary-raise-followups-to-author t]
 280      ["Lower score with current subject"
 281       gnus-summary-temporarily-lower-by-subject t]
 282      ["Lower score with current author"
 283       gnus-summary-temporarily-lower-by-author t]
 284      ["Lower score with current thread"
 285       gnus-summary-temporarily-lower-by-thread t]
 286      ["Lower score with current crossposting"
 287       gnus-summary-temporarily-lower-by-xref t]
 288      ["Permanently lower score with current subject"
 289       gnus-summary-lower-by-subject t]
 290      ["Permanently lower score with current author"
 291       gnus-summary-lower-by-author t]
 292      ["Permanently lower score with current crossposting"
 293       gnus-summary-lower-by-xref t]
 294      ["Permanently lower score for followups to current author"
 295       gnus-summary-lower-followups-to-author t]
 296      ))
 297   )
 298
 299 ;; Article buffer
 300 (defun gnus-article-make-menu-bar ()
 301
 302  (easy-menu-define
 303    gnus-article-mode-menu
 304    gnus-article-mode-map
 305    ""
 306    '("Article"
 307      ["Scroll forwards" gnus-article-next-page t]
 308      ["Scroll backwards" gnus-article-prev-page t]
 309      ["Show summary" gnus-article-show-summary t]
 310      ["Fetch Message-ID at point" gnus-article-refer-article t]
 311      ["Mail to address at point" gnus-article-mail t]
 312      ["Mail to address at point and include original"
 313       gnus-article-mail-with-original t]
 314      ))
 315
 316  (easy-menu-define
 317    gnus-article-mode-menu
 318    gnus-article-mode-map
 319    ""
 320    '("Treatment"
 321      ["Hide headers" gnus-article-hide-headers t]
 322      ["Hide signature" gnus-article-hide-signature t]
 323      ["Hide citation" gnus-article-hide-citation t]
 324      ["Treat overstrike" gnus-article-treat-overstrike t]
 325      ["Remove carriage return" gnus-article-remove-cr t]
 326      ["Remove quoted-unreadble" gnus-article-de-quoted-unreadable t]
 327      ))
 328  )
 329
 330 (defun gnus-visual-highlight-selected-summary ()
 331   ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 332   ;; Highlight selected article in summary buffer
 333   (if gnus-summary-selected-face
 334       (save-excursion
 335         (let* ((beg (progn (beginning-of-line) (point)))
 336                (end (progn (end-of-line) (point)))
 337                (from (or
 338                       (next-single-property-change beg 'mouse-face nil end)
 339                       beg))
 340                (to (or (next-single-property-change from 'mouse-face nil end)
 341                        end)))
 342           (if gnus-newsgroup-selected-overlay
 343               (move-overlay gnus-newsgroup-selected-overlay
 344                             from to (current-buffer))
 345             (setq gnus-newsgroup-selected-overlay (make-overlay from to))
 346             (overlay-put gnus-newsgroup-selected-overlay 'face
 347                          gnus-summary-selected-face))))))
 348
 349 (defun gnus-visual-summary-highlight-line ()
 350   "Highlight current line according to `gnus-visual-summary-highlight'."
 351   (let ((list gnus-visual-summary-highlight)
 352         (inhibit-read-only t))
 353     (while (and list (not (eval (car (car list)))))
 354       (setq list (cdr list)))
 355     (let ((face (and list (cdr (car list)))))
 356       (save-excursion
 357         ;; BUG! For some reason the text properties of the first
 358         ;; characters get mangled.
 359         (forward-char 10)
 360         (if (eq face (get-text-property (point) 'face))
 361             ()
 362           (put-text-property (save-excursion (beginning-of-line 1) (point))
 363                              (save-excursion (end-of-line 1) (point))
 364                              'face face))))))
 365
 366 (provide 'gnus-visual)
 367
 368 ;;; gnus-visual.el ends here