+Mon Aug 12 03:51:57 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-async.el (gnus-make-async-article-function): New function.
+ (gnus-async-prefetch-article): Use it.
+
+Sat Aug 10 07:16:29 1996 Greg Stark <gsstark@mit.edu>
+
+ * gnus-start.el (gnus-activate-level): Doc fix.
+
+Sun Aug 11 03:33:02 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-msg.el (gnus-summary-mail-crosspost-complaint): New command.
+ (gnus-crosspost-message): New variable.
+
+ * gnus-vis.el: Removed file -- functions spread out over
+ gnus-group.el, gnus-sum.el and gnus-art.el.
+
+ * gnus-util.el (gnus-turn-off-edit-menu): Renamed function.
+
+ * gnus-salt.el (gnus-carpal-mode): Moved to this file.
+
+ * gnus-vis.el (gnus-score-set-default): Removed.
+ (gnus-visual-score-map): Removed.
+
+ * nntp.el (nntp-send-nosy-authinfo): Don't echo password.
+
+ * gnus-srvr.el (gnus-server-open-all-servers): New command and
+ keystroke.
+ (gnus-server-close-all-servers): Ditto.
+
+ * gnus-async.el (gnus-async-get-semaphore): New function.
+ (gnus-async-release-semaphore): New function.
+ (gnus-async-prefetch-article): Use them.
+
+ * nntp.el (nntp-make-process-buffer): New function.
+ (nntp-retrieve-data): Use after-change instead of filter.
+ (nntp-after-change-function): New function.
+
+ * gnus.el (gnus-read-method): Intern method.
+
+ * gnus-cache.el (gnus-cache-save-buffers): Didn't check before
+ making dir.
+
+Sat Aug 10 14:55:33 1996 Sudish Joseph <sudish@mindspring.com>
+
+ * gnus-win.el (gnus-buffer-configuration): Don't create picon
+ frame if gnus-picons-display-where is 'article.
+
+Sun Aug 11 02:47:30 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-vis.el (gnus-highlight-selected-summary): Would bug out on
+ some lines.
+
+ * gnus-spec.el (gnus-tilde-cut-form): Typo.
+ (gnus-parse-simple-format): Forgot to check `max-right' and
+ `max-left'.
+ (gnus-compile): Don't issue warnings.
+
+Fri Aug 2 14:53:02 1996 Christoph Wedler <wedler@fmi.uni-passau.de>
+
+ * smiley.el (smiley-buffer): `smiley-regexp-alist' can be a symbol
+ now.
+
+Sun Aug 11 02:37:57 1996 Greg Stark <gsstark@mit.edu>
+
+ * gnus-msg.el (gnus-post-method): Tested the wrong variable.
+
+Sun Aug 11 02:28:30 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-check-news-syntax): Messaged wrong number.
+
+Sat Aug 10 11:26:56 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-y-or-n-p): Moved to before usage.
+
+Fri Aug 9 16:42:52 1996 Danny Siu <dsiu@adobe.com>
+
+ * gnus-picon.el (gnus-article-display-picons): display picon even if
+ From line doesn't have full domain name.
+
+Sat Aug 10 10:11:21 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-reply): Didn't narrow properly to the head.
+ (message-indent-citation): Remove all blank lines at the start.
+
Sat Aug 10 07:00:34 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.el: Red Gnus v0.9 is released.
(defvar gnus-article-mode-hook nil
"*A hook for Gnus article mode.")
+(defvar gnus-article-menu-hook nil
+ "*Hook run after the creation of the article mode menu.")
+
(defvar gnus-article-prepare-hook nil
"*A hook called after an article has been prepared in the article buffer.
If you want to run a special decoding program like nkf, use this hook.")
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
+(defun gnus-article-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'article)
+ (unless (boundp 'gnus-article-article-menu)
+ (easy-menu-define
+ gnus-article-article-menu gnus-article-mode-map ""
+ '("Article"
+ ["Scroll forwards" gnus-article-goto-next-page t]
+ ["Scroll backwards" gnus-article-goto-prev-page t]
+ ["Show summary" gnus-article-show-summary t]
+ ["Fetch Message-ID at point" gnus-article-refer-article t]
+ ["Mail to address at point" gnus-article-mail t]
+ ))
+
+ (easy-menu-define
+ gnus-article-treatment-menu gnus-article-mode-map ""
+ '("Treatment"
+ ["Hide headers" gnus-article-hide-headers t]
+ ["Hide signature" gnus-article-hide-signature t]
+ ["Hide citation" gnus-article-hide-citation t]
+ ["Treat overstrike" gnus-article-treat-overstrike t]
+ ["Remove carriage return" gnus-article-remove-cr t]
+ ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
+ ))
+ (run-hooks 'gnus-article-menu-hook)))
+
(defun gnus-article-mode ()
"Major mode for displaying an article.
(let ((case-fold-search nil))
(query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
+;;;
+;;; Article highlights
+;;;
+
+;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
+
+;;; Internal Variables:
+
+(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]"
+ "*Regular expression that matches URLs.")
+
+(defvar gnus-button-alist
+ `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
+ t gnus-button-message-id 3)
+ ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
+ gnus-button-message-id 3)
+ ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
+ ;; This is how URLs _should_ be embedded in text...
+ ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
+ ;; Next regexp stolen from highlight-headers.el.
+ ;; Modified by Vladimir Alexiev.
+ (,gnus-button-url-regexp 0 t gnus-button-url 0))
+ "Alist of regexps matching buttons in article bodies.
+
+Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
+REGEXP: is the string matching text around the button,
+BUTTON: is the number of the regexp grouping actually matching the button,
+FORM: is a lisp expression which must eval to true for the button to
+be added,
+CALLBACK: is the function to call when the user push this button, and each
+PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
+
+CALLBACK can also be a variable, in that case the value of that
+variable it the real callback function.")
+
+(defvar gnus-header-button-alist
+ `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+ 0 t gnus-button-message-id 0)
+ ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
+ ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
+ 0 t gnus-button-mailto 0)
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
+ ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
+ gnus-button-message-id 3))
+ "Alist of headers and regexps to match buttons in article heads.
+
+This alist is very similar to `gnus-button-alist', except that each
+alist has an additional HEADER element first in each entry:
+
+\(HEADER REGEXP BUTTON FORM CALLBACK PAR)
+
+HEADER is a regexp to match a header. For a fuller explanation, see
+`gnus-button-alist'.")
+
+(defvar gnus-button-regexp nil)
+(defvar gnus-button-marker-list nil)
+;; Regexp matching any of the regexps from `gnus-button-alist'.
+
+(defvar gnus-button-last nil)
+;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
+
+;;; Commands:
+
+(defun gnus-article-push-button (event)
+ "Check text under the mouse pointer for a callback function.
+If the text under the mouse pointer has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+ (interactive "e")
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (let* ((pos (posn-point (event-start event)))
+ (data (get-text-property pos 'gnus-data))
+ (fun (get-text-property pos 'gnus-callback)))
+ (if fun (funcall fun data))))
+
+(defun gnus-article-press-button ()
+ "Check text at point for a callback function.
+If the text at point has a `gnus-callback' property,
+call it with the value of the `gnus-data' text property."
+ (interactive)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (fun (get-text-property (point) 'gnus-callback)))
+ (if fun (funcall fun data))))
+
+(defun gnus-article-prev-button (n)
+ "Move point to N buttons backward.
+If N is negative, move forward instead."
+ (interactive "p")
+ (gnus-article-next-button (- n)))
+
+(defun gnus-article-next-button (n)
+ "Move point to N buttons forward.
+If N is negative, move backward instead."
+ (interactive "p")
+ (let ((function (if (< n 0) 'previous-single-property-change
+ 'next-single-property-change))
+ (inhibit-point-motion-hooks t)
+ (backward (< n 0))
+ (limit (if (< n 0) (point-min) (point-max))))
+ (setq n (abs n))
+ (while (and (not (= limit (point)))
+ (> n 0))
+ ;; Skip past the current button.
+ (when (get-text-property (point) 'gnus-callback)
+ (goto-char (funcall function (point) 'gnus-callback nil limit)))
+ ;; Go to the next (or previous) button.
+ (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
+ ;; Put point at the start of the button.
+ (when (and backward (not (get-text-property (point) 'gnus-callback)))
+ (goto-char (funcall function (point) 'gnus-callback nil limit)))
+ ;; Skip past intangible buttons.
+ (when (get-text-property (point) 'intangible)
+ (incf n))
+ (decf n))
+ (unless (zerop n)
+ (gnus-message 5 "No more buttons"))
+ n))
+
+(defun gnus-article-highlight (&optional force)
+ "Highlight current article.
+This function calls `gnus-article-highlight-headers',
+`gnus-article-highlight-citation',
+`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
+do the highlighting. See the documentation for those functions."
+ (interactive (list 'force))
+ (gnus-article-highlight-headers)
+ (gnus-article-highlight-citation force)
+ (gnus-article-highlight-signature)
+ (gnus-article-add-buttons force)
+ (gnus-article-add-buttons-to-head))
+
+(defun gnus-article-highlight-some (&optional force)
+ "Highlight current article.
+This function calls `gnus-article-highlight-headers',
+`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
+do the highlighting. See the documentation for those functions."
+ (interactive (list 'force))
+ (gnus-article-highlight-headers)
+ (gnus-article-highlight-signature)
+ (gnus-article-add-buttons))
+
+(defun gnus-article-highlight-headers ()
+ "Highlight article headers as specified by `gnus-header-face-alist'."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (let ((alist gnus-header-face-alist)
+ (buffer-read-only nil)
+ (case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ entry regexp header-face field-face from hpoints fpoints)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (narrow-to-region (1- (point)) (point-min))
+ (while (setq entry (pop alist))
+ (goto-char (point-min))
+ (setq regexp (concat "^\\("
+ (if (string-equal "" (nth 0 entry))
+ "[^\t ]"
+ (nth 0 entry))
+ "\\)")
+ header-face (nth 1 entry)
+ field-face (nth 2 entry))
+ (while (and (re-search-forward regexp nil t)
+ (not (eobp)))
+ (beginning-of-line)
+ (setq from (point))
+ (or (search-forward ":" nil t)
+ (forward-char 1))
+ (when (and header-face
+ (not (memq (point) hpoints)))
+ (push (point) hpoints)
+ (gnus-put-text-property from (point) 'face header-face))
+ (when (and field-face
+ (not (memq (setq from (point)) fpoints)))
+ (push from fpoints)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (forward-char -2)
+ (goto-char (point-max)))
+ (gnus-put-text-property from (point) 'face field-face)))))))))
+
+(defun gnus-article-highlight-signature ()
+ "Highlight the signature in an article.
+It does this by highlighting everything after
+`gnus-signature-separator' using `gnus-signature-face'."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
+ (save-restriction
+ (when (and gnus-signature-face
+ (article-narrow-to-signature))
+ (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+ 'face gnus-signature-face)
+ (widen)
+ (article-search-signature)
+ (let ((start (match-beginning 0))
+ (end (set-marker (make-marker) (1+ (match-end 0)))))
+ (gnus-article-add-button start (1- end) 'gnus-signature-toggle
+ end)))))))
+
+(defun gnus-article-add-buttons (&optional force)
+ "Find external references in the article and make buttons of them.
+\"External references\" are things like Message-IDs and URLs, as
+specified by `gnus-button-alist'."
+ (interactive (list 'force))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ ;; Remove all old markers.
+ (while gnus-button-marker-list
+ (set-marker (pop gnus-button-marker-list) nil))
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist gnus-button-alist)
+ beg entry regexp)
+ (goto-char (point-min))
+ ;; We skip the headers.
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (setq beg (point))
+ (while (setq entry (pop alist))
+ (setq regexp (car entry))
+ (goto-char beg)
+ (while (re-search-forward regexp nil t)
+ (let* ((start (and entry (match-beginning (nth 1 entry))))
+ (end (and entry (match-end (nth 1 entry))))
+ (from (match-beginning 0)))
+ (when (or (eq t (nth 1 entry))
+ (eval (nth 1 entry)))
+ ;; That optional form returned non-nil, so we add the
+ ;; button.
+ (gnus-article-add-button
+ start end 'gnus-button-push
+ (car (push (set-marker (make-marker) from)
+ gnus-button-marker-list))))))))))
+
+;; Add buttons to the head of an article.
+(defun gnus-article-add-buttons-to-head ()
+ "Add buttons to the head of the article."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist gnus-header-button-alist)
+ entry beg end)
+ (nnheader-narrow-to-headers)
+ (while alist
+ ;; Each alist entry.
+ (setq entry (car alist)
+ alist (cdr alist))
+ (goto-char (point-min))
+ (while (re-search-forward (car entry) nil t)
+ ;; Each header matching the entry.
+ (setq beg (match-beginning 0))
+ (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0))
+ (point-max)))
+ (goto-char beg)
+ (while (re-search-forward (nth 1 entry) end t)
+ ;; Each match within a header.
+ (let* ((from (match-beginning 0))
+ (entry (cdr entry))
+ (start (match-beginning (nth 1 entry)))
+ (end (match-end (nth 1 entry)))
+ (form (nth 2 entry)))
+ (goto-char (match-end 0))
+ (and (eval form)
+ (gnus-article-add-button
+ start end (nth 3 entry)
+ (buffer-substring (match-beginning (nth 4 entry))
+ (match-end (nth 4 entry)))))))
+ (goto-char end))))
+ (widen)))
+
+;;; External functions:
+
+(defun gnus-article-add-button (from to fun &optional data)
+ "Create a button between FROM and TO with callback FUN and data DATA."
+ (and gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
+ (gnus-add-text-properties
+ from to
+ (nconc (and gnus-article-mouse-face
+ (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'gnus-callback fun)
+ (and data (list 'gnus-data data)))))
+
+;;; Internal functions:
+
+(defun gnus-signature-toggle (end)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
+ (if (get-text-property end 'invisible)
+ (article-unhide-text end (point-max))
+ (article-hide-text end (point-max) gnus-hidden-properties)))))
+
+(defun gnus-button-entry ()
+ ;; Return the first entry in `gnus-button-alist' matching this place.
+ (let ((alist gnus-button-alist)
+ (entry nil))
+ (while alist
+ (setq entry (pop alist))
+ (if (looking-at (car entry))
+ (setq alist nil)
+ (setq entry nil)))
+ entry))
+
+(defun gnus-button-push (marker)
+ ;; Push button starting at MARKER.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char marker)
+ (let* ((entry (gnus-button-entry))
+ (inhibit-point-motion-hooks t)
+ (fun (nth 3 entry))
+ (args (mapcar (lambda (group)
+ (let ((string (buffer-substring
+ (match-beginning group)
+ (match-end group))))
+ (gnus-set-text-properties
+ 0 (length string) nil string)
+ string))
+ (nthcdr 4 entry))))
+ (cond
+ ((fboundp fun)
+ (apply fun args))
+ ((and (boundp fun)
+ (fboundp (symbol-value fun)))
+ (apply (symbol-value fun) args))
+ (t
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))
+
+(defun gnus-button-message-id (message-id)
+ "Fetch MESSAGE-ID."
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-refer-article message-id)))
+
+(defun gnus-button-mailto (address)
+ ;; Mail to ADDRESS.
+ (set-buffer (gnus-copy-article-buffer))
+ (message-reply address))
+
+(defun gnus-button-reply (address)
+ ;; Reply to ADDRESS.
+ (message-reply address))
+
+(defun gnus-button-url (address)
+ "Browse ADDRESS."
+ (funcall browse-url-browser-function address browse-url-new-window-p))
+
+;;; Next/prev buttons in the article buffer.
+
+(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
+(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
+
+(defvar gnus-prev-page-map nil)
+(unless gnus-prev-page-map
+ (setq gnus-prev-page-map (make-sparse-keymap))
+ (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+
+(defun gnus-insert-prev-page-button ()
+ (let ((buffer-read-only nil))
+ (gnus-eval-format
+ gnus-prev-page-line-format nil
+ `(gnus-prev t local-map ,gnus-prev-page-map
+ gnus-callback gnus-article-button-prev-page))))
+
+(defvar gnus-next-page-map nil)
+(unless gnus-next-page-map
+ (setq gnus-next-page-map (make-keymap))
+ (suppress-keymap gnus-prev-page-map)
+ (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
+ (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
+
+(defun gnus-button-next-page ()
+ "Go to the next page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-next-page)
+ (select-window win)))
+
+(defun gnus-button-prev-page ()
+ "Go to the prev page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-prev-page)
+ (select-window win)))
+
+(defun gnus-insert-next-page-button ()
+ (let ((buffer-read-only nil))
+ (gnus-eval-format gnus-next-page-line-format nil
+ `(gnus-next t local-map ,gnus-next-page-map
+ gnus-callback
+ gnus-article-button-next-page))))
+
+(defun gnus-article-button-next-page (arg)
+ "Go to the next page."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-next-page)
+ (select-window win)))
+
+(defun gnus-article-button-prev-page (arg)
+ "Go to the prev page."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-prev-page)
+ (select-window win)))
+
(provide 'gnus-art)
;;; gnus-art.el ends here
(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
(defvar gnus-async-article-alist nil)
+(defvar gnus-async-article-semaphore '(nil))
+(defvar gnus-async-fetch-list nil)
(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
-(defvar gnus-asynch-header-prefetched nil)
+(defvar gnus-async-header-prefetched nil)
;;; Utility functions.
"Say whether GROUP is fetched from a server that supports asynchronocity."
(gnus-asynchronous-p (gnus-find-method-for-group group)))
+;;; Somewhat bogus semaphores.
+
+(defun gnus-async-get-semaphore (semaphore)
+ "Wait until SEMAPHORE is released."
+ (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2)
+ (sleep-for 1)))
+
+(defun gnus-async-release-semaphore (semaphore)
+ "Release SEMAPHORE."
+ (setcdr (symbol-value semaphore) nil))
+
;;;
;;; Article prefetch
;;;
(gnus-kill-buffer gnus-async-prefetch-article-buffer)
(gnus-kill-buffer gnus-async-prefetch-headers-buffer)
(setq gnus-async-article-alist nil
- gnus-asynch-header-prefetched nil))
+ gnus-async-header-prefetched nil))
+
+(defun gnus-async-set-buffer ()
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t))
(defun gnus-async-prefetch-next (group article summary)
"Possibly prefetch several articles starting with the article after ARTICLE."
(when next
(gnus-async-prefetch-article group next summary))))
-(defun gnus-async-prefetch-article (group article summary &optional number)
+(defun gnus-async-prefetch-article (group article summary &optional next)
"Possibly prefetch several articles starting with ARTICLE."
- (unless number
- (setq number gnus-use-article-prefetch))
- (when (and number
- (or (not (numberp number))
- (> number 0))
- (gnus-group-asynchronous-p group)
- (gnus-buffer-live-p summary))
- (when (numberp number)
- (decf number))
- (while (and article (gnus-async-prefetched-article-entry group article))
- (setq article (caadr (gnus-data-find-list article)))
- (when (numberp number)
- (decf number)))
+ (when (and (gnus-group-asynchronous-p group)
+ (gnus-buffer-live-p summary)
+ (or (not next)
+ gnus-async-fetch-list))
+ (unwind-protect
+ (progn
+ (gnus-async-get-semaphore 'gnus-async-article-semaphore)
+ (unless next
+ ;; Nix out any outstanding requests.
+ (setq gnus-async-fetch-list nil)
+ ;; Fill in the new list.
+ (let ((n gnus-use-article-prefetch)
+ (data (gnus-data-find-list article))
+ d)
+ (while (and (setq d (pop data))
+ (if (numberp n)
+ (natnump (decf n))
+ n))
+ (unless (gnus-async-prefetched-article-entry
+ group (setq article (gnus-data-number d)))
+ ;; Not already fetched -- so we add it to the list.
+ (push article gnus-async-fetch-list)))
+ (setq gnus-async-fetch-list (nreverse gnus-async-fetch-list))))
+
+ (setq article (pop gnus-async-fetch-list)))
+
+ (gnus-async-release-semaphore 'gnus-async-article-semaphore))
+
(when article
;; We want to fetch some more articles.
(save-excursion
(set-buffer summary)
- (let ((next (caadr (gnus-data-find-list article)))
- mark)
- (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
+ (let (mark)
+ (gnus-async-set-buffer)
(goto-char (point-max))
(setq mark (point-marker))
(let ((nnheader-callback-function
- `(lambda (arg)
- (save-excursion
- (nnheader-set-temp-buffer
- gnus-async-prefetch-article-buffer t)
- (push (list ',(intern (format "%s-%d" group article))
- ,mark (set-marker (make-marker) (point-max))
- ,group ,article)
- gnus-async-article-alist)
- (when (gnus-buffer-live-p ,summary)
- ,(when next
- `(gnus-async-prefetch-article
- ,group ,next ,summary ,number))))))
+ (gnus-make-async-article-function
+ group article mark summary next))
(nntp-server-buffer (get-buffer
gnus-async-prefetch-article-buffer)))
(gnus-message 7 "Prefetching article %d in group %s"
article group)
(gnus-request-article article group)))))))
+(defun gnus-make-async-article-function (group article mark summary next)
+ "Return a callback function."
+ `(lambda (arg)
+ (save-excursion
+ (gnus-async-set-buffer)
+ (gnus-async-get-semaphore 'gnus-async-article-semaphore)
+ (push (list ',(intern (format "%s-%d" group article))
+ ,mark (set-marker (make-marker)
+ (point-max))
+ ,group ,article)
+ gnus-async-article-alist)
+ (gnus-async-release-semaphore
+ 'gnus-async-article-semaphore)
+ (when (gnus-buffer-live-p ,summary)
+ (gnus-async-prefetch-article
+ ,group ,next ,summary t)))))
+
(defun gnus-async-request-fetched-article (group article buffer)
"See whether we have ARTICLE from GROUP and put it in BUFFER."
(when (numberp article)
(let ((entry (gnus-async-prefetched-article-entry group article)))
(when entry
(save-excursion
- (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
+ (gnus-async-set-buffer)
(copy-to-buffer buffer (cadr entry) (caddr entry))
;; Remove the read article from the prefetch buffer.
(when (memq 'read gnus-prefetched-article-deletion-strategy)
- (gnus-asynch-delete-prefected-entry entry))
+ (gnus-async-delete-prefected-entry entry))
;; Decode the article. Perhaps this shouldn't be done
;; here?
(set-buffer buffer)
(gnus-delete-line)
t)))))
-(defun gnus-asynch-delete-prefected-entry (entry)
+(defun gnus-async-delete-prefected-entry (entry)
"Delete ENTRY from buffer and alist."
(delete-region (cadr entry) (caddr entry))
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil)
+ (gnus-async-get-semaphore 'gnus-async-article-semaphore)
(setq gnus-async-article-alist
- (delq entry gnus-async-article-alist)))
+ (delq entry gnus-async-article-alist))
+ (gnus-async-release-semaphore 'gnus-async-article-semaphore))
(defun gnus-async-prefetch-remove-group (group)
"Remove all articles belonging to GROUP from the prefetch buffer."
(memq 'exit gnus-prefetched-article-deletion-strategy))
(let ((alist gnus-async-article-alist))
(save-excursion
- (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
+ (gnus-async-set-buffer)
(while alist
(when (equal group (nth 3 (car alist)))
- (gnus-asynch-delete-prefected-entry (car alist)))
+ (gnus-async-delete-prefected-entry (car alist)))
(pop alist))))))
(defun gnus-async-prefetched-article-entry (group article)
(let (unread)
(when (and gnus-use-header-prefetch
(gnus-group-asynchronous-p group)
- (listp gnus-asynch-header-prefetched)
+ (listp gnus-async-header-prefetched)
(setq unread (gnus-list-of-unread-articles group)))
;; Mark that a fetch is in progress.
- (setq gnus-asynch-header-prefetched t)
+ (setq gnus-async-header-prefetched t)
(nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
(erase-buffer)
(let ((nntp-server-buffer (current-buffer))
(nnheader-callback-function
`(lambda (arg)
- (setq gnus-asynch-header-prefetched
+ (setq gnus-async-header-prefetched
,(cons group unread)))))
(gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
-(defun gnus-asynch-retrieve-fetched-headers (articles group)
+(defun gnus-async-retrieve-fetched-headers (articles group)
"See whether we have prefetched headers."
(when (and gnus-use-header-prefetch
(gnus-group-asynchronous-p group)
- (listp gnus-asynch-header-prefetched)
- (equal group (car gnus-asynch-header-prefetched))
- (equal articles (cdr gnus-asynch-header-prefetched)))
+ (listp gnus-async-header-prefetched)
+ (equal group (car gnus-async-header-prefetched))
+ (equal articles (cdr gnus-async-header-prefetched)))
(save-excursion
(nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
(nntp-decode-text)
(copy-to-buffer nntp-server-buffer (point-min) (point-max))
(erase-buffer)
- (setq gnus-asynch-header-prefetched nil)
+ (setq gnus-async-header-prefetched nil)
t)))
(provide 'gnus-async)
(if (> (buffer-size) 0)
;; non-empty overview, write it out
(progn
- (make-directory (file-name-directory overview-file) t)
+ (unless (file-exists-p (file-name-directory overview-file))
+ (make-directory (file-name-directory overview-file) t))
(write-region (point-min) (point-max)
overview-file nil 'quietly))
;; empty overview file, remove it
(defvar gnus-group-mode-hook nil
"*A hook for Gnus group mode.")
+(defvar gnus-group-menu-hook nil
+ "*Hook run after the creation of the group mode menu.")
+
(defvar gnus-group-catchup-group-hook nil
"*A hook run when catching up a group from the group buffer.")
"\C-k" gnus-group-kill-level
"z" gnus-group-kill-all-zombies))
+
+(defun gnus-group-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'group)
+ (unless (boundp 'gnus-group-reading-menu)
+
+ (easy-menu-define
+ gnus-group-reading-menu gnus-group-mode-map ""
+ '("Group"
+ ["Read" gnus-group-read-group (gnus-group-group-name)]
+ ["Select" gnus-group-select-group (gnus-group-group-name)]
+ ["See old articles" (gnus-group-select-group 'all)
+ :keys "C-u SPC" :active (gnus-group-group-name)]
+ ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
+ ["Catch up all articles" gnus-group-catchup-current-all
+ (gnus-group-group-name)]
+ ["Check for new articles" gnus-group-get-new-news-this-group
+ (gnus-group-group-name)]
+ ["Toggle subscription" gnus-group-unsubscribe-current-group
+ (gnus-group-group-name)]
+ ["Kill" gnus-group-kill-group (gnus-group-group-name)]
+ ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
+ ["Describe" gnus-group-describe-group (gnus-group-group-name)]
+ ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
+ ["Edit kill file" gnus-group-edit-local-kill
+ (gnus-group-group-name)]
+ ;; Actually one should check, if any of the marked groups gives t for
+ ;; (gnus-check-backend-function 'request-expire-articles ...)
+ ["Expire articles" gnus-group-expire-articles
+ (or (and (gnus-group-group-name)
+ (gnus-check-backend-function
+ 'request-expire-articles
+ (gnus-group-group-name))) gnus-group-marked)]
+ ["Set group level" gnus-group-set-current-level
+ (gnus-group-group-name)]
+ ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
+ ))
+
+ (easy-menu-define
+ gnus-group-group-menu gnus-group-mode-map ""
+ '("Groups"
+ ("Listing"
+ ["List unread subscribed groups" gnus-group-list-groups t]
+ ["List (un)subscribed groups" gnus-group-list-all-groups t]
+ ["List killed groups" gnus-group-list-killed gnus-killed-list]
+ ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
+ ["List level..." gnus-group-list-level t]
+ ["Describe all groups" gnus-group-describe-all-groups t]
+ ["Group apropos..." gnus-group-apropos t]
+ ["Group and description apropos..." gnus-group-description-apropos t]
+ ["List groups matching..." gnus-group-list-matching t]
+ ["List all groups matching..." gnus-group-list-all-matching t]
+ ["List active file" gnus-group-list-active t])
+ ("Sort"
+ ["Default sort" gnus-group-sort-groups
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by method" gnus-group-sort-groups-by-method
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by rank" gnus-group-sort-groups-by-rank
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by score" gnus-group-sort-groups-by-score
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by level" gnus-group-sort-groups-by-level
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by unread" gnus-group-sort-groups-by-unread
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
+ ["Sort by name" gnus-group-sort-groups-by-alphabet
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
+ ("Mark"
+ ["Mark group" gnus-group-mark-group
+ (and (gnus-group-group-name)
+ (not (memq (gnus-group-group-name) gnus-group-marked)))]
+ ["Unmark group" gnus-group-unmark-group
+ (and (gnus-group-group-name)
+ (memq (gnus-group-group-name) gnus-group-marked))]
+ ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
+ ["Mark regexp..." gnus-group-mark-regexp t]
+ ["Mark region" gnus-group-mark-region t]
+ ["Mark buffer" gnus-group-mark-buffer t]
+ ["Execute command" gnus-group-universal-argument
+ (or gnus-group-marked (gnus-group-group-name))])
+ ("Subscribe"
+ ["Subscribe to a group" gnus-group-unsubscribe-group t]
+ ["Kill all newsgroups in region" gnus-group-kill-region t]
+ ["Kill all zombie groups" gnus-group-kill-all-zombies
+ gnus-zombie-list]
+ ["Kill all groups on level..." gnus-group-kill-level t])
+ ("Foreign groups"
+ ["Make a foreign group" gnus-group-make-group t]
+ ["Add a directory group" gnus-group-make-directory-group t]
+ ["Add the help group" gnus-group-make-help-group t]
+ ["Add the archive group" gnus-group-make-archive-group t]
+ ["Make a doc group" gnus-group-make-doc-group t]
+ ["Make a kiboze group" gnus-group-make-kiboze-group t]
+ ["Make a virtual group" gnus-group-make-empty-virtual t]
+ ["Add a group to a virtual" gnus-group-add-to-virtual t]
+ ["Rename group" gnus-group-rename-group
+ (gnus-check-backend-function
+ 'request-rename-group (gnus-group-group-name))]
+ ["Delete group" gnus-group-delete-group
+ (gnus-check-backend-function
+ 'request-delete-group (gnus-group-group-name))])
+ ("Editing groups"
+ ["Parameters" gnus-group-edit-group-parameters
+ (gnus-group-group-name)]
+ ["Select method" gnus-group-edit-group-method
+ (gnus-group-group-name)]
+ ["Info" gnus-group-edit-group (gnus-group-group-name)])
+ ("Score file"
+ ["Flush cache" gnus-score-flush-cache
+ (or gnus-score-cache gnus-short-name-score-file-cache)])
+ ("Move"
+ ["Next" gnus-group-next-group t]
+ ["Previous" gnus-group-prev-group t]
+ ["Next unread" gnus-group-next-unread-group t]
+ ["Previous unread" gnus-group-prev-unread-group t]
+ ["Next unread same level" gnus-group-next-unread-group-same-level t]
+ ["Previous unread same level"
+ gnus-group-previous-unread-group-same-level t]
+ ["Jump to group" gnus-group-jump-to-group t]
+ ["First unread group" gnus-group-first-unread-group t]
+ ["Best unread group" gnus-group-best-unread-group t])
+ ["Transpose" gnus-group-transpose-groups
+ (gnus-group-group-name)]
+ ["Read a directory as a group..." gnus-group-enter-directory t]
+ ))
+
+ (easy-menu-define
+ gnus-group-misc-menu gnus-group-mode-map ""
+ '("Misc"
+ ["Send a bug report" gnus-bug t]
+ ["Send a mail" gnus-group-mail t]
+ ["Post an article..." gnus-group-post-news t]
+ ["Customize score file" gnus-score-customize t]
+ ["Check for new news" gnus-group-get-new-news t]
+ ["Activate all groups" gnus-activate-all-groups t]
+ ["Delete bogus groups" gnus-group-check-bogus-groups t]
+ ["Find new newsgroups" gnus-find-new-newsgroups t]
+ ["Restart Gnus" gnus-group-restart t]
+ ["Read init file" gnus-group-read-init-file t]
+ ["Browse foreign server" gnus-group-browse-foreign-server t]
+ ["Enter server buffer" gnus-group-enter-server-mode t]
+ ["Expire all expirable articles" gnus-group-expire-all-groups t]
+ ["Generate any kiboze groups" nnkiboze-generate-groups t]
+ ["Gnus version" gnus-version t]
+ ["Save .newsrc files" gnus-group-save-newsrc t]
+ ["Suspend Gnus" gnus-group-suspend t]
+ ["Clear dribble buffer" gnus-group-clear-dribble t]
+ ["Edit global kill file" gnus-group-edit-global-kill t]
+ ["Read manual" gnus-info-find-node t]
+ ["Toggle topics" gnus-topic-mode t]
+ ("SOUP"
+ ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
+ ["Send replies" gnus-soup-send-replies
+ (fboundp 'gnus-soup-pack-packet)]
+ ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
+ ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
+ ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
+ ["Exit from Gnus" gnus-group-exit t]
+ ["Exit without saving" gnus-group-quit t]
+ ))
+
+ (run-hooks 'gnus-group-menu-hook)
+ ))
+
(defun gnus-group-mode ()
"Major mode for reading news.
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
+(defun gnus-group-highlight-line ()
+ "Highlight the current line according to `gnus-group-highlight'."
+ (let* ((list gnus-group-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (group (gnus-group-group-name))
+ (entry (gnus-group-entry group))
+ (unread (if (numberp (car entry)) (car entry) 0))
+ (info (nth 2 entry))
+ (method (gnus-server-get-method group (gnus-info-method info)))
+ (marked (gnus-info-marks info))
+ (mailp (memq 'mail (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ (level (or (gnus-info-level info) 9))
+ (score (or (gnus-info-score info) 0))
+ (ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (gnus-extent-start-open beg)))
+ (goto-char p)))
+
(defun gnus-group-update-group (group &optional visible-only)
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
;;; Gnus Posting Functions
;;;
-(gnus-define-keys
- (gnus-summary-send-map "S" gnus-summary-mode-map)
- "p" gnus-summary-post-news
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "c" gnus-summary-cancel-article
- "s" gnus-summary-supersede-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "m" gnus-summary-mail-other-window
- "u" gnus-uu-post-news
- "om" gnus-summary-mail-forward
- "op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
-
-(gnus-define-keys
- (gnus-send-bounce-map "D" gnus-summary-send-map)
- "b" gnus-summary-resend-bounced-mail
-; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
+ "p" gnus-summary-post-news
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "c" gnus-summary-cancel-article
+ "s" gnus-summary-supersede-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "m" gnus-summary-mail-other-window
+ "u" gnus-uu-post-news
+ "\M-c" gnus-summary-mail-crosspost-complaint
+ "om" gnus-summary-mail-forward
+ "op" gnus-summary-post-forward
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
+
+(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
+ "b" gnus-summary-resend-bounced-mail
+ ;; "c" gnus-summary-send-draft
+ "r" gnus-summary-resend-message)
;;; Internal functions.
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
- (when (gnus-eval-in-buffer-window
- gnus-original-article-buffer (message-cancel-news))
+ (when (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (message-cancel-news))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
(cond
;; If the group-method is nil (which shouldn't happen) we use
;; the default method.
- ((null arg)
+ ((null group-method)
(or gnus-post-method gnus-select-method message-post-method))
;; We want this group's method.
((and arg (not (eq arg 0)))
(format " %d.%d" emacs-major-version emacs-minor-version)))
(t emacs-version))))
-;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
(defun gnus-inews-insert-mime-headers ()
(goto-char (point-min))
(let ((mail-header-separator
(insert (format gnus-nastygram-message group))
(message-send-and-exit))))
+(defvar gnus-crosspost-complaint
+ "Hi,
+
+You posted the article below with the following Newsgroups header:
+
+Newsgroups: %s
+
+The %s group, at least, was an inappropriate recipient
+of this message. Please trim your Newsgroups header to exclude this
+group before posting in the future.
+
+Thank you.
+"
+ "Format string to be inserted when complaining about crossposts.
+The first %s will be replaced by the Newsgroups header;
+the second with the current group name.")
+
+(defun gnus-summary-mail-crosspost-complaint (n)
+ "Send a complaint about crossposting to the current article(s)."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-subject article)
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ newsgroups)
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (if (<= (length (message-tokenize-header
+ (setq newsgroups (mail-fetch-field "newsgroups"))
+ ", "))
+ 1)
+ (gnus-message 1 "Not a crossposted article")
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-reply-with-original 1)
+ (set-buffer gnus-message-buffer)
+ (insert (format gnus-crosspost-complaint newsgroups group))
+ (when (gnus-y-or-n-p "Send this complaint? ")
+ (message-send-and-exit)))))))
+
(defun gnus-summary-mail-other-window ()
"Compose mail in other window."
(interactive)
(setq from (mail-fetch-field "from"))
(setq from (downcase (or (cadr (mail-extract-address-components
from))
- ""))
- at-idx (string-match "@" from)))
+ "")))
+ (or (setq at-idx (string-match "@" from))
+ (setq at-idx (length from))))
(save-excursion
(let ((username (substring from 0 at-idx))
- (addrs (nreverse
- (message-tokenize-header (substring from (1+ at-idx))
- "."))))
+ (addrs (if (eq at-idx (length from))
+ (if gnus-local-domain
+ (nreverse (message-tokenize-header
+ gnus-local-domain "."))
+ '(""))
+ (nreverse (message-tokenize-header
+ (substring from (1+ at-idx)) ".")))))
(set-buffer (get-buffer-create
(gnus-get-buffer-name gnus-picons-display-where)))
(gnus-add-current-to-buffer-list)
(set-window-point
(get-buffer-window (current-buffer) t) (cdr region))))))
+;;;
+;;; gnus-carpal
+;;;
+
+(defvar gnus-carpal-group-buffer-buttons
+ '(("next" . gnus-group-next-unread-group)
+ ("prev" . gnus-group-prev-unread-group)
+ ("read" . gnus-group-read-group)
+ ("select" . gnus-group-select-group)
+ ("catch-up" . gnus-group-catchup-current)
+ ("new-news" . gnus-group-get-new-news-this-group)
+ ("toggle-sub" . gnus-group-unsubscribe-current-group)
+ ("subscribe" . gnus-group-unsubscribe-group)
+ ("kill" . gnus-group-kill-group)
+ ("yank" . gnus-group-yank-group)
+ ("describe" . gnus-group-describe-group)
+ "list"
+ ("subscribed" . gnus-group-list-groups)
+ ("all" . gnus-group-list-all-groups)
+ ("killed" . gnus-group-list-killed)
+ ("zombies" . gnus-group-list-zombies)
+ ("matching" . gnus-group-list-matching)
+ ("post" . gnus-group-post-news)
+ ("mail" . gnus-group-mail)
+ ("rescan" . gnus-group-get-new-news)
+ ("browse-foreign" . gnus-group-browse-foreign)
+ ("exit" . gnus-group-exit)))
+
+(defvar gnus-carpal-summary-buffer-buttons
+ '("mark"
+ ("read" . gnus-summary-mark-as-read-forward)
+ ("tick" . gnus-summary-tick-article-forward)
+ ("clear" . gnus-summary-clear-mark-forward)
+ ("expirable" . gnus-summary-mark-as-expirable)
+ "move"
+ ("scroll" . gnus-summary-next-page)
+ ("next-unread" . gnus-summary-next-unread-article)
+ ("prev-unread" . gnus-summary-prev-unread-article)
+ ("first" . gnus-summary-first-unread-article)
+ ("best" . gnus-summary-best-unread-article)
+ "article"
+ ("headers" . gnus-summary-toggle-header)
+ ("uudecode" . gnus-uu-decode-uu)
+ ("enter-digest" . gnus-summary-enter-digest-group)
+ ("fetch-parent" . gnus-summary-refer-parent-article)
+ "mail"
+ ("move" . gnus-summary-move-article)
+ ("copy" . gnus-summary-copy-article)
+ ("respool" . gnus-summary-respool-article)
+ "threads"
+ ("lower" . gnus-summary-lower-thread)
+ ("kill" . gnus-summary-kill-thread)
+ "post"
+ ("post" . gnus-summary-post-news)
+ ("mail" . gnus-summary-mail)
+ ("followup" . gnus-summary-followup-with-original)
+ ("reply" . gnus-summary-reply-with-original)
+ ("cancel" . gnus-summary-cancel-article)
+ "misc"
+ ("exit" . gnus-summary-exit)
+ ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
+
+(defvar gnus-carpal-server-buffer-buttons
+ '(("add" . gnus-server-add-server)
+ ("browse" . gnus-server-browse-server)
+ ("list" . gnus-server-list-servers)
+ ("kill" . gnus-server-kill-server)
+ ("yank" . gnus-server-yank-server)
+ ("copy" . gnus-server-copy-server)
+ ("exit" . gnus-server-exit)))
+
+(defvar gnus-carpal-browse-buffer-buttons
+ '(("subscribe" . gnus-browse-unsubscribe-current-group)
+ ("exit" . gnus-browse-exit)))
+
+(defvar gnus-carpal-group-buffer "*Carpal Group*")
+(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
+(defvar gnus-carpal-server-buffer "*Carpal Server*")
+(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
+
+(defvar gnus-carpal-attached-buffer nil)
+
+(defvar gnus-carpal-mode-hook nil
+ "*Hook run in carpal mode buffers.")
+
+(defvar gnus-carpal-button-face 'bold
+ "*Face used on carpal buttons.")
+
+(defvar gnus-carpal-header-face 'bold-italic
+ "*Face used on carpal buffer headers.")
+
+(defvar gnus-carpal-mode-map nil)
+(put 'gnus-carpal-mode 'mode-class 'special)
+
+(if gnus-carpal-mode-map
+ nil
+ (setq gnus-carpal-mode-map (make-keymap))
+ (suppress-keymap gnus-carpal-mode-map)
+ (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
+ (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
+
+(defun gnus-carpal-mode ()
+ "Major mode for clicking buttons.
+
+All normal editing commands are switched off.
+\\<gnus-carpal-mode-map>
+The following commands are available:
+
+\\{gnus-carpal-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq mode-line-modified "-- ")
+ (setq major-mode 'gnus-carpal-mode)
+ (setq mode-name "Gnus Carpal")
+ (setq mode-line-process nil)
+ (use-local-map gnus-carpal-mode-map)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (make-local-variable 'gnus-carpal-attached-buffer)
+ (run-hooks 'gnus-carpal-mode-hook))
+
+(defun gnus-carpal-setup-buffer (type)
+ (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
+ (if (get-buffer buffer)
+ ()
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (gnus-carpal-mode)
+ (setq gnus-carpal-attached-buffer
+ (intern (format "gnus-%s-buffer" type)))
+ (gnus-add-current-to-buffer-list)
+ (let ((buttons (symbol-value
+ (intern (format "gnus-carpal-%s-buffer-buttons"
+ type))))
+ (buffer-read-only nil)
+ button)
+ (while buttons
+ (setq button (car buttons)
+ buttons (cdr buttons))
+ (if (stringp button)
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert button) (point) (insert " "))
+ (list 'face gnus-carpal-header-face))
+ (gnus-set-text-properties
+ (point)
+ (prog2 (insert (car button)) (point) (insert " "))
+ (list 'gnus-callback (cdr button)
+ 'face gnus-carpal-button-face
+ gnus-mouse-face-prop 'highlight))))
+ (let ((fill-column (- (window-width) 2)))
+ (fill-region (point-min) (point-max)))
+ (set-window-point (get-buffer-window (current-buffer))
+ (point-min)))))))
+
+(defun gnus-carpal-select ()
+ "Select the button under point."
+ (interactive)
+ (let ((func (get-text-property (point) 'gnus-callback)))
+ (if (null func)
+ ()
+ (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
+ (call-interactively func))))
+
+(defun gnus-carpal-mouse-select (event)
+ "Select the button under the mouse pointer."
+ (interactive "e")
+ (mouse-set-point event)
+ (gnus-carpal-select))
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
(if (> (length val) ,cut)
,(if (< cut-width 0)
`(substring val 0 (- (length val) ,cut))
- `(substring va 0 ,cut))
+ `(substring val 0 ,cut))
val)))))
(defun gnus-tilde-ignore-form (el ignore-value)
;; SPEC-ALIST and returns a list that can be eval'ed to return a
;; string.
(let ((max-width 0)
- spec flist fstring newspec elem beg result dontinsert user-defined
- type spec value pad-width spec-beg cut-width ignore-value
+ spec flist fstring elem result dontinsert user-defined
+ type value pad-width spec-beg cut-width ignore-value
tilde-form tilde elem-type)
(save-excursion
(gnus-set-work-buffer)
(setq pad-width value))
((eq type 'pad-right)
(setq pad-width (- value)))
- ((eq type 'max)
+ ((memq type '(max-right max))
(setq max-width value))
+ ((eq type 'max-left)
+ (setq max-width (- value)))
((memq type '(cut cut-left))
(setq cut-width value))
((eq type 'cut-right)
"Byte-compile the user-defined format specs."
(interactive)
(let ((entries gnus-format-specs)
+ (byte-compile-warnings '(unresolved callargs redefine))
entry gnus-tmp-func)
(save-excursion
(gnus-message 7 "Compiling format specs...")
(setq gnus-format-specs (delq entry gnus-format-specs))
(when (and (listp (caddr entry))
(not (eq 'byte-code (caaddr entry))))
- (fset 'gnus-tmp-func
- `(lambda () ,(caddr entry)))
+ (fset 'gnus-tmp-func `(lambda () ,(caddr entry)))
(byte-compile 'gnus-tmp-func)
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
"*Hook run after the creation of the server mode menu.")
(defun gnus-server-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'server)
+ (gnus-turn-off-edit-menu 'server)
(unless (boundp 'gnus-server-server-menu)
(easy-menu-define
gnus-server-server-menu gnus-server-mode-map ""
["Open" gnus-server-open-server t]
["Close" gnus-server-close-server t]
["Deny" gnus-server-deny-server t]
- ["Reset" gnus-server-remove-denials t]
+ "---"
+ ["Open All" gnus-server-open-all-servers t]
+ ["Close All" gnus-server-close-all-servers t]
+ ["Reset All" gnus-server-remove-denials t]
))
(run-hooks 'gnus-server-menu-hook)))
"e" gnus-server-edit-server
"O" gnus-server-open-server
+ "M-o" gnus-server-open-all-servers
"C" gnus-server-close-server
+ "M-c" gnus-server-close-all-servers
"D" gnus-server-deny-server
"R" gnus-server-remove-denials
(gnus-server-update-server server)
(gnus-server-position-point))))
+(defun gnus-server-open-all-servers ()
+ "Open all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-open-server (car (pop servers))))))
+
(defun gnus-server-close-server (server)
"Close SERVER."
(interactive (list (gnus-server-server-name)))
(gnus-server-update-server server)
(gnus-server-position-point))))
+(defun gnus-server-close-all-servers ()
+ "Close all servers."
+ (interactive)
+ (let ((servers gnus-inserted-opened-servers))
+ (while servers
+ (gnus-server-close-server (car (pop servers))))))
+
(defun gnus-server-deny-server (server)
"Make sure SERVER will never be attempted opened."
(interactive (list (gnus-server-server-name)))
"\C-c\C-i" gnus-info-find-node))
(defun gnus-browse-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'browse)
- (or
- (boundp 'gnus-browse-menu)
- (progn
- (easy-menu-define
- gnus-browse-menu gnus-browse-mode-map ""
- '("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
- ["Read" gnus-browse-read-group t]
- ["Select" gnus-browse-read-group t]
- ["Next" gnus-browse-next-group t]
- ["Prev" gnus-browse-next-group t]
- ["Exit" gnus-browse-exit t]
- ))
- (run-hooks 'gnus-browse-menu-hook))))
+ (gnus-turn-off-edit-menu 'browse)
+ (unless (boundp 'gnus-browse-menu)
+ (easy-menu-define
+ gnus-browse-menu gnus-browse-mode-map ""
+ '("Browse"
+ ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Read" gnus-browse-read-group t]
+ ["Select" gnus-browse-read-group t]
+ ["Next" gnus-browse-next-group t]
+ ["Prev" gnus-browse-next-group t]
+ ["Exit" gnus-browse-exit t]
+ ))
+ (run-hooks 'gnus-browse-menu-hook)))
(defvar gnus-browse-current-method nil)
(defvar gnus-browse-return-buffer nil)
(defvar gnus-activate-level (1+ gnus-level-subscribed)
"*Groups higher than this level won't be activated on startup.
-Setting this variable to something log might save lots of time when
+Setting this variable to something low might save lots of time when
you have many groups that you aren't interested in.")
(defvar gnus-activate-foreign-newsgroups 4
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer.")
+(defvar gnus-summary-menu-hook nil
+ "*Hook run after the creation of the summary mode menu.")
+
(defvar gnus-summary-exit-hook nil
"*A hook called on exit from the summary buffer.")
"s" gnus-soup-add-article)
)
+(defun gnus-summary-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'summary)
+
+ (unless (boundp 'gnus-summary-misc-menu)
+
+ (easy-menu-define
+ gnus-summary-kill-menu gnus-summary-mode-map ""
+ (cons
+ "Score"
+ (nconc
+ (list
+ ["Enter score..." gnus-summary-score-entry t])
+ (gnus-make-score-map 'increase)
+ (gnus-make-score-map 'lower)
+ '(("Mark"
+ ["Kill below" gnus-summary-kill-below t]
+ ["Mark above" gnus-summary-mark-above t]
+ ["Tick above" gnus-summary-tick-above t]
+ ["Clear above" gnus-summary-clear-above t])
+ ["Current score" gnus-summary-current-score t]
+ ["Set score" gnus-summary-set-score t]
+ ["Customize score file" gnus-score-customize t]
+ ["Switch current score file..." gnus-score-change-score-file t]
+ ["Set mark below..." gnus-score-set-mark-below t]
+ ["Set expunge below..." gnus-score-set-expunge-below t]
+ ["Edit current score file" gnus-score-edit-current-scores t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t]
+ ["Find words" gnus-score-find-favuorite-words t]
+ ["Rescore buffer" gnus-summary-rescore t]
+ ["Increase score..." gnus-summary-increase-score t]
+ ["Lower score..." gnus-summary-lower-score t]))))
+
+ '(("Default header"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
+ :style radio
+ :selected (null gnus-score-default-header)]
+ ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
+ :style radio
+ :selected (eq gnus-score-default-header 'a)]
+ ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
+ :style radio
+ :selected (eq gnus-score-default-header 's)]
+ ["Article body"
+ (gnus-score-set-default 'gnus-score-default-header 'b)
+ :style radio
+ :selected (eq gnus-score-default-header 'b )]
+ ["All headers"
+ (gnus-score-set-default 'gnus-score-default-header 'h)
+ :style radio
+ :selected (eq gnus-score-default-header 'h )]
+ ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
+ :style radio
+ :selected (eq gnus-score-default-header 'i )]
+ ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
+ :style radio
+ :selected (eq gnus-score-default-header 't )]
+ ["Crossposting"
+ (gnus-score-set-default 'gnus-score-default-header 'x)
+ :style radio
+ :selected (eq gnus-score-default-header 'x )]
+ ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
+ :style radio
+ :selected (eq gnus-score-default-header 'l )]
+ ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
+ :style radio
+ :selected (eq gnus-score-default-header 'd )]
+ ["Followups to author"
+ (gnus-score-set-default 'gnus-score-default-header 'f)
+ :style radio
+ :selected (eq gnus-score-default-header 'f )])
+ ("Default type"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
+ :style radio
+ :selected (null gnus-score-default-type)]
+ ;; The `:active' key is commented out in the following,
+ ;; because the GNU Emacs hack to support radio buttons use
+ ;; active to indicate which button is selected.
+ ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 's)]
+ ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'r)]
+ ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'e)]
+ ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'f)]
+ ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'b)]
+ ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'n)]
+ ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'a)]
+ ["Less than number"
+ (gnus-score-set-default 'gnus-score-default-type '<)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '<)]
+ ["Equal to number"
+ (gnus-score-set-default 'gnus-score-default-type '=)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '=)]
+ ["Greater than number"
+ (gnus-score-set-default 'gnus-score-default-type '>)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '>)])
+ ["Default fold" gnus-score-default-fold-toggle
+ :style toggle
+ :selected gnus-score-default-fold]
+ ("Default duration"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
+ :style radio
+ :selected (null gnus-score-default-duration)]
+ ["Permanent"
+ (gnus-score-set-default 'gnus-score-default-duration 'p)
+ :style radio
+ :selected (eq gnus-score-default-duration 'p)]
+ ["Temporary"
+ (gnus-score-set-default 'gnus-score-default-duration 't)
+ :style radio
+ :selected (eq gnus-score-default-duration 't)]
+ ["Immediate"
+ (gnus-score-set-default 'gnus-score-default-duration 'i)
+ :style radio
+ :selected (eq gnus-score-default-duration 'i)]))
+
+ (easy-menu-define
+ gnus-summary-article-menu gnus-summary-mode-map ""
+ '("Article"
+ ("Hide"
+ ["All" gnus-article-hide t]
+ ["Headers" gnus-article-hide-headers t]
+ ["Signature" gnus-article-hide-signature t]
+ ["Citation" gnus-article-hide-citation t]
+ ["PGP" gnus-article-hide-pgp t]
+ ["Boring headers" gnus-article-hide-boring-headers t])
+ ("Highlight"
+ ["All" gnus-article-highlight t]
+ ["Headers" gnus-article-highlight-headers t]
+ ["Signature" gnus-article-highlight-signature t]
+ ["Citation" gnus-article-highlight-citation t])
+ ("Date"
+ ["Local" gnus-article-date-local t]
+ ["UT" gnus-article-date-ut t]
+ ["Original" gnus-article-date-original t]
+ ["Lapsed" gnus-article-date-lapsed t])
+ ("Filter"
+ ["Overstrike" gnus-article-treat-overstrike t]
+ ["Emphasis" gnus-article-emphasize t]
+ ["Word wrap" gnus-article-fill-cited-article t]
+ ["CR" gnus-article-remove-cr t]
+ ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
+ ["Show X-Face" gnus-article-display-x-face t]
+ ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["Rot 13" gnus-summary-caesar-message t]
+ ["Add buttons" gnus-article-add-buttons t]
+ ["Add buttons to head" gnus-article-add-buttons-to-head t]
+ ["Stop page breaking" gnus-summary-stop-page-breaking t]
+ ["Toggle MIME" gnus-summary-toggle-mime t]
+ ["Verbose header" gnus-summary-verbose-headers t]
+ ["Toggle header" gnus-summary-toggle-header t])
+ ("Output"
+ ["Save in default format" gnus-summary-save-article t]
+ ["Save in file" gnus-summary-save-article-file t]
+ ["Save in Unix mail format" gnus-summary-save-article-mail t]
+ ["Save in MH folder" gnus-summary-save-article-folder t]
+ ["Save in VM folder" gnus-summary-save-article-vm t]
+ ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
+ ["Save body in file" gnus-summary-save-article-body-file t]
+ ["Pipe through a filter" gnus-summary-pipe-output t]
+ ["Add to SOUP packet" gnus-soup-add-article t])
+ ("Backend"
+ ["Respool article..." gnus-summary-respool-article t]
+ ["Move article..." gnus-summary-move-article
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)]
+ ["Copy article..." gnus-summary-copy-article t]
+ ["Crosspost article..." gnus-summary-crosspost-article
+ (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)]
+ ["Import file..." gnus-summary-import-article t]
+ ["Edit article" gnus-summary-edit-article
+ (not (gnus-group-read-only-p))]
+ ["Delete article" gnus-summary-delete-article
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Query respool" gnus-summary-respool-query t]
+ ["Delete expirable articles" gnus-summary-expire-articles-now
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)])
+ ("Extract"
+ ["Uudecode" gnus-uu-decode-uu t]
+ ["Uudecode and save" gnus-uu-decode-uu-and-save t]
+ ["Unshar" gnus-uu-decode-unshar t]
+ ["Unshar and save" gnus-uu-decode-unshar-and-save t]
+ ["Save" gnus-uu-decode-save t]
+ ["Binhex" gnus-uu-decode-binhex t]
+ ["Postscript" gnus-uu-decode-postscript t])
+ ["Enter digest buffer" gnus-summary-enter-digest-group t]
+ ["Isearch article..." gnus-summary-isearch-article t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward t]
+ ["Beginning of the article" gnus-summary-beginning-of-article t]
+ ["End of the article" gnus-summary-end-of-article t]
+ ["Fetch parent of article" gnus-summary-refer-parent-article t]
+ ["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch article with id..." gnus-summary-refer-article t]
+ ["Redisplay" gnus-summary-show-article t]))
+
+ (easy-menu-define
+ gnus-summary-thread-menu gnus-summary-mode-map ""
+ '("Threads"
+ ["Toggle threading" gnus-summary-toggle-threads t]
+ ["Hide threads" gnus-summary-hide-all-threads t]
+ ["Show threads" gnus-summary-show-all-threads t]
+ ["Hide thread" gnus-summary-hide-thread t]
+ ["Show thread" gnus-summary-show-thread t]
+ ["Go to next thread" gnus-summary-next-thread t]
+ ["Go to previous thread" gnus-summary-prev-thread t]
+ ["Go down thread" gnus-summary-down-thread t]
+ ["Go up thread" gnus-summary-up-thread t]
+ ["Top of thread" gnus-summary-top-thread t]
+ ["Mark thread as read" gnus-summary-kill-thread t]
+ ["Lower thread score" gnus-summary-lower-thread t]
+ ["Raise thread score" gnus-summary-raise-thread t]
+ ["Rethread current" gnus-summary-rethread-current t]
+ ))
+
+ (easy-menu-define
+ gnus-summary-post-menu gnus-summary-mode-map ""
+ '("Post"
+ ["Post an article" gnus-summary-post-news t]
+ ["Followup" gnus-summary-followup t]
+ ["Followup and yank" gnus-summary-followup-with-original t]
+ ["Supersede article" gnus-summary-supersede-article t]
+ ["Cancel article" gnus-summary-cancel-article t]
+ ["Reply" gnus-summary-reply t]
+ ["Reply and yank" gnus-summary-reply-with-original t]
+ ["Mail forward" gnus-summary-mail-forward t]
+ ["Post forward" gnus-summary-post-forward t]
+ ["Digest and mail" gnus-uu-digest-mail-forward t]
+ ["Digest and post" gnus-uu-digest-post-forward t]
+ ["Resend message" gnus-summary-resend-message t]
+ ["Send bounced mail" gnus-summary-resend-bounced-mail t]
+ ["Send a mail" gnus-summary-mail-other-window t]
+ ["Uuencode and post" gnus-uu-post-news t]
+ ;;("Draft"
+ ;;["Send" gnus-summary-send-draft t]
+ ;;["Send bounced" gnus-resend-bounced-mail t])
+ ))
+
+ (easy-menu-define
+ gnus-summary-misc-menu gnus-summary-mode-map ""
+ '("Misc"
+ ("Mark"
+ ("Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup t]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read t]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Limit"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Score" gnus-summary-limit-to-score t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Show expunged" gnus-summary-show-all-expunged t])
+ ("Process mark"
+ ["Set mark" gnus-summary-mark-as-processable t]
+ ["Remove mark" gnus-summary-unmark-as-processable t]
+ ["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region t]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]))
+ ("Scroll article"
+ ["Page forward" gnus-summary-next-page t]
+ ["Page backward" gnus-summary-prev-page t]
+ ["Line forward" gnus-summary-scroll-up t])
+ ("Move"
+ ["Next unread article" gnus-summary-next-unread-article t]
+ ["Previous unread article" gnus-summary-prev-unread-article t]
+ ["Next article" gnus-summary-next-article t]
+ ["Previous article" gnus-summary-prev-article t]
+ ["Next unread subject" gnus-summary-next-unread-subject t]
+ ["Previous unread subject" gnus-summary-prev-unread-subject t]
+ ["Next article same subject" gnus-summary-next-same-subject t]
+ ["Previous article same subject" gnus-summary-prev-same-subject t]
+ ["First unread article" gnus-summary-first-unread-article t]
+ ["Best unread article" gnus-summary-best-unread-article t]
+ ["Go to subject number..." gnus-summary-goto-subject t]
+ ["Go to article number..." gnus-summary-goto-article t]
+ ["Go to the last article" gnus-summary-goto-last-article t]
+ ["Pop article off history" gnus-summary-pop-article t])
+ ("Sort"
+ ["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by author" gnus-summary-sort-by-author t]
+ ["Sort by subject" gnus-summary-sort-by-subject t]
+ ["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by score" gnus-summary-sort-by-score t])
+ ("Help"
+ ["Fetch group FAQ" gnus-summary-fetch-faq t]
+ ["Describe group" gnus-summary-describe-group t]
+ ["Read manual" gnus-info-find-node t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
+ ("Modes"
+ ["Pick and read" gnus-pick-mode t]
+ ["Binary" gnus-binary-mode t])
+ ["Filter articles..." gnus-summary-execute-command t]
+ ["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Toggle line truncation" gnus-summary-toggle-truncation t]
+ ["Expand window" gnus-summary-expand-window t]
+ ["Expire expirable articles" gnus-summary-expire-articles
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Edit local kill file" gnus-summary-edit-local-kill t]
+ ["Edit main kill file" gnus-summary-edit-global-kill t]
+ ("Exit"
+ ["Catchup and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup all and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Exit group" gnus-summary-exit t]
+ ["Exit group without updating" gnus-summary-exit-no-update t]
+ ["Exit and goto next group" gnus-summary-next-group t]
+ ["Exit and goto prev group" gnus-summary-prev-group t]
+ ["Reselect group" gnus-summary-reselect-current-group t]
+ ["Rescan group" gnus-summary-rescan-group t])))
+
+ (run-hooks 'gnus-summary-menu-hook)))
+
+(defun gnus-score-set-default (var value)
+ "A version of set that updates the GNU Emacs menu-bar."
+ (set var value)
+ ;; It is the message that forces the active status to be updated.
+ (message ""))
+
+(defun gnus-make-score-map (type)
+ "Make a summary score map of type TYPE."
+ (if t
+ nil
+ (let ((headers '(("author" "from" string)
+ ("subject" "subject" string)
+ ("article body" "body" string)
+ ("article head" "head" string)
+ ("xref" "xref" string)
+ ("lines" "lines" number)
+ ("followups to author" "followup" string)))
+ (types '((number ("less than" <)
+ ("greater than" >)
+ ("equal" =))
+ (string ("substring" s)
+ ("exact string" e)
+ ("fuzzy string" f)
+ ("regexp" r))))
+ (perms '(("temporary" (current-time-string))
+ ("permanent" nil)
+ ("immediate" now)))
+ header)
+ (list
+ (apply
+ 'nconc
+ (list
+ (if (eq type 'lower)
+ "Lower score"
+ "Increase score"))
+ (let (outh)
+ (while headers
+ (setq header (car headers))
+ (setq outh
+ (cons
+ (apply
+ 'nconc
+ (list (car header))
+ (let ((ts (cdr (assoc (nth 2 header) types)))
+ outt)
+ (while ts
+ (setq outt
+ (cons
+ (apply
+ 'nconc
+ (list (caar ts))
+ (let ((ps perms)
+ outp)
+ (while ps
+ (setq outp
+ (cons
+ (vector
+ (caar ps)
+ (list
+ 'gnus-summary-score-entry
+ (nth 1 header)
+ (if (or (string= (nth 1 header)
+ "head")
+ (string= (nth 1 header)
+ "body"))
+ ""
+ (list 'gnus-summary-header
+ (nth 1 header)))
+ (list 'quote (nth 1 (car ts)))
+ (list 'gnus-score-default nil)
+ (nth 1 (car ps))
+ t)
+ t)
+ outp))
+ (setq ps (cdr ps)))
+ (list (nreverse outp))))
+ outt))
+ (setq ts (cdr ts)))
+ (list (nreverse outt))))
+ outh))
+ (setq headers (cdr headers)))
+ (list (nreverse outh))))))))
+
\f
(defun gnus-summary-mode (&optional group)
(when (cdr headers)
(setcdr headers (cddr headers))))))
+;;;
+;;; summary highlights
+;;;
+
+(defun gnus-highlight-selected-summary ()
+ ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+ ;; Highlight selected article in summary buffer
+ (when gnus-summary-selected-face
+ (save-excursion
+ (let* ((beg (progn (beginning-of-line) (point)))
+ (end (progn (end-of-line) (point)))
+ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
+ (from (if (get-text-property beg gnus-mouse-face-prop)
+ beg
+ (1+ (or (next-single-property-change
+ beg gnus-mouse-face-prop nil end)
+ beg))))
+ (to
+ (if (= from end)
+ (- from 2)
+ (1- (or (next-single-property-change
+ from gnus-mouse-face-prop nil end)
+ end)))))
+ ;; If no mouse-face prop on line we will have to = from = end,
+ ;; so we highlight the entire line instead.
+ (when (= (+ to 2) from)
+ (setq from beg)
+ (setq to end))
+ (if gnus-newsgroup-selected-overlay
+ ;; Move old overlay.
+ (gnus-move-overlay
+ gnus-newsgroup-selected-overlay from to (current-buffer))
+ ;; Create new overlay.
+ (gnus-overlay-put
+ (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
+ 'face gnus-summary-selected-face))))))
+
+;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
+(defun gnus-summary-highlight-line ()
+ "Highlight current line according to `gnus-summary-highlight'."
+ (let* ((list gnus-summary-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (article (gnus-summary-article-number))
+ (score (or (cdr (assq (or article gnus-current-article)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
+ (mark (or (gnus-summary-article-mark) gnus-unread-mark))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (let ((default gnus-summary-default-score))
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list))))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (when gnus-summary-highlight-line-function
+ (funcall gnus-summary-highlight-line-function article face))))
+ (goto-char p)))
+
(provide 'gnus-sum)
;;; gnus-sum.el ends here
,(gnus-make-sort-function (cdr funs))))
`(,(car funs) t1 t2)))
+(defun gnus-turn-off-edit-menu (type)
+ "Turn off edit meny in `gnus-TYPE-mode-map'."
+ (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
+ [menu-bar edit] 'undefined))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
-;;; gnus-vis.el --- display-oriented parts of Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'gnus-load)
-(require 'gnus-ems)
-(require 'easymenu)
-(require 'custom)
-(require 'browse-url)
-(require 'gnus-score)
-(require 'gnus-art)
-(require 'gnus-group)
-(require 'gnus-range)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-group-menu-hook nil
- "*Hook run after the creation of the group mode menu.")
-
-(defvar gnus-summary-menu-hook nil
- "*Hook run after the creation of the summary mode menu.")
-
-(defvar gnus-article-menu-hook nil
- "*Hook run after the creation of the article mode menu.")
-
-;;; Summary highlights.
-
-;(defvar gnus-summary-highlight-properties
-; '((unread "ForestGreen" "green")
-; (ticked "Firebrick" "pink")
-; (read "black" "white")
-; (low italic italic)
-; (high bold bold)
-; (canceled "yellow/black" "black/yellow")))
-
-;(defvar gnus-summary-highlight-translation
-; '(((unread (= mark gnus-unread-mark))
-; (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
-; (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
-; (canceled (= mark gnus-canceled-mark)))
-; ((low (< score gnus-summary-default-score))
-; (high (> score gnus-summary-default-score)))))
-
-;(defun gnus-visual-map-face-translation ()
-; (let ((props gnus-summary-highlight-properties)
-; (trans gnus-summary-highlight-translation)
-; map)
-; (while props)))
-
-;see gnus-cus.el
-;(defvar gnus-summary-selected-face 'underline
-; "*Face used for highlighting the current article in the summary buffer.")
-
-;see gnus-cus.el
-;(defvar gnus-summary-highlight
-; (cond ((not (eq gnus-display-type 'color))
-; '(((> score default) . bold)
-; ((< score default) . italic)))
-; ((eq gnus-background-mode 'dark)
-; (list (cons '(= mark gnus-canceled-mark)
-; (custom-face-lookup "yellow" "black" nil nil nil nil))
-; (cons '(and (> score default)
-; (or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark)))
-; (custom-face-lookup "pink" nil nil t nil nil))
-; (cons '(and (< score default)
-; (or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark)))
-; (custom-face-lookup "pink" nil nil nil t nil))
-; (cons '(or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark))
-; (custom-face-lookup "pink" nil nil nil nil nil))
-
-; (cons '(and (> score default) (= mark gnus-ancient-mark))
-; (custom-face-lookup "SkyBlue" nil nil t nil nil))
-; (cons '(and (< score default) (= mark gnus-ancient-mark))
-; (custom-face-lookup "SkyBlue" nil nil nil t nil))
-; (cons '(= mark gnus-ancient-mark)
-; (custom-face-lookup "SkyBlue" nil nil nil nil nil))
-
-; (cons '(and (> score default) (= mark gnus-unread-mark))
-; (custom-face-lookup "white" nil nil t nil nil))
-; (cons '(and (< score default) (= mark gnus-unread-mark))
-; (custom-face-lookup "white" nil nil nil t nil))
-; (cons '(= mark gnus-unread-mark)
-; (custom-face-lookup "white" nil nil nil nil nil))
-
-; (cons '(> score default) 'bold)
-; (cons '(< score default) 'italic)))
-; (t
-; (list (cons '(= mark gnus-canceled-mark)
-; (custom-face-lookup "yellow" "black" nil nil nil nil))
-; (cons '(and (> score default)
-; (or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark)))
-; (custom-face-lookup "firebrick" nil nil t nil nil))
-; (cons '(and (< score default)
-; (or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark)))
-; (custom-face-lookup "firebrick" nil nil nil t nil))
-; (cons '(or (= mark gnus-dormant-mark)
-; (= mark gnus-ticked-mark))
-; (custom-face-lookup "firebrick" nil nil nil nil nil))
-
-; (cons '(and (> score default) (= mark gnus-ancient-mark))
-; (custom-face-lookup "RoyalBlue" nil nil t nil nil))
-; (cons '(and (< score default) (= mark gnus-ancient-mark))
-; (custom-face-lookup "RoyalBlue" nil nil nil t nil))
-; (cons '(= mark gnus-ancient-mark)
-; (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
-
-; (cons '(and (> score default) (/= mark gnus-unread-mark))
-; (custom-face-lookup "DarkGreen" nil nil t nil nil))
-; (cons '(and (< score default) (/= mark gnus-unread-mark))
-; (custom-face-lookup "DarkGreen" nil nil nil t nil))
-; (cons '(/= mark gnus-unread-mark)
-; (custom-face-lookup "DarkGreen" nil nil nil nil nil))
-
-; (cons '(> score default) 'bold)
-; (cons '(< score default) 'italic))))
-; "*Alist of `(FORM . FACE)'.
-;Summary lines are highlighted with the FACE for the first FORM which
-;evaluate to a non-nil value.
-
-;Point will be at the beginning of the line when FORM is evaluated.
-;The following can be used for convenience:
-
-;score: (gnus-summary-article-score)
-;default: gnus-summary-default-score
-;below: gnus-summary-mark-below
-;mark: (gnus-summary-article-mark)
-
-;The latter can be used like this:
-; ((= mark gnus-replied-mark) . underline)")
-
-;;; article highlights
-
-;see gnus-cus.el
-;(defvar gnus-header-face-alist
-; (cond ((not (eq gnus-display-type 'color))
-; '(("" bold italic)))
-; ((eq gnus-background-mode 'dark)
-; (list (list "From" nil
-; (custom-face-lookup "SkyBlue" nil nil t t nil))
-; (list "Subject" nil
-; (custom-face-lookup "pink" nil nil t t nil))
-; (list "Newsgroups:.*," nil
-; (custom-face-lookup "yellow" nil nil t t nil))
-; (list ""
-; (custom-face-lookup "cyan" nil nil t nil nil)
-; (custom-face-lookup "green" nil nil nil t nil))))
-; (t
-; (list (list "From" nil
-; (custom-face-lookup "RoyalBlue" nil nil t t nil))
-; (list "Subject" nil
-; (custom-face-lookup "firebrick" nil nil t t nil))
-; (list "Newsgroups:.*," nil
-; (custom-face-lookup "red" nil nil t t nil))
-; (list ""
-; (custom-face-lookup "DarkGreen" nil nil t nil nil)
-; (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
-; "Alist of headers and faces used for highlighting them.
-;The entries in the list has the form `(REGEXP NAME CONTENT)', where
-;REGEXP is a regular expression matching the beginning of the header,
-;NAME is the face used for highlighting the header name and CONTENT is
-;the face used for highlighting the header content.
-
-;The first non-nil NAME or CONTENT with a matching REGEXP in the list
-;will be used.")
-
-
-;see gnus-cus.el
-;(defvar gnus-make-foreground t
-; "Non nil means foreground color to highlight citations.")
-
-;see gnus-cus.el
-;(defvar gnus-article-button-face 'bold
-; "Face used for text buttons.")
-
-;see gnus-cus.el
-;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
-; gnus-mouse-face
-; 'highlight)
-; "Face used when the mouse is over the button.")
-
-;see gnus-cus.el
-;(defvar gnus-signature-face 'italic
-; "Face used for signature.")
-
-(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]"
- "*Regular expression that matches URLs.")
-
-(defvar gnus-button-alist
- `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
- t gnus-button-message-id 3)
- ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
- gnus-button-message-id 3)
- ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
- ;; This is how URLs _should_ be embedded in text...
- ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
- ;; Next regexp stolen from highlight-headers.el.
- ;; Modified by Vladimir Alexiev.
- (,gnus-button-url-regexp 0 t gnus-button-url 0))
- "Alist of regexps matching buttons in article bodies.
-
-Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button,
-BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a lisp expression which must eval to true for the button to
-be added,
-CALLBACK: is the function to call when the user push this button, and each
-PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
-
-CALLBACK can also be a variable, in that case the value of that
-variable it the real callback function.")
-
-(defvar gnus-header-button-alist
- `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
- 0 t gnus-button-message-id 0)
- ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
- ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
- 0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
- ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
- ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
- gnus-button-message-id 3))
- "Alist of headers and regexps to match buttons in article heads.
-
-This alist is very similar to `gnus-button-alist', except that each
-alist has an additional HEADER element first in each entry:
-
-\(HEADER REGEXP BUTTON FORM CALLBACK PAR)
-
-HEADER is a regexp to match a header. For a fuller explanation, see
-`gnus-button-alist'.")
-
-;see gnus-cus.el
-;(eval-when-compile
-; (defvar browse-url-browser-function))
-
-;;; Group mode highlighting.
-
-;see gnus-cus.el
-;(defvar gnus-group-highlight nil
-; "Group lines are highlighted with the FACE for the first FORM which
-;evaluate to a non-nil value.
-;
-;Point will be at the beginning of the line when FORM is evaluated.
-;Variables bound when these forms are evaluated include:
-;
-;group: The group name.
-;unread: The number of unread articles.
-;method: The select method.
-;mailp: Whether the select method is a mail method.
-;level: The level of the group.
-;score: The score of the group.
-;ticked: The number of ticked articles in the group.
-;")
-
-
-;;; Internal variables.
-
-(defvar gnus-button-marker-list nil)
-
-\f
-
-(eval-and-compile
- (autoload 'nnkiboze-generate-groups "nnkiboze")
- (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
-
-;;;
-;;; gnus-menu
-;;;
-
-(defun gnus-visual-turn-off-edit-menu (type)
- (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
- [menu-bar edit] 'undefined))
-
-;; Newsgroup buffer
-
-(defun gnus-group-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'group)
- (unless (boundp 'gnus-group-reading-menu)
-
- (easy-menu-define
- gnus-group-reading-menu gnus-group-mode-map ""
- '("Group"
- ["Read" gnus-group-read-group (gnus-group-group-name)]
- ["Select" gnus-group-select-group (gnus-group-group-name)]
- ["See old articles" (gnus-group-select-group 'all)
- :keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
- ["Catch up all articles" gnus-group-catchup-current-all
- (gnus-group-group-name)]
- ["Check for new articles" gnus-group-get-new-news-this-group
- (gnus-group-group-name)]
- ["Toggle subscription" gnus-group-unsubscribe-current-group
- (gnus-group-group-name)]
- ["Kill" gnus-group-kill-group (gnus-group-group-name)]
- ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
- ["Describe" gnus-group-describe-group (gnus-group-group-name)]
- ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
- ["Edit kill file" gnus-group-edit-local-kill
- (gnus-group-group-name)]
- ;; Actually one should check, if any of the marked groups gives t for
- ;; (gnus-check-backend-function 'request-expire-articles ...)
- ["Expire articles" gnus-group-expire-articles
- (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
- ["Set group level" gnus-group-set-current-level
- (gnus-group-group-name)]
- ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
- ))
-
- (easy-menu-define
- gnus-group-group-menu gnus-group-mode-map ""
- '("Groups"
- ("Listing"
- ["List unread subscribed groups" gnus-group-list-groups t]
- ["List (un)subscribed groups" gnus-group-list-all-groups t]
- ["List killed groups" gnus-group-list-killed gnus-killed-list]
- ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
- ["List level..." gnus-group-list-level t]
- ["Describe all groups" gnus-group-describe-all-groups t]
- ["Group apropos..." gnus-group-apropos t]
- ["Group and description apropos..." gnus-group-description-apropos t]
- ["List groups matching..." gnus-group-list-matching t]
- ["List all groups matching..." gnus-group-list-all-matching t]
- ["List active file" gnus-group-list-active t])
- ("Sort"
- ["Default sort" gnus-group-sort-groups
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by method" gnus-group-sort-groups-by-method
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by rank" gnus-group-sort-groups-by-rank
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by score" gnus-group-sort-groups-by-score
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by level" gnus-group-sort-groups-by-level
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by unread" gnus-group-sort-groups-by-unread
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
- ["Sort by name" gnus-group-sort-groups-by-alphabet
- (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
- ("Mark"
- ["Mark group" gnus-group-mark-group
- (and (gnus-group-group-name)
- (not (memq (gnus-group-group-name) gnus-group-marked)))]
- ["Unmark group" gnus-group-unmark-group
- (and (gnus-group-group-name)
- (memq (gnus-group-group-name) gnus-group-marked))]
- ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
- ["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region t]
- ["Mark buffer" gnus-group-mark-buffer t]
- ["Execute command" gnus-group-universal-argument
- (or gnus-group-marked (gnus-group-group-name))])
- ("Subscribe"
- ["Subscribe to a group" gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region t]
- ["Kill all zombie groups" gnus-group-kill-all-zombies
- gnus-zombie-list]
- ["Kill all groups on level..." gnus-group-kill-level t])
- ("Foreign groups"
- ["Make a foreign group" gnus-group-make-group t]
- ["Add a directory group" gnus-group-make-directory-group t]
- ["Add the help group" gnus-group-make-help-group t]
- ["Add the archive group" gnus-group-make-archive-group t]
- ["Make a doc group" gnus-group-make-doc-group t]
- ["Make a kiboze group" gnus-group-make-kiboze-group t]
- ["Make a virtual group" gnus-group-make-empty-virtual t]
- ["Add a group to a virtual" gnus-group-add-to-virtual t]
- ["Rename group" gnus-group-rename-group
- (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))]
- ["Delete group" gnus-group-delete-group
- (gnus-check-backend-function
- 'request-delete-group (gnus-group-group-name))])
- ("Editing groups"
- ["Parameters" gnus-group-edit-group-parameters
- (gnus-group-group-name)]
- ["Select method" gnus-group-edit-group-method
- (gnus-group-group-name)]
- ["Info" gnus-group-edit-group (gnus-group-group-name)])
- ("Score file"
- ["Flush cache" gnus-score-flush-cache
- (or gnus-score-cache gnus-short-name-score-file-cache)])
- ("Move"
- ["Next" gnus-group-next-group t]
- ["Previous" gnus-group-prev-group t]
- ["Next unread" gnus-group-next-unread-group t]
- ["Previous unread" gnus-group-prev-unread-group t]
- ["Next unread same level" gnus-group-next-unread-group-same-level t]
- ["Previous unread same level"
- gnus-group-previous-unread-group-same-level t]
- ["Jump to group" gnus-group-jump-to-group t]
- ["First unread group" gnus-group-first-unread-group t]
- ["Best unread group" gnus-group-best-unread-group t])
- ["Transpose" gnus-group-transpose-groups
- (gnus-group-group-name)]
- ["Read a directory as a group..." gnus-group-enter-directory t]
- ))
-
- (easy-menu-define
- gnus-group-misc-menu gnus-group-mode-map ""
- '("Misc"
- ["Send a bug report" gnus-bug t]
- ["Send a mail" gnus-group-mail t]
- ["Post an article..." gnus-group-post-news t]
- ["Customize score file" gnus-score-customize t]
- ["Check for new news" gnus-group-get-new-news t]
- ["Activate all groups" gnus-activate-all-groups t]
- ["Delete bogus groups" gnus-group-check-bogus-groups t]
- ["Find new newsgroups" gnus-find-new-newsgroups t]
- ["Restart Gnus" gnus-group-restart t]
- ["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server" gnus-group-browse-foreign-server t]
- ["Enter server buffer" gnus-group-enter-server-mode t]
- ["Expire all expirable articles" gnus-group-expire-all-groups t]
- ["Generate any kiboze groups" nnkiboze-generate-groups t]
- ["Gnus version" gnus-version t]
- ["Save .newsrc files" gnus-group-save-newsrc t]
- ["Suspend Gnus" gnus-group-suspend t]
- ["Clear dribble buffer" gnus-group-clear-dribble t]
- ["Edit global kill file" gnus-group-edit-global-kill t]
- ["Read manual" gnus-info-find-node t]
- ["Toggle topics" gnus-topic-mode t]
- ("SOUP"
- ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
- ["Send replies" gnus-soup-send-replies
- (fboundp 'gnus-soup-pack-packet)]
- ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
- ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
- ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
- ["Exit from Gnus" gnus-group-exit t]
- ["Exit without saving" gnus-group-quit t]
- ))
-
- (run-hooks 'gnus-group-menu-hook)
- ))
-
-;; Summary buffer
-(defun gnus-summary-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'summary)
-
- (unless (boundp 'gnus-summary-misc-menu)
-
- (easy-menu-define
- gnus-summary-kill-menu gnus-summary-mode-map ""
- (cons
- "Score"
- (nconc
- (list
- ["Enter score..." gnus-summary-score-entry t])
- (gnus-visual-score-map 'increase)
- (gnus-visual-score-map 'lower)
- '(("Mark"
- ["Kill below" gnus-summary-kill-below t]
- ["Mark above" gnus-summary-mark-above t]
- ["Tick above" gnus-summary-tick-above t]
- ["Clear above" gnus-summary-clear-above t])
- ["Current score" gnus-summary-current-score t]
- ["Set score" gnus-summary-set-score t]
- ["Customize score file" gnus-score-customize t]
- ["Switch current score file..." gnus-score-change-score-file t]
- ["Set mark below..." gnus-score-set-mark-below t]
- ["Set expunge below..." gnus-score-set-expunge-below t]
- ["Edit current score file" gnus-score-edit-current-scores t]
- ["Edit score file" gnus-score-edit-file t]
- ["Trace score" gnus-score-find-trace t]
- ["Find words" gnus-score-find-favuorite-words t]
- ["Rescore buffer" gnus-summary-rescore t]
- ["Increase score..." gnus-summary-increase-score t]
- ["Lower score..." gnus-summary-lower-score t]))))
-
- '(("Default header"
- ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
- :style radio
- :selected (null gnus-score-default-header)]
- ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
- :style radio
- :selected (eq gnus-score-default-header 'a)]
- ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
- :style radio
- :selected (eq gnus-score-default-header 's)]
- ["Article body"
- (gnus-score-set-default 'gnus-score-default-header 'b)
- :style radio
- :selected (eq gnus-score-default-header 'b )]
- ["All headers"
- (gnus-score-set-default 'gnus-score-default-header 'h)
- :style radio
- :selected (eq gnus-score-default-header 'h )]
- ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
- :style radio
- :selected (eq gnus-score-default-header 'i )]
- ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
- :style radio
- :selected (eq gnus-score-default-header 't )]
- ["Crossposting"
- (gnus-score-set-default 'gnus-score-default-header 'x)
- :style radio
- :selected (eq gnus-score-default-header 'x )]
- ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
- :style radio
- :selected (eq gnus-score-default-header 'l )]
- ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
- :style radio
- :selected (eq gnus-score-default-header 'd )]
- ["Followups to author"
- (gnus-score-set-default 'gnus-score-default-header 'f)
- :style radio
- :selected (eq gnus-score-default-header 'f )])
- ("Default type"
- ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
- :style radio
- :selected (null gnus-score-default-type)]
- ;; The `:active' key is commented out in the following,
- ;; because the GNU Emacs hack to support radio buttons use
- ;; active to indicate which button is selected.
- ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
- :style radio
- ;; :active (not (memq gnus-score-default-header '(l d)))
- :selected (eq gnus-score-default-type 's)]
- ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
- :style radio
- ;; :active (not (memq gnus-score-default-header '(l d)))
- :selected (eq gnus-score-default-type 'r)]
- ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
- :style radio
- ;; :active (not (memq gnus-score-default-header '(l d)))
- :selected (eq gnus-score-default-type 'e)]
- ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
- :style radio
- ;; :active (not (memq gnus-score-default-header '(l d)))
- :selected (eq gnus-score-default-type 'f)]
- ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
- :style radio
- ;; :active (eq (gnus-score-default-header 'd))
- :selected (eq gnus-score-default-type 'b)]
- ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
- :style radio
- ;; :active (eq (gnus-score-default-header 'd))
- :selected (eq gnus-score-default-type 'n)]
- ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
- :style radio
- ;; :active (eq (gnus-score-default-header 'd))
- :selected (eq gnus-score-default-type 'a)]
- ["Less than number"
- (gnus-score-set-default 'gnus-score-default-type '<)
- :style radio
- ;; :active (eq (gnus-score-default-header 'l))
- :selected (eq gnus-score-default-type '<)]
- ["Equal to number"
- (gnus-score-set-default 'gnus-score-default-type '=)
- :style radio
- ;; :active (eq (gnus-score-default-header 'l))
- :selected (eq gnus-score-default-type '=)]
- ["Greater than number"
- (gnus-score-set-default 'gnus-score-default-type '>)
- :style radio
- ;; :active (eq (gnus-score-default-header 'l))
- :selected (eq gnus-score-default-type '>)])
- ["Default fold" gnus-score-default-fold-toggle
- :style toggle
- :selected gnus-score-default-fold]
- ("Default duration"
- ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
- :style radio
- :selected (null gnus-score-default-duration)]
- ["Permanent"
- (gnus-score-set-default 'gnus-score-default-duration 'p)
- :style radio
- :selected (eq gnus-score-default-duration 'p)]
- ["Temporary"
- (gnus-score-set-default 'gnus-score-default-duration 't)
- :style radio
- :selected (eq gnus-score-default-duration 't)]
- ["Immediate"
- (gnus-score-set-default 'gnus-score-default-duration 'i)
- :style radio
- :selected (eq gnus-score-default-duration 'i)]))
-
- (easy-menu-define
- gnus-summary-article-menu gnus-summary-mode-map ""
- '("Article"
- ("Hide"
- ["All" gnus-article-hide t]
- ["Headers" gnus-article-hide-headers t]
- ["Signature" gnus-article-hide-signature t]
- ["Citation" gnus-article-hide-citation t]
- ["PGP" gnus-article-hide-pgp t]
- ["Boring headers" gnus-article-hide-boring-headers t])
- ("Highlight"
- ["All" gnus-article-highlight t]
- ["Headers" gnus-article-highlight-headers t]
- ["Signature" gnus-article-highlight-signature t]
- ["Citation" gnus-article-highlight-citation t])
- ("Date"
- ["Local" gnus-article-date-local t]
- ["UT" gnus-article-date-ut t]
- ["Original" gnus-article-date-original t]
- ["Lapsed" gnus-article-date-lapsed t])
- ("Filter"
- ["Overstrike" gnus-article-treat-overstrike t]
- ["Emphasis" gnus-article-emphasize t]
- ["Word wrap" gnus-article-fill-cited-article t]
- ["CR" gnus-article-remove-cr t]
- ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
- ["Show X-Face" gnus-article-display-x-face t]
- ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
- ["Rot 13" gnus-summary-caesar-message t]
- ["Add buttons" gnus-article-add-buttons t]
- ["Add buttons to head" gnus-article-add-buttons-to-head t]
- ["Stop page breaking" gnus-summary-stop-page-breaking t]
- ["Toggle MIME" gnus-summary-toggle-mime t]
- ["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
- ("Output"
- ["Save in default format" gnus-summary-save-article t]
- ["Save in file" gnus-summary-save-article-file t]
- ["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Save in MH folder" gnus-summary-save-article-folder t]
- ["Save in VM folder" gnus-summary-save-article-vm t]
- ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
- ["Save body in file" gnus-summary-save-article-body-file t]
- ["Pipe through a filter" gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t])
- ("Backend"
- ["Respool article..." gnus-summary-respool-article t]
- ["Move article..." gnus-summary-move-article
- (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)]
- ["Copy article..." gnus-summary-copy-article t]
- ["Crosspost article..." gnus-summary-crosspost-article
- (gnus-check-backend-function
- 'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article t]
- ["Edit article" gnus-summary-edit-article
- (not (gnus-group-read-only-p))]
- ["Delete article" gnus-summary-delete-article
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Query respool" gnus-summary-respool-query t]
- ["Delete expirable articles" gnus-summary-expire-articles-now
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)])
- ("Extract"
- ["Uudecode" gnus-uu-decode-uu t]
- ["Uudecode and save" gnus-uu-decode-uu-and-save t]
- ["Unshar" gnus-uu-decode-unshar t]
- ["Unshar and save" gnus-uu-decode-unshar-and-save t]
- ["Save" gnus-uu-decode-save t]
- ["Binhex" gnus-uu-decode-binhex t]
- ["Postscript" gnus-uu-decode-postscript t])
- ["Enter digest buffer" gnus-summary-enter-digest-group t]
- ["Isearch article..." gnus-summary-isearch-article t]
- ["Search articles forward..." gnus-summary-search-article-forward t]
- ["Search articles backward..." gnus-summary-search-article-backward t]
- ["Beginning of the article" gnus-summary-beginning-of-article t]
- ["End of the article" gnus-summary-end-of-article t]
- ["Fetch parent of article" gnus-summary-refer-parent-article t]
- ["Fetch referenced articles" gnus-summary-refer-references t]
- ["Fetch article with id..." gnus-summary-refer-article t]
- ["Redisplay" gnus-summary-show-article t]))
-
- (easy-menu-define
- gnus-summary-thread-menu gnus-summary-mode-map ""
- '("Threads"
- ["Toggle threading" gnus-summary-toggle-threads t]
- ["Hide threads" gnus-summary-hide-all-threads t]
- ["Show threads" gnus-summary-show-all-threads t]
- ["Hide thread" gnus-summary-hide-thread t]
- ["Show thread" gnus-summary-show-thread t]
- ["Go to next thread" gnus-summary-next-thread t]
- ["Go to previous thread" gnus-summary-prev-thread t]
- ["Go down thread" gnus-summary-down-thread t]
- ["Go up thread" gnus-summary-up-thread t]
- ["Top of thread" gnus-summary-top-thread t]
- ["Mark thread as read" gnus-summary-kill-thread t]
- ["Lower thread score" gnus-summary-lower-thread t]
- ["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]
- ))
-
- (easy-menu-define
- gnus-summary-post-menu gnus-summary-mode-map ""
- '("Post"
- ["Post an article" gnus-summary-post-news t]
- ["Followup" gnus-summary-followup t]
- ["Followup and yank" gnus-summary-followup-with-original t]
- ["Supersede article" gnus-summary-supersede-article t]
- ["Cancel article" gnus-summary-cancel-article t]
- ["Reply" gnus-summary-reply t]
- ["Reply and yank" gnus-summary-reply-with-original t]
- ["Mail forward" gnus-summary-mail-forward t]
- ["Post forward" gnus-summary-post-forward t]
- ["Digest and mail" gnus-uu-digest-mail-forward t]
- ["Digest and post" gnus-uu-digest-post-forward t]
- ["Resend message" gnus-summary-resend-message t]
- ["Send bounced mail" gnus-summary-resend-bounced-mail t]
- ["Send a mail" gnus-summary-mail-other-window t]
- ["Uuencode and post" gnus-uu-post-news t]
- ;;("Draft"
- ;;["Send" gnus-summary-send-draft t]
- ;;["Send bounced" gnus-resend-bounced-mail t])
- ))
-
- (easy-menu-define
- gnus-summary-misc-menu gnus-summary-mode-map ""
- '("Misc"
- ("Mark"
- ("Read"
- ["Mark as read" gnus-summary-mark-as-read-forward t]
- ["Mark same subject and select"
- gnus-summary-kill-same-subject-and-select t]
- ["Mark same subject" gnus-summary-kill-same-subject t]
- ["Catchup" gnus-summary-catchup t]
- ["Catchup all" gnus-summary-catchup-all t]
- ["Catchup to here" gnus-summary-catchup-to-here t]
- ["Catchup region" gnus-summary-mark-region-as-read t]
- ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
- ("Various"
- ["Tick" gnus-summary-tick-article-forward t]
- ["Mark as dormant" gnus-summary-mark-as-dormant t]
- ["Remove marks" gnus-summary-clear-mark-forward t]
- ["Set expirable mark" gnus-summary-mark-as-expirable t]
- ["Set bookmark" gnus-summary-set-bookmark t]
- ["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Limit"
- ["Marks..." gnus-summary-limit-to-marks t]
- ["Subject..." gnus-summary-limit-to-subject t]
- ["Author..." gnus-summary-limit-to-author t]
- ["Score" gnus-summary-limit-to-score t]
- ["Unread" gnus-summary-limit-to-unread t]
- ["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Articles" gnus-summary-limit-to-articles t]
- ["Pop limit" gnus-summary-pop-limit t]
- ["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
- gnus-summary-limit-exclude-childless-dormant t]
- ;;["Hide thread" gnus-summary-limit-exclude-thread t]
- ["Show expunged" gnus-summary-show-all-expunged t])
- ("Process mark"
- ["Set mark" gnus-summary-mark-as-processable t]
- ["Remove mark" gnus-summary-unmark-as-processable t]
- ["Remove all marks" gnus-summary-unmark-all-processable t]
- ["Mark above" gnus-uu-mark-over t]
- ["Mark series" gnus-uu-mark-series t]
- ["Mark region" gnus-uu-mark-region t]
- ["Mark by regexp..." gnus-uu-mark-by-regexp t]
- ["Mark all" gnus-uu-mark-all t]
- ["Mark buffer" gnus-uu-mark-buffer t]
- ["Mark sparse" gnus-uu-mark-sparse t]
- ["Mark thread" gnus-uu-mark-thread t]
- ["Unmark thread" gnus-uu-unmark-thread t]))
- ("Scroll article"
- ["Page forward" gnus-summary-next-page t]
- ["Page backward" gnus-summary-prev-page t]
- ["Line forward" gnus-summary-scroll-up t])
- ("Move"
- ["Next unread article" gnus-summary-next-unread-article t]
- ["Previous unread article" gnus-summary-prev-unread-article t]
- ["Next article" gnus-summary-next-article t]
- ["Previous article" gnus-summary-prev-article t]
- ["Next unread subject" gnus-summary-next-unread-subject t]
- ["Previous unread subject" gnus-summary-prev-unread-subject t]
- ["Next article same subject" gnus-summary-next-same-subject t]
- ["Previous article same subject" gnus-summary-prev-same-subject t]
- ["First unread article" gnus-summary-first-unread-article t]
- ["Best unread article" gnus-summary-best-unread-article t]
- ["Go to subject number..." gnus-summary-goto-subject t]
- ["Go to article number..." gnus-summary-goto-article t]
- ["Go to the last article" gnus-summary-goto-last-article t]
- ["Pop article off history" gnus-summary-pop-article t])
- ("Sort"
- ["Sort by number" gnus-summary-sort-by-number t]
- ["Sort by author" gnus-summary-sort-by-author t]
- ["Sort by subject" gnus-summary-sort-by-subject t]
- ["Sort by date" gnus-summary-sort-by-date t]
- ["Sort by score" gnus-summary-sort-by-score t])
- ("Help"
- ["Fetch group FAQ" gnus-summary-fetch-faq t]
- ["Describe group" gnus-summary-describe-group t]
- ["Read manual" gnus-info-find-node t])
- ("Cache"
- ["Enter article" gnus-cache-enter-article t]
- ["Remove article" gnus-cache-remove-article t])
- ("Modes"
- ["Pick and read" gnus-pick-mode t]
- ["Binary" gnus-binary-mode t])
- ["Filter articles..." gnus-summary-execute-command t]
- ["Run command on subjects..." gnus-summary-universal-argument t]
- ["Toggle line truncation" gnus-summary-toggle-truncation t]
- ["Expand window" gnus-summary-expand-window t]
- ["Expire expirable articles" gnus-summary-expire-articles
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Edit local kill file" gnus-summary-edit-local-kill t]
- ["Edit main kill file" gnus-summary-edit-global-kill t]
- ("Exit"
- ["Catchup and exit" gnus-summary-catchup-and-exit t]
- ["Catchup all and exit" gnus-summary-catchup-and-exit t]
- ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
- ["Exit group" gnus-summary-exit t]
- ["Exit group without updating" gnus-summary-exit-no-update t]
- ["Exit and goto next group" gnus-summary-next-group t]
- ["Exit and goto prev group" gnus-summary-prev-group t]
- ["Reselect group" gnus-summary-reselect-current-group t]
- ["Rescan group" gnus-summary-rescan-group t])))
-
- (run-hooks 'gnus-summary-menu-hook)
- ))
-
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
-(defun gnus-visual-score-map (type)
- (if t
- nil
- (let ((headers '(("author" "from" string)
- ("subject" "subject" string)
- ("article body" "body" string)
- ("article head" "head" string)
- ("xref" "xref" string)
- ("lines" "lines" number)
- ("followups to author" "followup" string)))
- (types '((number ("less than" <)
- ("greater than" >)
- ("equal" =))
- (string ("substring" s)
- ("exact string" e)
- ("fuzzy string" f)
- ("regexp" r))))
- (perms '(("temporary" (current-time-string))
- ("permanent" nil)
- ("immediate" now)))
- header)
- (list
- (apply
- 'nconc
- (list
- (if (eq type 'lower)
- "Lower score"
- "Increase score"))
- (let (outh)
- (while headers
- (setq header (car headers))
- (setq outh
- (cons
- (apply
- 'nconc
- (list (car header))
- (let ((ts (cdr (assoc (nth 2 header) types)))
- outt)
- (while ts
- (setq outt
- (cons
- (apply
- 'nconc
- (list (caar ts))
- (let ((ps perms)
- outp)
- (while ps
- (setq outp
- (cons
- (vector
- (caar ps)
- (list
- 'gnus-summary-score-entry
- (nth 1 header)
- (if (or (string= (nth 1 header)
- "head")
- (string= (nth 1 header)
- "body"))
- ""
- (list 'gnus-summary-header
- (nth 1 header)))
- (list 'quote (nth 1 (car ts)))
- (list 'gnus-score-default nil)
- (nth 1 (car ps))
- t)
- t)
- outp))
- (setq ps (cdr ps)))
- (list (nreverse outp))))
- outt))
- (setq ts (cdr ts)))
- (list (nreverse outt))))
- outh))
- (setq headers (cdr headers)))
- (list (nreverse outh))))))))
-
-;; Article buffer
-(defun gnus-article-make-menu-bar ()
- (gnus-visual-turn-off-edit-menu 'summary)
- (or
- (boundp 'gnus-article-article-menu)
- (progn
- (easy-menu-define
- gnus-article-article-menu gnus-article-mode-map ""
- '("Article"
- ["Scroll forwards" gnus-article-goto-next-page t]
- ["Scroll backwards" gnus-article-goto-prev-page t]
- ["Show summary" gnus-article-show-summary t]
- ["Fetch Message-ID at point" gnus-article-refer-article t]
- ["Mail to address at point" gnus-article-mail t]
- ))
-
- (easy-menu-define
- gnus-article-treatment-menu gnus-article-mode-map ""
- '("Treatment"
- ["Hide headers" gnus-article-hide-headers t]
- ["Hide signature" gnus-article-hide-signature t]
- ["Hide citation" gnus-article-hide-citation t]
- ["Treat overstrike" gnus-article-treat-overstrike t]
- ["Remove carriage return" gnus-article-remove-cr t]
- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
- ))
- (run-hooks 'gnus-article-menu-hook))))
-
-;;;
-;;; summary highlights
-;;;
-
-(defun gnus-highlight-selected-summary ()
- ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- ;; Highlight selected article in summary buffer
- (if gnus-summary-selected-face
- (save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
- ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
- (from (if (get-text-property beg gnus-mouse-face-prop)
- beg
- (1+ (or (next-single-property-change
- beg gnus-mouse-face-prop nil end)
- beg))))
- (to (1- (or (next-single-property-change
- from gnus-mouse-face-prop nil end)
- end))))
- ;; If no mouse-face prop on line (e.g. xemacs) we
- ;; will have to = from = end, so we highlight the
- ;; entire line instead.
- (if (= (+ to 2) from)
- (progn
- (setq from beg)
- (setq to end)))
- (if gnus-newsgroup-selected-overlay
- (gnus-move-overlay gnus-newsgroup-selected-overlay
- from to (current-buffer))
- (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
- (gnus-overlay-put gnus-newsgroup-selected-overlay 'face
- gnus-summary-selected-face))))))
-
-;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
-(defun gnus-summary-highlight-line ()
- "Highlight current line according to `gnus-summary-highlight'."
- (let* ((list gnus-summary-highlight)
- (p (point))
- (end (progn (end-of-line) (point)))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point)))
- (article (gnus-summary-article-number))
- (score (or (cdr (assq (or article gnus-current-article)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))
- (mark (or (gnus-summary-article-mark) gnus-unread-mark))
- (inhibit-read-only t))
- ;; Eval the cars of the lists until we find a match.
- (let ((default gnus-summary-default-score))
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list))))
- (let ((face (cdar list)))
- (unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
- (setq face (if (boundp face) (symbol-value face) face)))
- (when gnus-summary-highlight-line-function
- (funcall gnus-summary-highlight-line-function article face))))
- (goto-char p)))
-
-(defun gnus-group-highlight-line ()
- "Highlight the current line according to `gnus-group-highlight'."
- (let* ((list gnus-group-highlight)
- (p (point))
- (end (progn (end-of-line) (point)))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point)))
- (group (gnus-group-group-name))
- (entry (gnus-group-entry group))
- (unread (if (numberp (car entry)) (car entry) 0))
- (info (nth 2 entry))
- (method (gnus-server-get-method group (gnus-info-method info)))
- (marked (gnus-info-marks info))
- (mailp (memq 'mail (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
- (level (or (gnus-info-level info) 9))
- (score (or (gnus-info-score info) 0))
- (ticked (gnus-range-length (cdr (assq 'tick marked))))
- (inhibit-read-only t))
- ;; Eval the cars of the lists until we find a match.
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))
- (let ((face (cdar list)))
- (unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
- (setq face (if (boundp face) (symbol-value face) face)))
- (gnus-extent-start-open beg)))
- (goto-char p)))
-
-;;;
-;;; gnus-carpal
-;;;
-
-(defvar gnus-carpal-group-buffer-buttons
- '(("next" . gnus-group-next-unread-group)
- ("prev" . gnus-group-prev-unread-group)
- ("read" . gnus-group-read-group)
- ("select" . gnus-group-select-group)
- ("catch-up" . gnus-group-catchup-current)
- ("new-news" . gnus-group-get-new-news-this-group)
- ("toggle-sub" . gnus-group-unsubscribe-current-group)
- ("subscribe" . gnus-group-unsubscribe-group)
- ("kill" . gnus-group-kill-group)
- ("yank" . gnus-group-yank-group)
- ("describe" . gnus-group-describe-group)
- "list"
- ("subscribed" . gnus-group-list-groups)
- ("all" . gnus-group-list-all-groups)
- ("killed" . gnus-group-list-killed)
- ("zombies" . gnus-group-list-zombies)
- ("matching" . gnus-group-list-matching)
- ("post" . gnus-group-post-news)
- ("mail" . gnus-group-mail)
- ("rescan" . gnus-group-get-new-news)
- ("browse-foreign" . gnus-group-browse-foreign)
- ("exit" . gnus-group-exit)))
-
-(defvar gnus-carpal-summary-buffer-buttons
- '("mark"
- ("read" . gnus-summary-mark-as-read-forward)
- ("tick" . gnus-summary-tick-article-forward)
- ("clear" . gnus-summary-clear-mark-forward)
- ("expirable" . gnus-summary-mark-as-expirable)
- "move"
- ("scroll" . gnus-summary-next-page)
- ("next-unread" . gnus-summary-next-unread-article)
- ("prev-unread" . gnus-summary-prev-unread-article)
- ("first" . gnus-summary-first-unread-article)
- ("best" . gnus-summary-best-unread-article)
- "article"
- ("headers" . gnus-summary-toggle-header)
- ("uudecode" . gnus-uu-decode-uu)
- ("enter-digest" . gnus-summary-enter-digest-group)
- ("fetch-parent" . gnus-summary-refer-parent-article)
- "mail"
- ("move" . gnus-summary-move-article)
- ("copy" . gnus-summary-copy-article)
- ("respool" . gnus-summary-respool-article)
- "threads"
- ("lower" . gnus-summary-lower-thread)
- ("kill" . gnus-summary-kill-thread)
- "post"
- ("post" . gnus-summary-post-news)
- ("mail" . gnus-summary-mail)
- ("followup" . gnus-summary-followup-with-original)
- ("reply" . gnus-summary-reply-with-original)
- ("cancel" . gnus-summary-cancel-article)
- "misc"
- ("exit" . gnus-summary-exit)
- ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
-
-(defvar gnus-carpal-server-buffer-buttons
- '(("add" . gnus-server-add-server)
- ("browse" . gnus-server-browse-server)
- ("list" . gnus-server-list-servers)
- ("kill" . gnus-server-kill-server)
- ("yank" . gnus-server-yank-server)
- ("copy" . gnus-server-copy-server)
- ("exit" . gnus-server-exit)))
-
-(defvar gnus-carpal-browse-buffer-buttons
- '(("subscribe" . gnus-browse-unsubscribe-current-group)
- ("exit" . gnus-browse-exit)))
-
-(defvar gnus-carpal-group-buffer "*Carpal Group*")
-(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
-(defvar gnus-carpal-server-buffer "*Carpal Server*")
-(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
-
-(defvar gnus-carpal-attached-buffer nil)
-
-(defvar gnus-carpal-mode-hook nil
- "*Hook run in carpal mode buffers.")
-
-(defvar gnus-carpal-button-face 'bold
- "*Face used on carpal buttons.")
-
-(defvar gnus-carpal-header-face 'bold-italic
- "*Face used on carpal buffer headers.")
-
-(defvar gnus-carpal-mode-map nil)
-(put 'gnus-carpal-mode 'mode-class 'special)
-
-(if gnus-carpal-mode-map
- nil
- (setq gnus-carpal-mode-map (make-keymap))
- (suppress-keymap gnus-carpal-mode-map)
- (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
- (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
- (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
-
-(defun gnus-carpal-mode ()
- "Major mode for clicking buttons.
-
-All normal editing commands are switched off.
-\\<gnus-carpal-mode-map>
-The following commands are available:
-
-\\{gnus-carpal-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq mode-line-modified "-- ")
- (setq major-mode 'gnus-carpal-mode)
- (setq mode-name "Gnus Carpal")
- (setq mode-line-process nil)
- (use-local-map gnus-carpal-mode-map)
- (buffer-disable-undo (current-buffer))
- (setq buffer-read-only t)
- (make-local-variable 'gnus-carpal-attached-buffer)
- (run-hooks 'gnus-carpal-mode-hook))
-
-(defun gnus-carpal-setup-buffer (type)
- (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
- (if (get-buffer buffer)
- ()
- (save-excursion
- (set-buffer (get-buffer-create buffer))
- (gnus-carpal-mode)
- (setq gnus-carpal-attached-buffer
- (intern (format "gnus-%s-buffer" type)))
- (gnus-add-current-to-buffer-list)
- (let ((buttons (symbol-value
- (intern (format "gnus-carpal-%s-buffer-buttons"
- type))))
- (buffer-read-only nil)
- button)
- (while buttons
- (setq button (car buttons)
- buttons (cdr buttons))
- (if (stringp button)
- (gnus-set-text-properties
- (point)
- (prog2 (insert button) (point) (insert " "))
- (list 'face gnus-carpal-header-face))
- (gnus-set-text-properties
- (point)
- (prog2 (insert (car button)) (point) (insert " "))
- (list 'gnus-callback (cdr button)
- 'face gnus-carpal-button-face
- gnus-mouse-face-prop 'highlight))))
- (let ((fill-column (- (window-width) 2)))
- (fill-region (point-min) (point-max)))
- (set-window-point (get-buffer-window (current-buffer))
- (point-min)))))))
-
-(defun gnus-carpal-select ()
- "Select the button under point."
- (interactive)
- (let ((func (get-text-property (point) 'gnus-callback)))
- (if (null func)
- ()
- (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
- (call-interactively func))))
-
-(defun gnus-carpal-mouse-select (event)
- "Select the button under the mouse pointer."
- (interactive "e")
- (mouse-set-point event)
- (gnus-carpal-select))
-
-;;;
-;;; article highlights
-;;;
-
-;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
-
-;;; Internal Variables:
-
-(defvar gnus-button-regexp nil)
-;; Regexp matching any of the regexps from `gnus-button-alist'.
-
-(defvar gnus-button-last nil)
-;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
-
-;;; Commands:
-
-(defun gnus-article-push-button (event)
- "Check text under the mouse pointer for a callback function.
-If the text under the mouse pointer has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
- (interactive "e")
- (set-buffer (window-buffer (posn-window (event-start event))))
- (let* ((pos (posn-point (event-start event)))
- (data (get-text-property pos 'gnus-data))
- (fun (get-text-property pos 'gnus-callback)))
- (if fun (funcall fun data))))
-
-(defun gnus-article-press-button ()
- "Check text at point for a callback function.
-If the text at point has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
- (interactive)
- (let* ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
- (if fun (funcall fun data))))
-
-(defun gnus-article-prev-button (n)
- "Move point to N buttons backward.
-If N is negative, move forward instead."
- (interactive "p")
- (gnus-article-next-button (- n)))
-
-(defun gnus-article-next-button (n)
- "Move point to N buttons forward.
-If N is negative, move backward instead."
- (interactive "p")
- (let ((function (if (< n 0) 'previous-single-property-change
- 'next-single-property-change))
- (inhibit-point-motion-hooks t)
- (backward (< n 0))
- (limit (if (< n 0) (point-min) (point-max))))
- (setq n (abs n))
- (while (and (not (= limit (point)))
- (> n 0))
- ;; Skip past the current button.
- (when (get-text-property (point) 'gnus-callback)
- (goto-char (funcall function (point) 'gnus-callback nil limit)))
- ;; Go to the next (or previous) button.
- (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
- ;; Put point at the start of the button.
- (when (and backward (not (get-text-property (point) 'gnus-callback)))
- (goto-char (funcall function (point) 'gnus-callback nil limit)))
- ;; Skip past intangible buttons.
- (when (get-text-property (point) 'intangible)
- (incf n))
- (decf n))
- (unless (zerop n)
- (gnus-message 5 "No more buttons"))
- n))
-
-(defun gnus-article-highlight (&optional force)
- "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-citation',
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
- (gnus-article-highlight-headers)
- (gnus-article-highlight-citation force)
- (gnus-article-highlight-signature)
- (gnus-article-add-buttons force)
- (gnus-article-add-buttons-to-head))
-
-(defun gnus-article-highlight-some (&optional force)
- "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
- (gnus-article-highlight-headers)
- (gnus-article-highlight-signature)
- (gnus-article-add-buttons))
-
-(defun gnus-article-highlight-headers ()
- "Highlight article headers as specified by `gnus-header-face-alist'."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((alist gnus-header-face-alist)
- (buffer-read-only nil)
- (case-fold-search t)
- (inhibit-point-motion-hooks t)
- entry regexp header-face field-face from hpoints fpoints)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (narrow-to-region (1- (point)) (point-min))
- (while (setq entry (pop alist))
- (goto-char (point-min))
- (setq regexp (concat "^\\("
- (if (string-equal "" (nth 0 entry))
- "[^\t ]"
- (nth 0 entry))
- "\\)")
- header-face (nth 1 entry)
- field-face (nth 2 entry))
- (while (and (re-search-forward regexp nil t)
- (not (eobp)))
- (beginning-of-line)
- (setq from (point))
- (or (search-forward ":" nil t)
- (forward-char 1))
- (when (and header-face
- (not (memq (point) hpoints)))
- (push (point) hpoints)
- (gnus-put-text-property from (point) 'face header-face))
- (when (and field-face
- (not (memq (setq from (point)) fpoints)))
- (push from fpoints)
- (if (re-search-forward "^[^ \t]" nil t)
- (forward-char -2)
- (goto-char (point-max)))
- (gnus-put-text-property from (point) 'face field-face)))))))))
-
-(defun gnus-article-highlight-signature ()
- "Highlight the signature in an article.
-It does this by highlighting everything after
-`gnus-signature-separator' using `gnus-signature-face'."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t))
- (save-restriction
- (when (and gnus-signature-face
- (article-narrow-to-signature))
- (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
- 'face gnus-signature-face)
- (widen)
- (article-search-signature)
- (let ((start (match-beginning 0))
- (end (set-marker (make-marker) (1+ (match-end 0)))))
- (gnus-article-add-button start (1- end) 'gnus-signature-toggle
- end)))))))
-
-(defun gnus-article-add-buttons (&optional force)
- "Find external references in the article and make buttons of them.
-\"External references\" are things like Message-IDs and URLs, as
-specified by `gnus-button-alist'."
- (interactive (list 'force))
- (save-excursion
- (set-buffer gnus-article-buffer)
- ;; Remove all old markers.
- (while gnus-button-marker-list
- (set-marker (pop gnus-button-marker-list) nil))
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (case-fold-search t)
- (alist gnus-button-alist)
- beg entry regexp)
- (goto-char (point-min))
- ;; We skip the headers.
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max)))
- (setq beg (point))
- (while (setq entry (pop alist))
- (setq regexp (car entry))
- (goto-char beg)
- (while (re-search-forward regexp nil t)
- (let* ((start (and entry (match-beginning (nth 1 entry))))
- (end (and entry (match-end (nth 1 entry))))
- (from (match-beginning 0)))
- (when (or (eq t (nth 1 entry))
- (eval (nth 1 entry)))
- ;; That optional form returned non-nil, so we add the
- ;; button.
- (gnus-article-add-button
- start end 'gnus-button-push
- (car (push (set-marker (make-marker) from)
- gnus-button-marker-list))))))))))
-
-;; Add buttons to the head of an article.
-(defun gnus-article-add-buttons-to-head ()
- "Add buttons to the head of the article."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (case-fold-search t)
- (alist gnus-header-button-alist)
- entry beg end)
- (nnheader-narrow-to-headers)
- (while alist
- ;; Each alist entry.
- (setq entry (car alist)
- alist (cdr alist))
- (goto-char (point-min))
- (while (re-search-forward (car entry) nil t)
- ;; Each header matching the entry.
- (setq beg (match-beginning 0))
- (setq end (or (and (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0))
- (point-max)))
- (goto-char beg)
- (while (re-search-forward (nth 1 entry) end t)
- ;; Each match within a header.
- (let* ((from (match-beginning 0))
- (entry (cdr entry))
- (start (match-beginning (nth 1 entry)))
- (end (match-end (nth 1 entry)))
- (form (nth 2 entry)))
- (goto-char (match-end 0))
- (and (eval form)
- (gnus-article-add-button
- start end (nth 3 entry)
- (buffer-substring (match-beginning (nth 4 entry))
- (match-end (nth 4 entry)))))))
- (goto-char end))))
- (widen)))
-
-;;; External functions:
-
-(defun gnus-article-add-button (from to fun &optional data)
- "Create a button between FROM and TO with callback FUN and data DATA."
- (and gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay from to)
- 'face gnus-article-button-face))
- (gnus-add-text-properties
- from to
- (nconc (and gnus-article-mouse-face
- (list gnus-mouse-face-prop gnus-article-mouse-face))
- (list 'gnus-callback fun)
- (and data (list 'gnus-data data)))))
-
-;;; Internal functions:
-
-(defun gnus-signature-toggle (end)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t))
- (if (get-text-property end 'invisible)
- (article-unhide-text end (point-max))
- (article-hide-text end (point-max) gnus-hidden-properties)))))
-
-(defun gnus-button-entry ()
- ;; Return the first entry in `gnus-button-alist' matching this place.
- (let ((alist gnus-button-alist)
- (entry nil))
- (while alist
- (setq entry (pop alist))
- (if (looking-at (car entry))
- (setq alist nil)
- (setq entry nil)))
- entry))
-
-(defun gnus-button-push (marker)
- ;; Push button starting at MARKER.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char marker)
- (let* ((entry (gnus-button-entry))
- (inhibit-point-motion-hooks t)
- (fun (nth 3 entry))
- (args (mapcar (lambda (group)
- (let ((string (buffer-substring
- (match-beginning group)
- (match-end group))))
- (gnus-set-text-properties
- 0 (length string) nil string)
- string))
- (nthcdr 4 entry))))
- (cond
- ((fboundp fun)
- (apply fun args))
- ((and (boundp fun)
- (fboundp (symbol-value fun)))
- (apply (symbol-value fun) args))
- (t
- (gnus-message 1 "You must define `%S' to use this button"
- (cons fun args)))))))
-
-(defun gnus-button-message-id (message-id)
- "Fetch MESSAGE-ID."
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article message-id)))
-
-(defun gnus-button-mailto (address)
- ;; Mail to ADDRESS.
- (set-buffer (gnus-copy-article-buffer))
- (message-reply address))
-
-(defun gnus-button-reply (address)
- ;; Reply to ADDRESS.
- (message-reply address))
-
-(defun gnus-button-url (address)
- "Browse ADDRESS."
- (funcall browse-url-browser-function address browse-url-new-window-p))
-
-;;; Next/prev buttons in the article buffer.
-
-(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
-(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
- (setq gnus-prev-page-map (make-sparse-keymap))
- (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
- (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
-
-(defun gnus-insert-prev-page-button ()
- (let ((buffer-read-only nil))
- (gnus-eval-format
- gnus-prev-page-line-format nil
- `(gnus-prev t local-map ,gnus-prev-page-map
- gnus-callback gnus-article-button-prev-page))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
- (setq gnus-next-page-map (make-keymap))
- (suppress-keymap gnus-prev-page-map)
- (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
- (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
- "Go to the next page."
- (interactive)
- (let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
- (gnus-article-next-page)
- (select-window win)))
-
-(defun gnus-button-prev-page ()
- "Go to the prev page."
- (interactive)
- (let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
- (gnus-article-prev-page)
- (select-window win)))
-
-(defun gnus-insert-next-page-button ()
- (let ((buffer-read-only nil))
- (gnus-eval-format gnus-next-page-line-format nil
- `(gnus-next t local-map ,gnus-next-page-map
- gnus-callback
- gnus-article-button-next-page))))
-
-(defun gnus-article-button-next-page (arg)
- "Go to the next page."
- (interactive "P")
- (let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
- (gnus-article-next-page)
- (select-window win)))
-
-(defun gnus-article-button-prev-page (arg)
- "Go to the prev page."
- (interactive "P")
- (let ((win (selected-window)))
- (select-window (get-buffer-window gnus-article-buffer t))
- (gnus-article-prev-page)
- (select-window win)))
-
-;;; Compatibility Functions:
-
-(or (fboundp 'rassoc)
- ;; Introduced in Emacs 19.29.
- (defun rassoc (elt list)
- "Return non-nil if ELT is `equal' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr is ELT."
- (let (result)
- (while list
- (setq result (car list))
- (if (equal (cdr result) elt)
- (setq list nil)
- (setq result nil
- list (cdr list))))
- result)))
-
-; (require 'gnus-cus)
-(gnus-ems-redefine)
-(provide 'gnus-vis)
-
-;;; gnus-vis.el ends here
;;; gnus-vm.el --- vm interface for Gnus
;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
-;; Author: Per Persson <pp@solace.mh.se>
+;; Author: Per Persson <pp@gnu.ai.mit.edu>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
(if gnus-carpal '(summary-carpal 4))))
(article
(cond
- (gnus-use-picons
+ ((and gnus-use-picons (not (eq gnus-picons-display-where 'article)))
'(frame 1.0
(vertical 1.0
(summary 0.25 point)
(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.10"
+(defconst gnus-version-number "0.11"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
((equal method "")
(setq method gnus-select-method))
((assoc method gnus-valid-select-methods)
- (list method
+ (list (intern method)
(if (memq 'prompt-address
(assoc method gnus-valid-select-methods))
(read-string "Address: ")
"")))
((assoc method gnus-server-alist)
- (list method))
+ (cdr (assoc method gnus-server-alist)))
(t
- (list method "")))))
+ (list (intern method) "")))))
;;; User-level commands.
(point)
(goto-char p))))
+(defmacro message-y-or-n-p (question show &rest text)
+ "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
+ `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
;; Delete the current line (and the next N lines.);
(defmacro message-delete-line (&optional n)
`(delete-region (progn (beginning-of-line) (point))
(if (search-forward "\n\n" nil t)
(1- (point))
(point)))
- (message-remove-header message-ignored-cited-headers t)))
+ (message-remove-header message-ignored-cited-headers t)
+ (goto-char (point-max))))
+ ;; Delete blank lines at the start of the buffer.
+ (while (and (point-min)
+ (eolp))
+ (message-delete-line))
+ ;; Delete blank lines at the end of the buffer.
+ (goto-char (point-max))
+ (unless (eolp)
+ (insert "\n"))
+ (while (and (zerop (forward-line -1))
+ (looking-at "$"))
+ (message-delete-line))
;; Do the indentation.
(if (null message-yank-prefix)
(indent-rigidly start (mark t) message-indentation-spaces)
(unless modified
(setq message-checksum (cons (message-checksum) (buffer-size)))))))
-(defun message-cite-original ()
+(defun message-cite-original ()
+ "Cite function in the standard Message manner."
(let ((start (point))
(functions
(when message-indent-citation-function
(y-or-n-p
(format
"Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
+ (1- (count-lines (point) (point-max)))))
t))))))
(defun message-check-element (type)
(inhibit-point-motion-hooks t)
mct never-mct gnus-warning)
(save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (point)
- (point-max)))
+ (message-narrow-to-head)
;; Allow customizations to have their say.
(if (not wide)
;; This is a regular reply.
;;; Help stuff.
-(defmacro message-y-or-n-p (question show &rest text)
- "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
- `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-
(defun message-talkative-question (ask question show &rest text)
"Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
The following arguments may contain lists of values."
;;; Internal variables.
+(defvar nntp-process-wait-for nil)
+(defvar nntp-process-to-buffer nil)
+(defvar nntp-process-callback nil)
+(defvar nntp-process-decode nil)
+(defvar nntp-process-start-point nil)
+(defvar nntp-inside-change-function nil)
+
(defvoo nntp-server-type nil)
(defvoo nntp-connection-alist nil)
(defvoo nntp-status-string "")
(while (setq process (car (pop nntp-connection-alist)))
(when (memq (process-status process) '(open run))
(set-process-sentinel process nil)
- (set-process-filter process nil)
(nntp-send-string process "QUIT"))
(when (buffer-name (process-buffer process))
(kill-buffer (process-buffer process))))
(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
(nntp-decode-text))))
-(deffoo nntp-asynchronous-p ()
- t)
-
(deffoo nntp-request-post (&optional server)
(nntp-possibly-change-group nil server)
(when (nntp-send-command "^[23].*\r?\n" "POST")
(deffoo nntp-request-type (group article)
'news)
+(deffoo nntp-asynchronous-p ()
+ t)
+
;;; Hooky functions.
(defun nntp-send-mode-reader ()
(nntp-send-command "^.*\r?\n" "AUTHINFO USER"
(read-string "NNTP user name: "))
(nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
- (read-string "NNTP password: ")))
+ (nnmail-read-passwd "NNTP password: ")))
(defun nntp-send-authinfo ()
"Send the AUTHINFO to the nntp server.
(when process
(process-buffer process))))
+(defun nntp-make-process-buffer (buffer)
+ "Create a new, fresh buffer usable for nntp process connections."
+ (save-excursion
+ (set-buffer
+ (generate-new-buffer
+ (format " *server %s %s %s*"
+ nntp-address nntp-port-number
+ (buffer-name (get-buffer buffer)))))
+ (buffer-disable-undo (current-buffer))
+ (set (make-local-variable 'after-change-functions) nil)
+ (set (make-local-variable 'nntp-process-wait-for) nil)
+ (set (make-local-variable 'nntp-process-callback) nil)
+ (set (make-local-variable 'nntp-process-to-buffer) nil)
+ (set (make-local-variable 'nntp-process-start-point) nil)
+ (set (make-local-variable 'nntp-process-decode) nil)
+ (current-buffer)))
+
(defun nntp-open-connection (buffer)
"Open a connection to PORT on ADDRESS delivering output to BUFFER."
(run-hooks 'nntp-prepare-server-hook)
- (let* ((pbuffer (save-excursion
- (set-buffer
- (generate-new-buffer
- (format " *server %s %s %s*"
- nntp-address nntp-port-number
- (buffer-name (get-buffer buffer)))))
- (buffer-disable-undo (current-buffer))
- (current-buffer)))
+ (let* ((pbuffer (nntp-make-process-buffer buffer))
(process
(condition-case ()
(funcall
(eval (cadr entry))
(funcall (cadr entry)))))))
-(defvar nntp-tmp-first)
-(defvar nntp-tmp-wait-for)
-(defvar nntp-tmp-callback)
-(defvar nntp-tmp-buffer)
-
-(defun nntp-make-process-filter (wait-for callback buffer decode)
- `(lambda (proc string)
- (let ((nntp-tmp-wait-for ,wait-for)
- (nntp-tmp-callback ,callback)
- (nntp-tmp-buffer ,buffer))
- (nntp-process-filter proc string))))
-
-(defun nntp-process-filter (proc string)
- "Process filter used for waiting a calling back."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (let (point)
- (set-buffer (process-buffer proc))
- ;; Insert the text, moving the process-marker.
- (setq point (goto-char (process-mark proc)))
- (insert string)
- (set-marker (process-mark proc) (point))
- (if (and (= point (point-min))
- (string-match "^45" string))
- (progn
- (nntp-snarf-error-message)
- (set-process-filter proc nil)
- (funcall nntp-tmp-callback nil))
- (setq nntp-tmp-first nil)
- (if (re-search-backward nntp-tmp-wait-for nil t)
- (progn
- (if (buffer-name (get-buffer nntp-tmp-buffer))
- (save-excursion
- (set-buffer (get-buffer nntp-tmp-buffer))
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer proc))))
- (set-process-filter proc nil)
- (erase-buffer)
- (funcall nntp-tmp-callback t)))))
- (set-buffer old-buffer))))
+(defun nntp-after-change-function (beg end len)
+ (when nntp-process-callback
+ (save-match-data
+ (if (and (= beg (point-min))
+ (memq (char-after beg) '(?4 ?5)))
+ ;; Report back error messages.
+ (progn
+ (nntp-snarf-error-message)
+ (funcall nntp-process-callback nil))
+ (goto-char end)
+ (when (and (> (point) nntp-process-start-point)
+ (re-search-backward nntp-process-wait-for
+ nntp-process-start-point t))
+ (when nntp-process-decode
+ ;(nntp-decode-text)
+ )
+ (when (buffer-name (get-buffer nntp-process-to-buffer))
+ (let ((cur (current-buffer))
+ (start nntp-process-start-point))
+ (save-excursion
+ (set-buffer (get-buffer nntp-process-to-buffer))
+ (goto-char (point-max))
+ (insert-buffer-substring cur start))))
+ (goto-char end)
+ ;(erase-buffer)
+ (let ((callback nntp-process-callback)
+ (nntp-inside-change-function t))
+ (setq nntp-process-callback nil)
+ (save-excursion
+ (funcall callback t))))))))
(defun nntp-retrieve-data (command address port buffer
&optional wait-for callback decode)
(nntp-open-connection buffer))))
(if (not process)
(nnheader-report 'nntp "Couldn't open connection to %a" address)
- (unless nntp-inhibit-erase
+ (unless (or nntp-inhibit-erase nnheader-callback-function)
(save-excursion
(set-buffer (process-buffer process))
(erase-buffer)))
((eq callback 'ignore)
t)
((and callback wait-for)
- (set-process-filter
- process (nntp-make-process-filter wait-for callback buffer decode))
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (unless nntp-inside-change-function
+ (erase-buffer))
+ (setq nntp-process-decode decode
+ nntp-process-to-buffer buffer
+ nntp-process-wait-for wait-for
+ nntp-process-callback callback
+ nntp-process-start-point (point-max)
+ after-change-functions (list 'nntp-after-change-function)))
t)
(wait-for
- (set-process-filter process nil)
(nntp-wait-for process wait-for buffer decode))
(t t)))))
"A list of regexps to map smilies to real images.
Defaults to the content of smiley-deformed-regexp-alist.
An alternative smiley-nose-regexp-alist that
-matches less aggresively is available.")
+matches less aggresively is available.
+If this is a symbol, take its value.")
(defvar smiley-flesh-color "yellow"
"Flesh color.")
(when buffer
(set-buffer buffer))
(let ((buffer-read-only nil)
- (alist smiley-regexp-alist)
+ (alist (if (symbolp smiley-regexp-alist)
+ (symbol-value smiley-regexp-alist)
+ smiley-regexp-alist))
entry regexp beg group file)
(goto-char (or st (point-min)))
(setq beg (point))
+Sun Aug 11 02:52:37 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (User-Defined Specs): Correction.
+ (Unavailable Servers): Addition.
+ (Moderation): New.
+ (Summary Mail Commands): Addition.
+ (Crosspost Handling): Addition.
+
Sat Aug 10 00:13:39 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Summary Buffer Lines): Correction.
(Top): Name fix.
(Compilation ): Addition.
(Group Parameters): Addition.
+ (Troubleshooting): Addition.
Fri Aug 9 07:17:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
buffer. But, hey, that's your problem. Blllrph!
@findex gnus-no-server
+@kindex M-x gnus-no-server
@c @head
If you know that the server is definitely down, or you just want to read
your mail without bothering with the server at all, you can use the
@code{gnus-no-server} command to start Gnus. That might come in handy
-if you're in a hurry as well.
+if you're in a hurry as well. This command will not attempt to contact
+your primary server---instead, it will just activate all groups on level
+1 and 2. (You should preferrably keep no native groups on those two
+levels.)
@node Slave Gnusii
@findex gnus-uu-digest-post-forward
Digest the current series and forward the result to a newsgroup
(@code{gnus-uu-digest-mail-forward}).
+
+@item S M-c
+@kindex S M-c (Summary)
+@findex gnus-summary-mail-crosspost-complaint
+@cindex crossposting
+@cindex excessive crossposting
+Send a complaint about excessive crossposting to the author of the
+current article (@code{gnus-summary-mail-crosspost-complaint}).
+
+@findex gnus-crosspost-complaint
+This command is provided as a way to fight back agains the current
+crossposting pandemic that's sweeping Usenet. It will compose a reply
+using the @code{gnus-crosspost-complaint} variable as a preamble. This
+command understands the process/prefix convention
+(@pxref{Process/Prefix}) and will prompt you before sending each mail.
+
@end table
Remember: Cross-posting is kinda ok, but posting the same article
separately to several groups is not. Massive cross-posting (aka.
-@dfn{velveeta}) is to be avoided at all costs.
+@dfn{velveeta}) is to be avoided at all costs, and you can even use the
+@code{gnus-summary-mail-crosspost-complaint} command to complain about
+excessive crossposting (@pxref{Summary Mail Commands}).
@cindex cross-posting
@cindex Xref
Mark the current server as unreachable
(@code{gnus-server-deny-server}).
+@item M-o
+@kindex M-o (Server)
+@findex gnus-server-open-all-servers
+Open the connections to all servers in the buffer
+(@code{gnus-server-open-all-servers}).
+
+@item M-c
+@kindex M-c (Server)
+@findex gnus-server-close-all-servers
+Close the connections to all servers in the buffer
+(@code{gnus-server-close-all-servers}).
+
@item R
@kindex R (Server)
@findex gnus-server-remove-denials
* Daemons:: Gnus can do things behind your back.
* NoCeM:: How to avoid spam and other fatty foods.
* Picons:: How to display pictures of what your reading.
+* Moderation:: What to do if you're a moderator.
* Various Various:: Things that are really various.
@end menu
You can also use tilde modifiers (@pxref{Advanced Formatting} to achieve
much the same without defining new functions. Here's an example:
-@samp{%~(form (count-lines (point-min) (point-max)))@@}. The form
+@samp{%~(form (count-lines (point-min) (point)))@@}. The form
given here will be evaluated to yield the current line number, and then
inserted.
@end table
+@node Moderation
+@section Moderation
+@cindex moderation
+
+If you are a moderator, you can use the @file{gnus-mdrtn.el} package.
+It is not included in the standard Gnus package. Write a mail to
+@samp{larsi@@ifi.uio.no} and state what group you moderate, and you'll
+get a copy.
+
+The moderation package is implemented as a minor mode for summary
+buffers. Put
+
+@lisp
+(add-hook 'gnus-summary-mode-hook 'gnus-moderate)
+@end lisp
+
+in your @file{.gnus.el} file.
+
+If you are the moderation of @samp{rec.zoofle}, this is how it's
+supposed to work:
+
+@enumerate
+@item
+You split your incoming mail by matching on
+@samp{Newsgroups:.*rec.zoofle}, which will put all the to-be-posted
+articles in some mail group---@samp{nnml:rec.zoofle}, for instance.
+
+@item
+You enter that group once in a while and post articles using the @kbd{e}
+(edit-and-post) or @kbd{s} (just send unedited) commands.
+
+@item
+If, while reading the @samp{rec.zoofle} newsgroup, you happen upon some
+articles that weren't approved by you, you can cancel them with the
+@kbd{c} command.
+@end enumerate
+
+To use moderation mode in these two groups, say:
+
+@lisp
+(setq gnus-moderatated-groups
+ "^nnml:rec.zoofle$\\|^rec.zoofle$")
+@end lisp
+
+
@node Various Various
@section Various Various
@cindex mode lines
@item
Read the help group (@kbd{G h} in the group buffer) for a FAQ and a
how-to.
+
+@item
+@vindex max-lisp-eval-depth
+Gnus works on many recursive structures, and in some extreme (and very
+rare) cases Gnus may recurse down ``too deeply'' and Emacs will beep at
+you. If this happens to you, set @code{max-lisp-eval-depth} to 500 or
+something like that.
@end enumerate
If all else fails, report the problem as a bug.
@code{news} if @var{article} in @var{group} is news, @code{mail} if it
is mail and @code{unknown} if the type can't be decided. (The
@var{article} parameter is necessary in @code{nnvirtual} groups which
-might very well combine mail groups and news groups.)
+might very well combine mail groups and news groups.) Both @var{group}
+and @var{article} may be @code{nil}.
There should be no result data from this function.
projects / gnus / commitdiff