*** pub/rgnus/lisp/gnus-art.el Sat Aug 10 01:23:59 1996 --- rgnus/lisp/gnus-art.el Mon Aug 12 03:31:44 1996 *************** *** 127,132 **** --- 127,135 ---- (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.") *************** *** 488,493 **** --- 491,521 ---- (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. *************** *** 1276,1281 **** --- 1304,1733 ---- (search-forward-regexp "^$" nil t) (let ((case-fold-search nil)) (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) + + ;;; + ;;; Article highlights + ;;; + + ;; Written by Per Abrahamsen . + + ;;; 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) + ("\\(\n\t ]*\\)>?\\)" 1 t + gnus-button-message-id 3) + ("\\( \n\t]+\\)>?" 0 t gnus-button-reply 2) + ;; This is how URLs _should_ be embedded in text... + ("]*\\)>" 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) *** pub/rgnus/lisp/gnus-async.el Fri Aug 2 20:04:55 1996 --- rgnus/lisp/gnus-async.el Mon Aug 12 04:30:18 1996 *************** *** 48,56 **** (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") (defvar gnus-async-article-alist nil) (defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") ! (defvar gnus-asynch-header-prefetched nil) ;;; Utility functions. --- 48,58 ---- (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-async-header-prefetched nil) ;;; Utility functions. *************** *** 58,63 **** --- 60,76 ---- "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 ;;; *************** *** 67,73 **** (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)) (defun gnus-async-prefetch-next (group article summary) "Possibly prefetch several articles starting with the article after ARTICLE." --- 80,89 ---- (gnus-kill-buffer gnus-async-prefetch-article-buffer) (gnus-kill-buffer gnus-async-prefetch-headers-buffer) (setq gnus-async-article-alist 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." *************** *** 75,134 **** (when next (gnus-async-prefetch-article group next summary)))) ! (defun gnus-async-prefetch-article (group article summary &optional number) "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 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) (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)))))) (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-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) (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)) ;; Decode the article. Perhaps this shouldn't be done ;; here? (set-buffer buffer) --- 91,171 ---- (when next (gnus-async-prefetch-article group next summary)))) ! (defun gnus-async-prefetch-article (group article summary &optional next) "Possibly prefetch several articles starting with ARTICLE." ! (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 (mark) ! (gnus-async-set-buffer) (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function ! (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 ! (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-async-delete-prefected-entry entry)) ;; Decode the article. Perhaps this shouldn't be done ;; here? (set-buffer buffer) *************** *** 137,149 **** (gnus-delete-line) t))))) ! (defun gnus-asynch-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) (setq gnus-async-article-alist ! (delq entry gnus-async-article-alist))) (defun gnus-async-prefetch-remove-group (group) "Remove all articles belonging to GROUP from the prefetch buffer." --- 174,188 ---- (gnus-delete-line) t))))) ! (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)) ! (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." *************** *** 151,160 **** (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) (while alist (when (equal group (nth 3 (car alist))) ! (gnus-asynch-delete-prefected-entry (car alist))) (pop alist)))))) (defun gnus-async-prefetched-article-entry (group article) --- 190,199 ---- (memq 'exit gnus-prefetched-article-deletion-strategy)) (let ((alist gnus-async-article-alist)) (save-excursion ! (gnus-async-set-buffer) (while alist (when (equal group (nth 3 (car alist))) ! (gnus-async-delete-prefected-entry (car alist))) (pop alist)))))) (defun gnus-async-prefetched-article-entry (group article) *************** *** 172,203 **** (let (unread) (when (and gnus-use-header-prefetch (gnus-group-asynchronous-p group) ! (listp gnus-asynch-header-prefetched) (setq unread (gnus-list-of-unread-articles group))) ;; Mark that a fetch is in progress. ! (setq gnus-asynch-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 ,(cons group unread))))) (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) ! (defun gnus-asynch-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))) (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) t))) (provide 'gnus-async) --- 211,242 ---- (let (unread) (when (and gnus-use-header-prefetch (gnus-group-asynchronous-p group) ! (listp gnus-async-header-prefetched) (setq unread (gnus-list-of-unread-articles group))) ;; Mark that a fetch is in progress. ! (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-async-header-prefetched ,(cons group unread))))) (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) ! (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-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-async-header-prefetched nil) t))) (provide 'gnus-async) *** pub/rgnus/lisp/gnus-cache.el Fri Aug 2 18:50:08 1996 --- rgnus/lisp/gnus-cache.el Mon Aug 12 03:31:45 1996 *************** *** 102,108 **** (if (> (buffer-size) 0) ;; non-empty overview, write it out (progn ! (make-directory (file-name-directory overview-file) t) (write-region (point-min) (point-max) overview-file nil 'quietly)) ;; empty overview file, remove it --- 102,109 ---- (if (> (buffer-size) 0) ;; non-empty overview, write it out (progn ! (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 *** pub/rgnus/lisp/gnus-group.el Sat Aug 10 01:24:02 1996 --- rgnus/lisp/gnus-group.el Mon Aug 12 03:31:46 1996 *************** *** 153,158 **** --- 153,161 ---- (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.") *************** *** 390,395 **** --- 393,562 ---- "\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. *************** *** 726,731 **** --- 893,930 ---- (forward-line)) ;; 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. *** pub/rgnus/lisp/gnus-msg.el Sat Aug 10 01:24:07 1996 --- rgnus/lisp/gnus-msg.el Mon Aug 12 06:02:58 1996 *************** *** 107,133 **** ;;; 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) ;;; Internal functions. --- 107,132 ---- ;;; 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 ! "\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. *************** *** 250,257 **** 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)) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) --- 249,256 ---- 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)) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) *************** *** 360,366 **** (cond ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ! ((null arg) (or gnus-post-method gnus-select-method message-post-method)) ;; We want this group's method. ((and arg (not (eq arg 0))) --- 359,365 ---- (cond ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ! ((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))) *************** *** 484,490 **** (format " %d.%d" emacs-major-version emacs-minor-version))) (t emacs-version)))) ! ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) (let ((mail-header-separator --- 483,489 ---- (format " %d.%d" emacs-major-version emacs-minor-version))) (t emacs-version)))) ! ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) (let ((mail-header-separator *************** *** 580,585 **** --- 579,625 ---- (set-buffer gnus-message-buffer) (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." *** pub/rgnus/lisp/gnus-picon.el Wed Jul 31 21:25:18 1996 --- rgnus/lisp/gnus-picon.el Mon Aug 12 03:31:46 1996 *************** *** 213,225 **** (setq from (mail-fetch-field "from")) (setq from (downcase (or (cadr (mail-extract-address-components from)) ! "")) ! at-idx (string-match "@" from))) (save-excursion (let ((username (substring from 0 at-idx)) ! (addrs (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) --- 213,230 ---- (setq from (mail-fetch-field "from")) (setq from (downcase (or (cadr (mail-extract-address-components from)) ! ""))) ! (or (setq at-idx (string-match "@" from)) ! (setq at-idx (length from)))) (save-excursion (let ((username (substring from 0 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) *** pub/rgnus/lisp/gnus-salt.el Fri Aug 2 18:52:03 1996 --- rgnus/lisp/gnus-salt.el Mon Aug 12 03:31:46 1996 *************** *** 691,696 **** --- 691,867 ---- (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. + \\ + 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) *** pub/rgnus/lisp/gnus-spec.el Sat Aug 10 04:37:51 1996 --- rgnus/lisp/gnus-spec.el Mon Aug 12 03:37:32 1996 *************** *** 271,277 **** (if (> (length val) ,cut) ,(if (< cut-width 0) `(substring val 0 (- (length val) ,cut)) ! `(substring va 0 ,cut)) val))))) (defun gnus-tilde-ignore-form (el ignore-value) --- 271,277 ---- (if (> (length val) ,cut) ,(if (< cut-width 0) `(substring val 0 (- (length val) ,cut)) ! `(substring val 0 ,cut)) val))))) (defun gnus-tilde-ignore-form (el ignore-value) *************** *** 334,341 **** ;; 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 tilde-form tilde elem-type) (save-excursion (gnus-set-work-buffer) --- 334,341 ---- ;; SPEC-ALIST and returns a list that can be eval'ed to return a ;; string. (let ((max-width 0) ! 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) *************** *** 371,378 **** (setq pad-width value)) ((eq type 'pad-right) (setq pad-width (- value))) ! ((eq type 'max) (setq max-width value)) ((memq type '(cut cut-left)) (setq cut-width value)) ((eq type 'cut-right) --- 371,380 ---- (setq pad-width value)) ((eq type 'pad-right) (setq pad-width (- value))) ! ((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) *************** *** 499,504 **** --- 501,507 ---- "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...") *************** *** 509,516 **** (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))) (byte-compile 'gnus-tmp-func) (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) --- 512,518 ---- (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))) (byte-compile 'gnus-tmp-func) (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) *** pub/rgnus/lisp/gnus-srvr.el Mon Aug 5 00:16:23 1996 --- rgnus/lisp/gnus-srvr.el Mon Aug 12 03:31:47 1996 *************** *** 71,77 **** "*Hook run after the creation of the server mode menu.") (defun gnus-server-make-menu-bar () ! (gnus-visual-turn-off-edit-menu 'server) (unless (boundp 'gnus-server-server-menu) (easy-menu-define gnus-server-server-menu gnus-server-mode-map "" --- 71,77 ---- "*Hook run after the creation of the server mode menu.") (defun gnus-server-make-menu-bar () ! (gnus-turn-off-edit-menu 'server) (unless (boundp 'gnus-server-server-menu) (easy-menu-define gnus-server-server-menu gnus-server-mode-map "" *************** *** 92,98 **** ["Open" gnus-server-open-server t] ["Close" gnus-server-close-server t] ["Deny" gnus-server-deny-server t] ! ["Reset" gnus-server-remove-denials t] )) (run-hooks 'gnus-server-menu-hook))) --- 92,101 ---- ["Open" gnus-server-open-server t] ["Close" gnus-server-close-server t] ["Deny" gnus-server-deny-server 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))) *************** *** 118,124 **** --- 121,129 ---- "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 *************** *** 341,346 **** --- 346,358 ---- (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))) *************** *** 352,357 **** --- 364,376 ---- (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))) *************** *** 481,501 **** "\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)))) (defvar gnus-browse-current-method nil) (defvar gnus-browse-return-buffer nil) --- 500,518 ---- "\C-c\C-i" gnus-info-find-node)) (defun gnus-browse-make-menu-bar () ! (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) *** pub/rgnus/lisp/gnus-start.el Wed Aug 7 23:42:54 1996 --- rgnus/lisp/gnus-start.el Sat Aug 10 07:24:02 1996 *************** *** 129,135 **** (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 you have many groups that you aren't interested in.") (defvar gnus-activate-foreign-newsgroups 4 --- 129,135 ---- (defvar gnus-activate-level (1+ gnus-level-subscribed) "*Groups higher than this level won't be activated on startup. ! 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 *** pub/rgnus/lisp/gnus-sum.el Sat Aug 10 04:02:16 1996 --- rgnus/lisp/gnus-sum.el Mon Aug 12 03:41:52 1996 *************** *** 358,363 **** --- 358,366 ---- "*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.") *************** *** 1076,1081 **** --- 1079,1538 ---- "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)))))))) + (defun gnus-summary-mode (&optional group) *************** *** 7254,7259 **** --- 7711,7781 ---- (pop headers)) (when (cdr headers) (setcdr headers (cddr headers)))))) + + ;;; + ;;; summary highlights + ;;; + + (defun gnus-highlight-selected-summary () + ;; Added by Per Abrahamsen . + ;; 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 . + (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 . + (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) *** pub/rgnus/lisp/gnus-util.el Sat Aug 10 01:24:15 1996 --- rgnus/lisp/gnus-util.el Mon Aug 12 03:31:49 1996 *************** *** 520,525 **** --- 520,530 ---- ,(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 *** pub/rgnus/lisp/gnus-vis.el Sun Aug 4 22:10:33 1996 --- rgnus/lisp/gnus-vis.el Mon Aug 12 03:31:49 1996 *************** *** 1,1612 **** - ;;; gnus-vis.el --- display-oriented parts of Gnus - ;; Copyright (C) 1995,96 Free Software Foundation, Inc. - - ;; Author: Lars Magne Ingebrigtsen - ;; Per Abrahamsen - ;; 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) - ("\\(\n\t ]*\\)>?\\)" 1 t - gnus-button-message-id 3) - ("\\( \n\t]+\\)>?" 0 t gnus-button-reply 2) - ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 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) - - - - (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 . - ;; 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 . - (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 . - (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. - \\ - 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 . - - ;;; 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 --- 0 ---- *** pub/rgnus/lisp/gnus-vm.el Sun Jul 28 13:48:36 1996 --- rgnus/lisp/gnus-vm.el Mon Aug 12 06:02:58 1996 *************** *** 1,7 **** ;;; gnus-vm.el --- vm interface for Gnus ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ! ;; Author: Per Persson ;; Keywords: news, mail ;; This file is part of GNU Emacs. --- 1,7 ---- ;;; gnus-vm.el --- vm interface for Gnus ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ! ;; Author: Per Persson ;; Keywords: news, mail ;; This file is part of GNU Emacs. *** pub/rgnus/lisp/gnus-win.el Sun Aug 4 22:10:33 1996 --- rgnus/lisp/gnus-win.el Mon Aug 12 03:31:49 1996 *************** *** 50,56 **** (if gnus-carpal '(summary-carpal 4)))) (article (cond ! (gnus-use-picons '(frame 1.0 (vertical 1.0 (summary 0.25 point) --- 50,56 ---- (if gnus-carpal '(summary-carpal 4)))) (article (cond ! ((and gnus-use-picons (not (eq gnus-picons-display-where 'article))) '(frame 1.0 (vertical 1.0 (summary 0.25 point) *** pub/rgnus/lisp/gnus.el Sat Aug 10 07:02:40 1996 --- rgnus/lisp/gnus.el Mon Aug 12 03:31:49 1996 *************** *** 28,34 **** (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.10" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) --- 28,34 ---- (eval '(run-hooks 'gnus-load-hook)) ! (defconst gnus-version-number "0.11" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) *************** *** 794,808 **** ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods) ! (list method (if (memq 'prompt-address (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) ((assoc method gnus-server-alist) ! (list method)) (t ! (list method ""))))) ;;; User-level commands. --- 794,808 ---- ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods) ! (list (intern method) (if (memq 'prompt-address (assoc method gnus-valid-select-methods)) (read-string "Address: ") ""))) ((assoc method gnus-server-alist) ! (cdr (assoc method gnus-server-alist))) (t ! (list (intern method) ""))))) ;;; User-level commands. *** pub/rgnus/lisp/message.el Sat Aug 10 05:21:58 1996 --- rgnus/lisp/message.el Mon Aug 12 03:31:50 1996 *************** *** 512,517 **** --- 512,521 ---- (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)) *************** *** 1085,1091 **** (if (search-forward "\n\n" nil t) (1- (point)) (point))) ! (message-remove-header message-ignored-cited-headers t))) ;; Do the indentation. (if (null message-yank-prefix) (indent-rigidly start (mark t) message-indentation-spaces) --- 1089,1107 ---- (if (search-forward "\n\n" nil t) (1- (point)) (point))) ! (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) *************** *** 1119,1125 **** (unless modified (setq message-checksum (cons (message-checksum) (buffer-size))))))) ! (defun message-cite-original () (let ((start (point)) (functions (when message-indent-citation-function --- 1135,1142 ---- (unless modified (setq message-checksum (cons (message-checksum) (buffer-size))))))) ! (defun message-cite-original () ! "Cite function in the standard Message manner." (let ((start (point)) (functions (when message-indent-citation-function *************** *** 1731,1737 **** (y-or-n-p (format "Your .sig is %d lines; it should be max 4. Really post? " ! (count-lines (point) (point-max)))) t)))))) (defun message-check-element (type) --- 1748,1754 ---- (y-or-n-p (format "Your .sig is %d lines; it should be max 4. Really post? " ! (1- (count-lines (point) (point-max))))) t)))))) (defun message-check-element (type) *************** *** 2440,2450 **** (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))) ;; Allow customizations to have their say. (if (not wide) ;; This is a regular reply. --- 2457,2463 ---- (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction ! (message-narrow-to-head) ;; Allow customizations to have their say. (if (not wide) ;; This is a regular reply. *************** *** 2990,2999 **** (pop-to-buffer cur))))))) ;;; 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. --- 3003,3008 ---- *** pub/rgnus/lisp/nntp.el Sat Aug 10 01:24:21 1996 --- rgnus/lisp/nntp.el Mon Aug 12 05:06:15 1996 *************** *** 141,146 **** --- 141,153 ---- ;;; 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 "") *************** *** 290,296 **** (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)))) --- 297,302 ---- *************** *** 317,325 **** (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") --- 323,328 ---- *************** *** 328,333 **** --- 331,339 ---- (deffoo nntp-request-type (group article) 'news) + (deffoo nntp-asynchronous-p () + t) + ;;; Hooky functions. (defun nntp-send-mode-reader () *************** *** 344,350 **** (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string "NNTP user name: ")) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" ! (read-string "NNTP password: "))) (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. --- 350,356 ---- (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string "NNTP user name: ")) (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" ! (nnmail-read-passwd "NNTP password: "))) (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. *************** *** 442,458 **** (when process (process-buffer process)))) (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))) (process (condition-case () (funcall --- 448,474 ---- (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 (nntp-make-process-buffer buffer)) (process (condition-case () (funcall *************** *** 489,534 **** (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-retrieve-data (command address port buffer &optional wait-for callback decode) --- 505,540 ---- (eval (cadr entry)) (funcall (cadr entry))))))) ! (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) *************** *** 537,543 **** (nntp-open-connection buffer)))) (if (not process) (nnheader-report 'nntp "Couldn't open connection to %a" address) ! (unless nntp-inhibit-erase (save-excursion (set-buffer (process-buffer process)) (erase-buffer))) --- 543,549 ---- (nntp-open-connection buffer)))) (if (not process) (nnheader-report 'nntp "Couldn't open connection to %a" address) ! (unless (or nntp-inhibit-erase nnheader-callback-function) (save-excursion (set-buffer (process-buffer process)) (erase-buffer))) *************** *** 547,557 **** ((eq callback 'ignore) t) ((and callback wait-for) ! (set-process-filter ! process (nntp-make-process-filter wait-for callback buffer decode)) t) (wait-for - (set-process-filter process nil) (nntp-wait-for process wait-for buffer decode)) (t t))))) --- 553,570 ---- ((eq callback 'ignore) t) ((and callback wait-for) ! (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 (nntp-wait-for process wait-for buffer decode)) (t t))))) *** pub/rgnus/lisp/smiley.el Sat Jul 20 19:03:19 1996 --- rgnus/lisp/smiley.el Mon Aug 12 03:31:51 1996 *************** *** 85,91 **** "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.") (defvar smiley-flesh-color "yellow" "Flesh color.") --- 85,92 ---- "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. ! If this is a symbol, take its value.") (defvar smiley-flesh-color "yellow" "Flesh color.") *************** *** 135,141 **** (when buffer (set-buffer buffer)) (let ((buffer-read-only nil) ! (alist smiley-regexp-alist) entry regexp beg group file) (goto-char (or st (point-min))) (setq beg (point)) --- 136,144 ---- (when buffer (set-buffer buffer)) (let ((buffer-read-only nil) ! (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)) *** pub/rgnus/lisp/ChangeLog Sat Aug 10 07:00:14 1996 --- rgnus/lisp/ChangeLog Mon Aug 12 03:59:10 1996 *************** *** 1,3 **** --- 1,88 ---- + Mon Aug 12 03:51:57 1996 Lars Magne Ingebrigtsen + + * 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 + + * gnus-start.el (gnus-activate-level): Doc fix. + + Sun Aug 11 03:33:02 1996 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 + + * smiley.el (smiley-buffer): `smiley-regexp-alist' can be a symbol + now. + + Sun Aug 11 02:37:57 1996 Greg Stark + + * gnus-msg.el (gnus-post-method): Tested the wrong variable. + + Sun Aug 11 02:28:30 1996 Lars Magne Ingebrigtsen + + * message.el (message-check-news-syntax): Messaged wrong number. + + Sat Aug 10 11:26:56 1996 Lars Magne Ingebrigtsen + + * message.el (message-y-or-n-p): Moved to before usage. + + Fri Aug 9 16:42:52 1996 Danny Siu + + * 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 + + * 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 * gnus.el: Red Gnus v0.9 is released. *** pub/rgnus/texi/gnus.texi Sat Aug 10 07:02:40 1996 --- rgnus/texi/gnus.texi Mon Aug 12 03:44:03 1996 *************** *** 462,472 **** buffer. But, hey, that's your problem. Blllrph! @findex 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. @node Slave Gnusii --- 462,476 ---- 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. 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 *************** *** 3235,3240 **** --- 3239,3260 ---- @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 *************** *** 6291,6297 **** 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. @cindex cross-posting @cindex Xref --- 6311,6319 ---- 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, 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 *************** *** 7439,7444 **** --- 7461,7478 ---- 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 *************** *** 10866,10871 **** --- 10900,10906 ---- * 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 *************** *** 11081,11087 **** 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 given here will be evaluated to yield the current line number, and then inserted. --- 11116,11122 ---- 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)))@@}. The form given here will be evaluated to yield the current line number, and then inserted. *************** *** 11928,11933 **** --- 11963,12013 ---- @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 *************** *** 12804,12809 **** --- 12884,12896 ---- @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. *************** *** 13203,13209 **** @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.) There should be no result data from this function. --- 13290,13297 ---- @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.) Both @var{group} ! and @var{article} may be @code{nil}. There should be no result data from this function. *** pub/rgnus/texi/ChangeLog Sat Aug 10 01:24:33 1996 --- rgnus/texi/ChangeLog Mon Aug 12 03:31:54 1996 *************** *** 1,9 **** --- 1,18 ---- + Sun Aug 11 02:52:37 1996 Lars Magne Ingebrigtsen + + * 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 * 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