diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/ChangeLog dgnus/lisp/ChangeLog *** pub/dgnus/lisp/ChangeLog Sun Apr 30 22:46:23 1995 --- dgnus/lisp/ChangeLog Sat May 6 05:20:26 1995 *************** *** 1,3 **** --- 1,71 ---- + Sat May 6 01:48:06 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-de-quoted-unreadable): Did not set + buffer-read-only to nil. + + * gnus-score.el (gnus-score-save): Would not save score file if + the directory didn't exist. + + * gnus-vis.el (gnus-summary-make-menu-bar): Added sort-by-score. + + * gnus.el (gnus-read-active-file): Don't pretend that we have read + the active file when we haven't. + (gnus-summary-catchup): Make catchup-and-exit faster. + (gnus-summary-sort-by-score): Make the `reverse' element optional + on all score functions. + (gnus-read-descriptions-file): Don't barf if the server if down. + + * gnus-uu.el (gnus-uu-initialize): Chmod work dir. + + * gnus.el (gnus-nov-parse-line): Allow strings as Lines headers. + (gnus-summary-dummy-line-format): Not aligned properly. + (gnus-summary-goto-subject): Skip dummy articles. + (gnus-group-first-unread-group): Went to the first group, not the + first unread group. + + Mon May 1 01:51:25 1995 Lars Ingebrigtsen + + * gnus-vis.el (gnus-server-make-menu-bar): New function. + + * gnus.el: Pushed gnus-uu autoloads out to a keymap in gnus-uu. + (gnus-rebuild-thread): New function. + (gnus-rebuild-remove-articles): New function. + (gnus-group-mode-map): Changes. + + * gnus-score.el + (gnus-summary-temporarily-lower-followups-to-author): New command. + (gnus-summary-lower-followups-to-author): Raised instead of + lowering. + + * gnus.el (gnus-article-date-ut): `lapsed' would give incorrect + time. + (gnus-group-mark-group, gnus-group-unmark-group, + gnus-group-mark-region): New commands and keystrokes. + (gnus-group-process-prefix): New function. + (gnus-group-goto-group): New function. + (gnus-group-catchup-current): Use pro/pre. + (gnus-group-expire-articles): Ditto. + (gnus-group-expire-all-groups): Double ditto. + (gnus-group-set-current-level): Ditto. + (gnus-delete-line): New function. + (gnus-summary-mark-article): Don't unconditionally request article + when using the cache. + + Tue May 2 01:52:56 1995 Christian Limpach + + * gnus.el (gnus-article-display-x-face): cleaned up and use + call-process-region now. + + Mon May 1 23:40:32 1995 Christian Limpach + + * gnus.el (gnus-group-fetch-faq): fixed fetching faq of foreign + groups + + Mon May 1 21:04:22 1995 Scott Byer + + * gnus.el (gnus-unread-articles) Put back in dropped change to + prevent activation of unsubscribed foreign newsgroups. + Sun Apr 30 04:11:31 1995 Lars Ingebrigtsen * gnus.el (gnus-sorted-complement): Would reverse the result given *************** *** 18,23 **** --- 86,93 ---- (gnus-summary-respool-article): Behave grafully on nil input. (gnus-get-unread-articles): Would barf on virtual servers. (gnus-use-cache): New variable. + + * gnus.el: 0.63 is released. Sun Apr 30 01:29:34 1995 Lars Magne Ingebrigtsen diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-cache.el dgnus/lisp/gnus-cache.el *** pub/dgnus/lisp/gnus-cache.el Sun Apr 30 22:46:16 1995 --- dgnus/lisp/gnus-cache.el Sat May 6 01:25:22 1995 *************** *** 103,108 **** --- 103,109 ---- gnus-cache-enter-articles ticked dormant unread)) (file-exists-p (setq file (gnus-cache-file-name group article)))) () + (gnus-summary-select-article) (or (file-exists-p (setq dir (file-name-directory file))) (gnus-make-directory dir)) (if (file-exists-p file) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-hilit.el dgnus/lisp/gnus-hilit.el *** pub/dgnus/lisp/gnus-hilit.el Sat May 6 05:34:32 1995 --- dgnus/lisp/gnus-hilit.el Sat May 6 05:40:06 1995 *************** *** 0 **** --- 1,810 ---- + ;;; gnus-hilit.el --- Highlight GNUS article. + ;; Copyright (C) 1995 Free Software Foundation, Inc. + + ;; Author: Per Abrahamsen + ;; Keywords: news, mail + ;; Version: 0.4 + + ;;; Commentary: + + ;; Insert + ;; (require 'gnus-hilit) + ;; in your `.gnus' file to enable article highlighting. + + ;; If you have a color monitor you will also want to insert + ;; (setq gnus-cite-face-list 'dark) + ;; or + ;; (setq gnus-cite-face-list 'light) + ;; to get different colors for each citation. + + ;; See the documentation for `gnus-article-highlight' for more information. + + ;; This file should eventually be folded into `gnus-vis.el'. + + ;;; TODO: + + ;; - Command to force citations into prefered style. + ;; - Pass different URL types to different packages. + ;; News should be handled by GNUS itself. + ;; File & Ftp should perhaps be handled by ange-ftp or url.el. + ;; - Maybe recognize ange-ftp filenames. + ;; - Maybe recognize mail addresses. + + ;;; Code: + + ;;; Hack `gnus.el': + + (defun gnus-hilit-install () + (define-key gnus-article-mode-map [ mouse-2 ] 'gnus-article-push-button) + (define-key gnus-summary-wash-map "A" 'gnus-article-highlight) + (define-key gnus-summary-wash-map "a" 'gnus-article-hide) + (define-key gnus-summary-wash-map "H" 'gnus-article-highlight-headers) + (define-key gnus-summary-wash-map "C" 'gnus-article-highlight-citation) + (define-key gnus-summary-wash-map "S" 'gnus-article-highlight-signature) + (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) + (if gnus-visual + (add-hook 'gnus-article-display-hook 'gnus-article-highlight))) + + (if (featurep 'gnus) + (gnus-hilit-install) + (eval-after-load "gnus" + '(gnus-hilit-install))) + + ;;; Customization: + + (defvar gnus-face-light-name-list + '("light blue" "light cyan" "light yellow" "light pink" + "pale green" "beige" "orange" "magenta" "violet" "medium purple" + "turquoise") + "Names of light colors.") + + (defvar gnus-face-dark-name-list + '("dark blue" "dark cyan" "dark red" + "dark green" "dark orange" "dark khaki" "dark violet" + "dark turquoise") + "Names of dark colors.") + + (defvar gnus-make-foreground t + "Non nil means foreground color to highlight citations.") + + (defvar gnus-article-button-face 'bold + "Face used for text buttons.") + + (defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face) + gnus-mouse-face + highlight) + "Face used when the mouse is over the button.") + + (defvar gnus-header-face-alist '(("" bold italic)) + "Alist of headers and faces used for highlighting them. + The entries in the list has the form `(REGEXP NAME CONTENT)', where + REGEXP is a regeular 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.") + + (defvar gnus-cite-prefix-regexp "^[^\n]*[]>|:}+]" + "Regexp matching the longest possible citation prefix on a line.") + + (defvar gnus-cite-max-prefix 20 + "Maximal possible length for a citation prefix.") + + (defvar gnus-supercite-regexp + (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" + ">>>>> +\"\\([^\"\n]+\\)\" +==") + "Regexp matching normal SuperCite attribution lines. + The first regexp group should match a prefix added by another package. + The second regexp group should match the SuperCite attribution itself.") + + (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" + "Regexp matching mangled SuperCite attribution lines. + The first regexp group should match the SuperCite attribution.") + + (defvar gnus-cite-minimum-match-count 2 + "Minimal number of identical prefix'es before we believe it is a citation.") + + (defvar gnus-cite-face-list '(italic) + "Faces used for displaying different citations. + It is either a list of face names, or one of the following special + values: + + dark: Create faces from `gnus-face-dark-name-list'. + light: Create faces from `gnus-face-light-name-list'. + + The variable `gnus-make-foreground' determines whether the created + faces change the foreground or the background colors.") + + (defvar gnus-cite-attribution-prefix "in article\\|in <" + "Regexp matching the beginning of an attribution line.") + + (defvar gnus-cite-attribution-postfix "\\(wrote\\|writes\\|said\\):[ \t]*$" + "Regexp matching the end of an attribution line. + The text matching the first grouping will be used as a button.") + + (defvar gnus-cite-attribution-face 'underline + "Face used for attribution lines. + It is merged with the face for the cited text belonging to the attribution.") + + (defvar gnus-signature-separator "^-- *$" + "Regexp matching signature separator.") + + (defvar gnus-signature-face 'italic + "Face used for signature.") + + (defvar gnus-button-alist + '(("in\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 + (assq (count-lines (point-min) (match-end 0)) + gnus-cite-attribution-alist) + gnus-button-message-id 3) + ;; This is how URLs _should_ be embedded in text... + ("]*\\)>" 0 t gnus-button-url 1) + ;; Next regexp stolen from highlight-headers.el + ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]+" 0 t + gnus-button-url 0)) + "Alist of regexps matching buttons in an article. + + 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-button-url (cond ((fboundp 'w3-fetch) + 'w3-fetch) + ((fboundp 'highlight-headers-follow-url-netscape) + 'highlight-headers-follow-url-netscape) + (t nil)) + "Function to fetch URL. + The function will be called with one argument, the URL to fetch. + Useful values of this function are: + + w3-fetch: + defined in the w3 emacs package by William M. Perry. + highlight-headers-follow-url-netscape: + from `highlight-headers.el' for loading NetScape 1.1.") + + ;;; Internal Variables: + + (defvar gnus-cite-prefix-alist nil) + ;; Alist of citation prefixes. + ;; The cdr is a list of lines with that prefix. + + (defvar gnus-cite-attribution-alist nil) + ;; Alist of attribution lines. + ;; The car is a line number. + ;; The cdr is the prefix for the citation started by that line. + + (defvar gnus-cite-loose-prefix-alist nil) + ;; Alist of citation prefixes that have no matching attribution. + ;; The cdr is a list of lines with that prefix. + + (defvar gnus-cite-loose-attribution-alist nil) + ;; Alist of attribution lines that have no matching citation. + ;; Each member has the form (WROTE IN PREFIX TAG), where + ;; WROTE: is the attribution line number + ;; IN: is the line number of the previous line if part of the same attribution, + ;; PREFIX: Is the citation prefix of the attribution line(s), and + ;; TAG: Is a SuperCite tag, if any. + + (defvar gnus-article-length nil) + ;; Length of article last time we parsed it. + + (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-highlight () + "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) + (gnus-article-highlight-headers) + (gnus-article-highlight-citation) + (gnus-article-highlight-signature) + (gnus-article-add-buttons)) + + (defun gnus-article-hide () + "Hide current article. + This function calls `gnus-article-hide-headers', + `gnus-article-hide-citation', and `gnus-article-hide-signature' to do + the hiding. See the documentation for those functions." + (interactive) + (gnus-article-hide-headers) + (gnus-article-hide-citation) + (gnus-article-hide-signature)) + + (defun gnus-article-highlight-headers () + "Highlight article headers as specified by `gnus-header-face-alist'." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (search-forward "\n\n") + (beginning-of-line 0) + (while (not (bobp)) + (let ((alist gnus-header-face-alist) + (case-fold-search t) + (end (point)) + begin entry regexp header-face field-face header-found field-found) + (re-search-backward "^[^ \t]" nil t) + (setq begin (point)) + (while alist + (setq entry (car alist) + regexp (nth 0 entry) + header-face (nth 1 entry) + field-face (nth 2 entry) + alist (cdr alist)) + (if (looking-at regexp) + (let ((from (point))) + (skip-chars-forward "^:\n") + (and (not header-found) + header-face + (progn + (put-text-property from (point) 'face header-face) + (setq header-found t))) + (and (not field-found) + field-face + (progn + (skip-chars-forward ": \t") + (let ((from (point))) + (goto-char end) + (skip-chars-backward " \t") + (put-text-property from (point) 'face field-face) + (setq field-found t)))))) + (goto-char begin)))))) + + (defun gnus-article-highlight-citation () + "Highlight cited text. + Each citation in the article will be highlighted with a different face. + The faces are taken from `gnus-cite-face-list'. + Attribution lines are highlighted with the sameface as the + corresponding citation merged with `gnus-cite-attribution-face'. + + Text is concidered cited if at least `gnus-cite-minimum-match-count' + lines matches `gnus-cite-prefix-regexp' with the same prefix. + + Lines matching `gnus-cite-attribution-postfix' and perhaps + `gnus-cite-attribution-prefix' are concidered attribution lines." + (interactive) + ;; Create dark or light faces if necessary. + (cond ((eq gnus-cite-face-list 'light) + (setq gnus-cite-face-list + (mapcar 'gnus-make-face gnus-face-light-name-list))) + ((eq gnus-cite-face-list 'dark) + (setq gnus-cite-face-list + (mapcar 'gnus-make-face gnus-face-dark-name-list)))) + (save-excursion + (set-buffer gnus-article-buffer) + (gnus-cite-parse-maybe) + (let ((buffer-read-only nil) + (alist gnus-cite-prefix-alist) + (faces gnus-cite-face-list) + face entry prefix numbers number face-alist end) + ;; Loop through citation prefixes. + (while alist + (setq entry (car alist) + alist (cdr alist) + prefix (car entry) + numbers (cdr entry) + face (car faces) + faces (or (cdr faces) gnus-cite-face-list) + face-alist (cons (cons prefix face) face-alist)) + (while numbers + (setq number (car numbers) + numbers (cdr numbers)) + (and (not (assq number gnus-cite-attribution-alist)) + (not (assq number gnus-cite-loose-attribution-alist)) + (gnus-cite-add-face number prefix face)))) + ;; Loop through attribution lines. + (setq alist gnus-cite-attribution-alist) + (while alist + (setq entry (car alist) + alist (cdr alist) + number (car entry) + prefix (cdr entry) + skip (gnus-cite-find-prefix number) + face (cdr (assoc prefix face-alist))) + ;; Add attribution button. + (goto-line number) + (if (re-search-forward gnus-cite-attribution-postfix + (save-excursion (end-of-line 1) (point)) + t) + (gnus-article-add-button (match-beginning 1) (match-end 1) + 'gnus-cite-toggle prefix)) + ;; Highlight attribution line. + (gnus-cite-add-face number skip face) + (gnus-cite-add-face number skip gnus-cite-attribution-face)) + ;; Loop through attribution lines. + (setq alist gnus-cite-loose-attribution-alist) + (while alist + (setq entry (car alist) + alist (cdr alist) + number (car entry) + skip (gnus-cite-find-prefix number)) + (gnus-cite-add-face number skip gnus-cite-attribution-face))))) + + (defun gnus-article-hide-citation () + "Hide all cited text except attribution lines. + See the documentation for `gnus-article-highlight-citation'." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (gnus-cite-parse-maybe) + (let ((buffer-read-only nil) + (alist gnus-cite-prefix-alist) + numbers) + (while alist + (setq numbers (cdr (car alist)) + alist (cdr alist)) + (while numbers + (setq number (car numbers) + numbers (cdr numbers)) + (goto-line number) + (or (assq number gnus-cite-attribution-alist) + (put-text-property (point) (progn (forward-line 1) (point)) + 'invisible t))))))) + + (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)) + (goto-char (point-max)) + (and (re-search-backward gnus-signature-separator nil t) + gnus-signature-face + (let ((start (match-beginning 0)) + (end (match-end 0))) + (gnus-article-add-button start end 'gnus-signature-toggle end) + (overlay-put (make-overlay end (point-max)) + 'face gnus-signature-face)))))) + + (defun gnus-article-hide-signature () + "Hide the signature in an article. + It does this by majing everything after `gnus-signature-separator' invisible." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (and (re-search-backward gnus-signature-separator nil t) + gnus-signature-face + (put-text-property (match-end 0) (point-max) 'invisible t))))) + + (defun gnus-article-add-buttons () + "Find external references in article and make them to buttons. + + External references are things like message-ids and URLs, as specified by + `gnus-button-alist'." + (interactive) + (if (eq gnus-button-last gnus-button-alist) + () + (setq gnus-button-regexp (mapconcat 'car gnus-button-alist "\\|") + gnus-button-last gnus-button-alist)) + (save-excursion + (set-buffer gnus-article-buffer) + (gnus-cite-parse-maybe) + (let ((buffer-read-only nil) + (case-fold-search t)) + (goto-char (point-min)) + (search-forward "\n\n") + (while (re-search-forward gnus-button-regexp nil t) + (goto-char (match-beginning 0)) + (let* ((from (point)) + (entry (gnus-button-entry)) + (start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (form (nth 2 entry)) + marker) + (goto-char (match-end 0)) + (if (eval form) + (gnus-article-add-button start end 'gnus-button-push + (set-marker (make-marker) + from)))))))) + + ;;; Extrenal functions: + + (defun gnus-article-add-button (from to fun &optional data) + "Create a button between FROM and TO with callback FUN and data DATA." + (add-text-properties from to + (append (if gnus-article-button-face + (list 'face gnus-article-button-face)) + (if gnus-article-mouse-face + (list 'mouse-face gnus-article-mouse-face)) + (list 'gnus-callback fun) + (if data (list 'gnus-data data))))) + + ;;; Internal functions: + + (defun gnus-cite-parse-maybe () + ;; Parse if the buffer has changes since last time. + (if (eq gnus-article-length (- (point-max) (point-min))) + () + (setq gnus-article-length (- (point-max) (point-min))) + (gnus-cite-parse))) + + (defun gnus-cite-parse () + ;; Parse and connect citation prefixes and attribution lines. + (setq gnus-cite-prefix-alist nil + gnus-cite-attribution-alist nil + gnus-cite-loose-prefix-alist nil + gnus-cite-loose-attribution-alist nil) + ;; Parse current buffer searching for citation prefixes. + (goto-char (point-min)) + (search-forward "\n\n") + (let ((line (1+ (count-lines (point-min) (point)))) + (case-fold-search t) + (max (save-excursion + (goto-char (point-max)) + (re-search-backward gnus-signature-separator nil t) + (point))) + alist entry prefix start begin end numbers) + ;; Get all potential prefixes in `alist'. + (while (< (point) max) + ;; Each line. + (setq begin (point) + end (progn (beginning-of-line 2) (point)) + start end) + (goto-char begin) + ;; Ignore standard SuperCite attribution prefix. + (if (looking-at gnus-supercite-regexp) + (if (match-end 1) + (setq end (1+ (match-end 1))) + (setq end (1+ begin)))) + ;; Ignore very long prefixes. + (if (> end (+ (point) gnus-cite-max-prefix)) + (setq end (+ (point) gnus-cite-max-prefix))) + (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) + ;; Each prefix. + (setq end (match-end 0) + prefix (buffer-substring begin end)) + (set-text-properties 0 (length prefix) nil prefix) + (setq entry (assoc prefix alist)) + (if entry + (setcdr entry (cons line (cdr entry))) + (setq alist (cons (list prefix line) alist))) + (goto-char begin)) + (goto-char start) + (setq line (1+ line))) + ;; We got all the potential prefixes. Now create + ;; `gnus-cite-prefix-alist' containing the oldest prefix for each + ;; line that appears at least gnus-cite-minimum-match-count + ;; times. First sort them by length. Longer is older. + (setq alist (sort alist (lambda (a b) + (> (length (car a)) (length (car b)))))) + (while alist + (setq entry (car alist) + prefix (car entry) + numbers (cdr entry) + alist (cdr alist)) + (cond ((null numbers) + ;; No lines with this prefix that wasn't also part of + ;; a longer prefix. + ) + ((< (length numbers) gnus-cite-minimum-match-count) + ;; Too few lines with this prefix. We keep it a bit + ;; longer in case it is an exact match for an attribution + ;; line, but we don't remove the line from other + ;; prefixes. + (setq gnus-cite-prefix-alist + (cons entry gnus-cite-prefix-alist))) + (t + (setq gnus-cite-prefix-alist (cons entry gnus-cite-prefix-alist)) + ;; Remove articles from other prefixes. + (let ((loop alist) + current) + (while loop + (setq current (car loop) + loop (cdr loop)) + (setcdr current + (gnus-set-difference (cdr current) numbers)))))))) + ;; No citations have been connected to attribution lines yet. + (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) + + ;; Parse current buffer searching for attribution lines. + (goto-char (point-min)) + (search-forward "\n\n") + (while (re-search-forward gnus-cite-attribution-postfix (point-max) t) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (wrote (count-lines (point-min) end)) + (prefix (gnus-cite-find-prefix wrote)) + ;; Check previous line for an attribution leader. + (tag (progn + (beginning-of-line 1) + (and (looking-at gnus-supercite-secondary-regexp) + (buffer-substring (match-beginning 1) + (match-end 1))))) + (in (progn + (goto-char start) + (and (re-search-backward gnus-cite-attribution-prefix + (save-excursion + (beginning-of-line 0) + (point)) + t) + (not (re-search-forward gnus-cite-attribution-postfix + start t)) + (count-lines (point-min) (1+ (point))))))) + (if (eq wrote in) + (setq in nil)) + (goto-char end) + (setq gnus-cite-loose-attribution-alist + (cons (list wrote in prefix tag) + gnus-cite-loose-attribution-alist)))) + ;; Find exact supercite citations. + (gnus-cite-match-attributions 'small nil + (lambda (prefix tag) + (if tag + (concat "\\`" (regexp-quote prefix) "[ \t]*" + (regexp-quote tag) ">")))) + ;; Find loose supercite citations after attributions. + (gnus-cite-match-attributions 'small t + (lambda (prefix tag) + (if tag (concat "\\<" (regexp-quote tag) "\\>")))) + ;; Find loose supercite citations anywhere. + (gnus-cite-match-attributions 'small nil + (lambda (prefix tag) + (if tag (concat "\\<" (regexp-quote tag) "\\>")))) + ;; Find nested citations after attributions. + (gnus-cite-match-attributions 'small-if-unique t + (lambda (prefix tag) + (concat "\\`" (regexp-quote prefix) ".+"))) + ;; Find nested citations anywhere. + (gnus-cite-match-attributions 'small nil + (lambda (prefix tag) + (concat "\\`" (regexp-quote prefix) ".+"))) + ;; Remove loose prefixes with too few lines. + (let ((alist gnus-cite-loose-prefix-alist) + entry prefix) + (while alist + (setq entry (car alist) + alist (cdr alist)) + (if (< (length (cdr entry)) gnus-cite-minimum-match-count) + (setq gnus-cite-prefix-alist + (delq entry gnus-cite-prefix-alist) + gnus-cite-loose-prefix-alist + (delq entry gnus-cite-loose-prefix-alist))))) + ;; Find flat attributions. + (gnus-cite-match-attributions 'first t nil) + ;; Find any attributions (are we getting desperate yet?). + (gnus-cite-match-attributions 'first nil nil)) + + (defun gnus-cite-match-attributions (sort after fun) + ;; Match all loose attributions and citations (SORT AFTER FUN) . + ;; + ;; If SORT is `small', the citation with the shortest prefix will be + ;; used, if it is `first' the first prefix will be used, if it is + ;; `small-if-unique' the shortest prefix will be used if the + ;; attribution line does not share its own prefix with other + ;; loose attribution lines, otherwise the first prefix will be used. + ;; + ;; If AFTER is non-nil, only citations after the attribution line + ;; will be concidered. + ;; + ;; If FUN is non-nil, it will be called with the arguments (WROTE + ;; PREFIX TAG) and expected to return a regular expression. Only + ;; citations whose prefix matches the regular expression will be + ;; concidered. + ;; + ;; WROTE is the attribution line number. + ;; PREFIX is the attribution line prefix. + ;; TAG is the SuperCite tag on the attribution line. + (let ((atts gnus-cite-loose-attribution-alist) + (case-fold-search t) + att wrote in prefix tag regexp limit smallest best size aprefix) + (while atts + (setq att (car atts) + atts (cdr atts) + wrote (nth 0 att) + in (nth 1 att) + prefix (nth 2 att) + tag (nth 3 att) + regexp (if fun (funcall fun prefix tag) "") + size (cond ((eq sort 'small) t) + ((eq sort 'first) nil) + (t (< (length (gnus-cite-find-loose prefix)) 2))) + limit (if after wrote -1) + smallest 1000000 + best nil) + (let ((cites gnus-cite-loose-prefix-alist) + cite candidate numbers first compare) + (while cites + (setq cite (car cites) + cites (cdr cites) + candidate (car cite) + numbers (cdr cite) + first (apply 'min numbers) + compare (if size (length candidate) first)) + (and (> first limit) + regexp + (string-match regexp candidate) + (< compare smallest) + (setq best cite + smallest compare)))) + (if (null best) + () + (setq gnus-cite-loose-attribution-alist + (delq att gnus-cite-loose-attribution-alist)) + (setq gnus-cite-attribution-alist + (cons (cons wrote (car best)) gnus-cite-attribution-alist)) + (if in + (setq gnus-cite-attribution-alist + (cons (cons in (car best)) gnus-cite-attribution-alist))) + (if (memq best gnus-cite-loose-prefix-alist) + (let ((loop gnus-cite-prefix-alist) + (numbers (cdr best)) + current) + (setq gnus-cite-loose-prefix-alist + (delq best gnus-cite-loose-prefix-alist)) + (while loop + (setq current (car loop) + loop (cdr loop)) + (if (eq current best) + () + (setcdr current (gnus-set-difference (cdr current) numbers)) + (if (null (cdr current)) + (setq gnus-cite-loose-prefix-alist + (delq current gnus-cite-loose-prefix-alist) + atts (delq current atts))))))))))) + + (defun gnus-cite-find-loose (prefix) + ;; Return a list of loose attribution lines prefixed by PREFIX. + (let* ((atts gnus-cite-loose-attribution-alist) + att line lines candidate) + (while atts + (setq att (car atts) + line (car att) + atts (cdr atts)) + (if (string-equal (gnus-cite-find-prefix line) prefix) + (setq lines (cons line lines)))) + lines)) + + (defun gnus-cite-add-face (number prefix face) + ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. + (if face + (let (from to) + (goto-line number) + (forward-char (length prefix)) + (skip-chars-forward " \t") + (setq from (point)) + (end-of-line 1) + (skip-chars-backward " \t") + (setq to (point)) + (if (< from to) + (overlay-put (make-overlay from to) 'face face))))) + + (defun gnus-cite-toggle (prefix) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil) + (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) + number) + (while numbers + (setq number (car numbers) + numbers (cdr numbers)) + (goto-line number) + (cond ((get-text-property (point) 'invisible) + (put-text-property (point) (progn (forward-line 1) (point)) + 'invisible nil)) + ((assq number gnus-cite-attribution-alist)) + (t + (put-text-property (point) (progn (forward-line 1) (point)) + 'invisible t))))))) + + (defun gnus-signature-toggle (end) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (if (get-text-property end 'invisible) + (put-text-property end (point-max) 'invisible nil) + (put-text-property end (point-max) 'invisible t))))) + + (defun gnus-cite-find-prefix (line) + ;; Return citation prefix for LINE. + (let ((alist gnus-cite-prefix-alist) + (prefix "") + entry) + (while alist + (setq entry (car alist) + alist (cdr alist)) + (if (memq line (cdr entry)) + (setq prefix (car entry)))) + prefix)) + + (defun gnus-make-face (color) + ;; Create entry for face with background COLOR. + (let ((name (intern (concat "gnus " color)))) + (make-face name) + (if gnus-make-foreground + (set-face-foreground name color) + (set-face-background name color)) + name)) + + (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 (car alist) + alist (cdr 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)) + (fun (nth 3 entry)) + (args (mapcar (lambda (group) + (let ((string (buffer-substring + (match-beginning group) + (match-end group)))) + (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 + (message "You must define `%S' to use this button" + (cons fun args))))))) + + (defun gnus-button-message-id (message-id) + ;; Push on MESSAGE-ID. + (save-excursion + (switch-to-buffer gnus-article-buffer) + (set-buffer gnus-summary-buffer) + (gnus-summary-refer-article message-id))) + + ;;; Compatibility Functions: + + (or (fboundp 'rassoc) + (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))) + + (provide 'gnus-hilit) + + ;;; gnus-hilit.el ends here + + diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-msg.el dgnus/lisp/gnus-msg.el *** pub/dgnus/lisp/gnus-msg.el Sun Apr 30 22:46:16 1995 --- dgnus/lisp/gnus-msg.el Sat May 6 04:12:03 1995 *************** *** 271,282 **** gnus-use-followup-to)) (if post (progn ! (gnus-configure-windows '(1 0 0)) (switch-to-buffer gnus-post-news-buffer)) ! (gnus-configure-windows '(0 1 0)) (if (not yank) (progn ! (switch-to-buffer article-buffer) (pop-to-buffer gnus-post-news-buffer)) (switch-to-buffer gnus-post-news-buffer))) (gnus-overload-functions) --- 271,289 ---- gnus-use-followup-to)) (if post (progn ! (or ! (and gnus-split-window (split-window-vertically)) ! (gnus-configure-windows '(1 0 0))) (switch-to-buffer gnus-post-news-buffer)) ! (or (and gnus-split-window ! (pop-to-buffer gnus-article-buffer) ! (split-window-vertically) ! (pop-to-buffer gnus-summary-buffer) ! ) ! (gnus-configure-windows '(0 1 0))) (if (not yank) (progn ! (or gnus-split-window (switch-to-buffer article-buffer)) (pop-to-buffer gnus-post-news-buffer)) (switch-to-buffer gnus-post-news-buffer))) (gnus-overload-functions) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-score.el dgnus/lisp/gnus-score.el *** pub/dgnus/lisp/gnus-score.el Sun Apr 30 22:46:16 1995 --- dgnus/lisp/gnus-score.el Sat May 6 05:04:32 1995 *************** *** 166,175 **** (define-prefix-command 'gnus-summary-inc-fol-map) (define-key gnus-summary-increase-map "f" 'gnus-summary-inc-fol-map) ! (define-key gnus-summary-increase-map "F" 'gnus-summary-raise-followups-to-author) ! (define-key gnus-summary-inc-fol-map "f" 'gnus-summary-raise-followups-to-author) (define-key gnus-summary-inc-fol-map "F" 'gnus-summary-raise-followups-to-author) ! (define-key gnus-summary-inc-fol-map "t" 'gnus-summary-raise-followups-to-author) (define-key gnus-summary-inc-fol-map "p" 'gnus-summary-raise-followups-to-author) --- 166,175 ---- (define-prefix-command 'gnus-summary-inc-fol-map) (define-key gnus-summary-increase-map "f" 'gnus-summary-inc-fol-map) ! (define-key gnus-summary-increase-map "F" 'gnus-summary-temporarily-raise-followups-to-author) ! (define-key gnus-summary-inc-fol-map "f" 'gnus-summary-temporarily-raise-followups-to-author) (define-key gnus-summary-inc-fol-map "F" 'gnus-summary-raise-followups-to-author) ! (define-key gnus-summary-inc-fol-map "t" 'gnus-summary-temporarily-raise-followups-to-author) (define-key gnus-summary-inc-fol-map "p" 'gnus-summary-raise-followups-to-author) *************** *** 230,239 **** (define-prefix-command 'gnus-summary-low-fol-map) (define-key gnus-summary-lower-map "f" 'gnus-summary-low-fol-map) ! (define-key gnus-summary-lower-map "F" 'gnus-summary-lower-followups-to-author) ! (define-key gnus-summary-low-fol-map "f" 'gnus-summary-lower-followups-to-author) (define-key gnus-summary-low-fol-map "F" 'gnus-summary-lower-followups-to-author) ! (define-key gnus-summary-low-fol-map "t" 'gnus-summary-lower-followups-to-author) (define-key gnus-summary-low-fol-map "p" 'gnus-summary-lower-followups-to-author) --- 230,239 ---- (define-prefix-command 'gnus-summary-low-fol-map) (define-key gnus-summary-lower-map "f" 'gnus-summary-low-fol-map) ! (define-key gnus-summary-lower-map "F" 'gnus-summary-temporarily-lower-followups-to-author) ! (define-key gnus-summary-low-fol-map "f" 'gnus-summary-temporarily-lower-followups-to-author) (define-key gnus-summary-low-fol-map "F" 'gnus-summary-lower-followups-to-author) ! (define-key gnus-summary-low-fol-map "t" 'gnus-summary-temporarily-lower-followups-to-author) (define-key gnus-summary-low-fol-map "p" 'gnus-summary-lower-followups-to-author) *************** *** 402,407 **** --- 402,414 ---- "references" (gnus-summary-header "message-id") nil (- (gnus-score-default level)) (current-time-string))) + (defun gnus-summary-temporarily-lower-followups-to-author (level) + "Lower score by LEVEL for all followups to the current author." + (interactive "P") + (gnus-summary-score-entry + "followup" (gnus-summary-header "from") + nil (- (gnus-score-default level)) (current-time-string) t t)) + (defun gnus-summary-lower-by-subject (level) "Lower score by LEVEL for current subject." (interactive "P") *************** *** 440,446 **** (interactive "P") (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil (gnus-score-default level) (current-time-string) t t)) (defun gnus-summary-temporarily-raise-by-subject (level) "Temporarily raise score by LEVEL for current subject. --- 447,453 ---- (interactive "P") (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil (- (gnus-score-default level)) nil t t)) (defun gnus-summary-temporarily-raise-by-subject (level) "Temporarily raise score by LEVEL for current subject. *************** *** 485,490 **** --- 492,504 ---- "references" (gnus-summary-header "message-id") nil level (current-time-string))) + (defun gnus-summary-temporarily-raise-followups-to-author (level) + "Raise score by LEVEL for all followups to the current author." + (interactive "P") + (gnus-summary-score-entry + "followup" (gnus-summary-header "from") + nil (gnus-score-default level) (current-time-string) t t)) + (defun gnus-summary-raise-by-subject (level) "Raise score by LEVEL for current subject." (interactive "P") *************** *** 519,525 **** (interactive "P") (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil (gnus-score-default level) (current-time-string) t t)) --- 533,539 ---- (interactive "P") (gnus-summary-score-entry "followup" (gnus-summary-header "from") ! nil (gnus-score-default level) nil t t)) *************** *** 664,670 **** files)))) (and eval (not global) (eval eval)) (setq gnus-scores-exclude-files exclude-files) ! (if orphan (setq gnus-orphan-score (car orphan))) (setq gnus-adaptive-score-alist (cond ((equal adapt '(t)) gnus-default-adaptive-score-alist) --- 678,684 ---- files)))) (and eval (not global) (eval eval)) (setq gnus-scores-exclude-files exclude-files) ! (if orphan (setq gnus-orphan-score orphan)) (setq gnus-adaptive-score-alist (cond ((equal adapt '(t)) gnus-default-adaptive-score-alist) *************** *** 790,796 **** score (cdr entry)) (if (or (not (equal (gnus-score-get 'touched score) '(t))) (gnus-score-get 'read-only score) ! (not (file-writable-p file))) () (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) --- 804,811 ---- score (cdr entry)) (if (or (not (equal (gnus-score-get 'touched score) '(t))) (gnus-score-get 'read-only score) ! (and (file-exists-p file) ! (not (file-writable-p file)))) () (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) *************** *** 1478,1481 **** (provide 'gnus-score) ! ;;; gnus-score.el ends here \ No newline at end of file --- 1493,1496 ---- (provide 'gnus-score) ! ;;; gnus-score.el ends here diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-uu.el dgnus/lisp/gnus-uu.el *** pub/dgnus/lisp/gnus-uu.el Sun Apr 30 22:46:16 1995 --- dgnus/lisp/gnus-uu.el Sat May 6 03:16:35 1995 *************** *** 258,263 **** --- 258,311 ---- (defconst gnus-uu-highest-article-number 1) (defvar gnus-uu-default-dir default-directory) + ;; Keymaps + + (defvar gnus-uu-extract-map nil) + (defvar gnus-uu-extract-view-map nil) + (defvar gnus-uu-mark-map nil) + + (define-prefix-command 'gnus-summary-process-map) + (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map) + (define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable) + (define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable) + (define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable) + (define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series) + (define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region) + (define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp) + (define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread) + (define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all) + (define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse) + + (define-prefix-command 'gnus-uu-extract-map) + (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) + ; (define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any) + ; (define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime) + (define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu) + (define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save) + (define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar) + (define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save) + (define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save) + (define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save) + (define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex) + (define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex) + (define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript) + (define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save) + + (define-prefix-command 'gnus-uu-extract-view-map) + (define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map) + (define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view) + (define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) + (define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view) + (define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) + (define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view) + (define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view) + (define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view) + (define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view) + (define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view) + (define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) + + + ;; Commands. (defun gnus-uu-decode-uu (n) *************** *** 1392,1397 **** --- 1440,1446 ---- (gnus-uu-add-file gnus-uu-work-dir) (if (not (file-directory-p gnus-uu-work-dir)) (make-directory gnus-uu-work-dir)) + (set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/"))) ;; Kills the temporary uu buffers, kills any processes, etc. diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-vis.el dgnus/lisp/gnus-vis.el *** pub/dgnus/lisp/gnus-vis.el Sun Apr 30 22:46:16 1995 --- dgnus/lisp/gnus-vis.el Sat May 6 04:56:00 1995 *************** *** 91,96 **** --- 91,100 ---- ["Group apropos" gnus-group-apropos t] ["Group and description apropos" gnus-group-description-apropos t] ["List groups matching..." gnus-group-list-matching t]) + ("Mark" + ["Mark group" gnus-group-mark-group t] + ["Unmark group" gnus-group-unmark-group t] + ["Mark region" gnus-group-mark-region t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] *************** *** 127,132 **** --- 131,137 ---- ["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] ["Edit the global kill file" gnus-group-edit-global-kill t] ["Expire all expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] *************** *** 142,147 **** --- 147,168 ---- ) + (defun gnus-server-make-menu-bar () + (easy-menu-define + gnus-server-menu + gnus-server-mode-map + "" + '("Server" + ["Add" gnus-server-add-server t] + ["Browse" gnus-server-read-server t] + ["List" gnus-server-list-servers t] + ["Kill" gnus-server-kill-server t] + ["Yank" gnus-server-yank-server t] + ["Copy" gnus-server-copy-server t] + ["Edit" gnus-server-edit-server t] + ["Exit" gnus-server-exit t] + ))) + ;; Summary buffer (defun gnus-summary-make-menu-bar () *************** *** 279,285 **** ["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]) ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] --- 300,307 ---- ["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]) ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] *************** *** 337,342 **** --- 359,366 ---- gnus-summary-temporarily-raise-by-thread t] ["Raise score with current crossposting" gnus-summary-temporarily-raise-by-xref t] + ["Raise score for followups to current author" + gnus-summary-temporarily-raise-followups-to-author t] ["Permanently raise score with current subject" gnus-summary-raise-by-subject t] ["Permanently raise score with current author" *************** *** 353,358 **** --- 377,384 ---- gnus-summary-temporarily-lower-by-thread t] ["Lower score with current crossposting" gnus-summary-temporarily-lower-by-xref t] + ["Lower score for followups to current author" + gnus-summary-temporarily-lower-followups-to-author t] ["Permanently lower score with current subject" gnus-summary-lower-by-subject t] ["Permanently lower score with current author" *************** *** 450,456 **** gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) ! (mark (get-text-property beg 'gnus-mark)) (inhibit-read-only t)) (while (and list (not (eval (car (car list))))) (setq list (cdr list))) --- 476,482 ---- gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) ! (mark (car (cdr (get-text-property beg 'gnus)))) (inhibit-read-only t)) (while (and list (not (eval (car (car list))))) (setq list (cdr list))) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus.el dgnus/lisp/gnus.el *** pub/dgnus/lisp/gnus.el Sun Apr 30 22:46:18 1995 --- dgnus/lisp/gnus.el Sat May 6 06:05:01 1995 *************** *** 485,491 **** (defvar gnus-level-unsubscribed 7 "*Groups with levels less than or equal to this variable are unsubscribed. Groups with levels less than `gnus-level-subscribed', which should be ! less than thiss variable, are subscribed.") (defvar gnus-level-zombie 8 "*Groups with this level are zombie groups.") --- 485,491 ---- (defvar gnus-level-unsubscribed 7 "*Groups with levels less than or equal to this variable are unsubscribed. Groups with levels less than `gnus-level-subscribed', which should be ! less than this variable, are subscribed.") (defvar gnus-level-zombie 8 "*Groups with this level are zombie groups.") *************** *** 949,955 **** This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format "* : : %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. --- 949,955 ---- This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format "* : : %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. *************** *** 1116,1121 **** --- 1116,1122 ---- `gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") (add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) (add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) + (add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) (defvar gnus-article-x-face-command "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -" *************** *** 1317,1323 **** (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.63" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1318,1324 ---- (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.64" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1392,1397 **** --- 1393,1400 ---- (defvar gnus-moderated-list nil "List of moderated newsgroups.") + (defvar gnus-group-marked nil) + (defvar gnus-current-startup-file nil "Startup file for the current host.") *************** *** 1508,1573 **** ;; Define some autoload functions Gnus might use. (eval-and-compile (autoload 'metamail-buffer "metamail") (autoload 'Info-goto-node "info") (autoload 'hexl-hex-string-to-integer "hexl") ! (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-fix-time "timezone") (autoload 'timezone-make-sortable-date "timezone") (autoload 'timezone-make-time-string "timezone") ! ! (autoload 'rmail-output "rmailout") (autoload 'mail-position-on-field "sendmail") (autoload 'mail-setup "sendmail") (autoload 'news-mail-other-window "rnewspost") (autoload 'news-reply-yank-original "rnewspost") (autoload 'news-caesar-buffer-body "rnewspost") - (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail") (autoload 'gnus-mail-reply-using-mhe "gnus-mh") (autoload 'gnus-mail-forward-using-mhe "gnus-mh") (autoload 'gnus-mail-other-window-using-mhe "gnus-mh") (autoload 'gnus-summary-save-in-folder "gnus-mh") (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ! (autoload 'gnus-group-make-menu-bar "gnus-vis") (autoload 'gnus-summary-make-menu-bar "gnus-vis") (autoload 'gnus-article-make-menu-bar "gnus-vis") (autoload 'gnus-visual-highlight-selected-summary "gnus-vis") (autoload 'gnus-visual-summary-highlight-line "gnus-vis") ! (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-region "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-thread "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-sparse "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-series "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-all "gnus-uu" nil t) ! (autoload 'gnus-uu-post-news "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t) ! ! (autoload 'gnus-uu-decode-uu "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-binhex "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-postscript "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-postscript-and-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-postscript-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-postscript-and-save-view "gnus-uu" nil t) (autoload 'gnus-kill "gnus-kill") (autoload 'gnus-apply-kill-file-internal "gnus-kill") (autoload 'gnus-kill-file-edit-file "gnus-kill") --- 1511,1568 ---- ;; Define some autoload functions Gnus might use. (eval-and-compile + + ;; Various (autoload 'metamail-buffer "metamail") (autoload 'Info-goto-node "info") (autoload 'hexl-hex-string-to-integer "hexl") ! (autoload 'pp "pp") ! (autoload 'pp-to-string "pp") ! (autoload 'mail-extract-address-components "mail-extr") ! ! ;; timezone (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'timezone-fix-time "timezone") (autoload 'timezone-make-sortable-date "timezone") (autoload 'timezone-make-time-string "timezone") ! ! ;; rmail & friends (autoload 'mail-position-on-field "sendmail") (autoload 'mail-setup "sendmail") + (autoload 'rmail-output "rmailout") (autoload 'news-mail-other-window "rnewspost") (autoload 'news-reply-yank-original "rnewspost") (autoload 'news-caesar-buffer-body "rnewspost") (autoload 'rmail-insert-rmail-file-header "rmail") (autoload 'rmail-count-new-messages "rmail") (autoload 'rmail-show-message "rmail") + ;; gnus-mh (autoload 'gnus-mail-reply-using-mhe "gnus-mh") (autoload 'gnus-mail-forward-using-mhe "gnus-mh") (autoload 'gnus-mail-other-window-using-mhe "gnus-mh") (autoload 'gnus-summary-save-in-folder "gnus-mh") (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ! ! ;; gnus-vis (autoload 'gnus-group-make-menu-bar "gnus-vis") (autoload 'gnus-summary-make-menu-bar "gnus-vis") + (autoload 'gnus-server-make-menu-bar "gnus-vis") (autoload 'gnus-article-make-menu-bar "gnus-vis") (autoload 'gnus-visual-highlight-selected-summary "gnus-vis") (autoload 'gnus-visual-summary-highlight-line "gnus-vis") ! ;; gnus-hilit ! (autoload 'gnus-article-push-button "gnus-hilit" nil t) ! (autoload 'gnus-article-highlight "gnus-hilit" nil t) ! (autoload 'gnus-article-hide "gnus-hilit" nil t) ! (autoload 'gnus-article-highlight-headers "gnus-hilit" nil t) ! (autoload 'gnus-article-highlight-citation "gnus-hilit" nil t) ! (autoload 'gnus-article-highlight-signature "gnus-hilit" nil t) ! (autoload 'gnus-article-add-buttons "gnus-hilit" nil t) + ;; gnus-kill (autoload 'gnus-kill "gnus-kill") (autoload 'gnus-apply-kill-file-internal "gnus-kill") (autoload 'gnus-kill-file-edit-file "gnus-kill") *************** *** 1575,1580 **** --- 1570,1576 ---- (autoload 'gnus-execute "gnus-kill") (autoload 'gnus-expunge "gnus-kill") + ;; gnus-cache (autoload 'gnus-cache-possibly-enter-article "gnus-cache") (autoload 'gnus-cache-save-buffers "gnus-cache") (autoload 'gnus-cache-possibly-remove-article "gnus-cache") *************** *** 1583,1592 **** (autoload 'gnus-cache-possibly-alter-active "gnus-cache") (autoload 'gnus-jog-cache "gnus-cache" nil t) ! (autoload 'pp "pp") ! (autoload 'pp-to-string "pp") ! (autoload 'mail-extract-address-components "mail-extr") ! (autoload 'gnus-summary-increase-map "gnus-score" nil nil 'keymap) (autoload 'gnus-summary-lower-map "gnus-score" nil nil 'keymap) (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap) --- 1579,1585 ---- (autoload 'gnus-cache-possibly-alter-active "gnus-cache") (autoload 'gnus-jog-cache "gnus-cache" nil t) ! ;; gnus-score (autoload 'gnus-summary-increase-map "gnus-score" nil nil 'keymap) (autoload 'gnus-summary-lower-map "gnus-score" nil nil 'keymap) (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap) *************** *** 1596,1601 **** --- 1589,1595 ---- (autoload 'gnus-score-adaptive "gnus-score") (autoload 'gnus-score-remove-lines-adaptive "gnus-score") + ;; gnus-msg (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap) (autoload 'gnus-group-post-news "gnus-msg" nil t) (autoload 'gnus-summary-post-news "gnus-msg" nil t) *************** *** 2425,2432 **** (kill-buffer (current-buffer))) (setq dirs (cdr dirs)))) (while olist ! (insert "(setq " (symbol-name (car olist)) " '" ! (prin1-to-string (symbol-value (car olist))) ")\n") (setq olist (cdr olist))) (insert "\n\n"))) --- 2419,2428 ---- (kill-buffer (current-buffer))) (setq dirs (cdr dirs)))) (while olist ! (if (boundp (car olist)) ! (insert "(setq " (symbol-name (car olist)) " '" ! (prin1-to-string (symbol-value (car olist))) ")\n") ! (insert ";; (makunbound 'b'" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) (insert "\n\n"))) *************** *** 2540,2545 **** --- 2536,2547 ---- (setq i (* 2 i))) (1- i))) + ;; Delete the current line (and the next N lines.); + (defun gnus-delete-line (&optional n) + (let ((n (or n 1))) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line n) (point))))) + ;;; List and range functions (defun gnus-last-element (list) *************** *** 2773,2779 **** ;;; (defvar gnus-group-mode-map nil) ! (defvar gnus-group-make-map nil) (defvar gnus-group-list-map nil) (defvar gnus-group-sub-map nil) (put 'gnus-group-mode 'mode-class 'special) --- 2775,2782 ---- ;;; (defvar gnus-group-mode-map nil) ! (defvar gnus-group-group-map nil) ! (defvar gnus-group-mark-map nil) (defvar gnus-group-list-map nil) (defvar gnus-group-sub-map nil) (put 'gnus-group-mode 'mode-class 'special) *************** *** 2840,2858 **** (define-key gnus-group-mode-map ">" 'end-of-buffer) (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug) ! (define-prefix-command 'gnus-group-make-map) ! (define-key gnus-group-mode-map "M" 'gnus-group-make-map) ! (define-key gnus-group-make-map "d" 'gnus-group-make-directory-group) ! (define-key gnus-group-make-map "h" 'gnus-group-make-help-group) ! (define-key gnus-group-make-map "a" 'gnus-group-make-archive-group) ! (define-key gnus-group-make-map "k" 'gnus-group-make-kiboze-group) ! (define-key gnus-group-make-map "m" 'gnus-group-make-group) ! (define-key gnus-group-make-map "E" 'gnus-group-edit-group) ! (define-key gnus-group-make-map "e" 'gnus-group-edit-group-method) ! (define-key gnus-group-make-map "p" 'gnus-group-edit-group-parameters) (define-prefix-command 'gnus-group-list-map) ! (define-key gnus-group-mode-map "G" 'gnus-group-list-map) (define-key gnus-group-list-map "k" 'gnus-group-list-killed) (define-key gnus-group-list-map "z" 'gnus-group-list-zombies) (define-key gnus-group-list-map "s" 'gnus-group-list-groups) --- 2843,2869 ---- (define-key gnus-group-mode-map ">" 'end-of-buffer) (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug) ! (define-key gnus-group-mode-map "#" 'gnus-group-mark-group) ! (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group) ! (define-prefix-command 'gnus-group-mark-map) ! (define-key gnus-group-mode-map "M" 'gnus-group-mark-map) ! (define-key gnus-group-mark-map "m" 'gnus-group-mark-group) ! (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group) ! (define-key gnus-group-mark-map "w" 'gnus-group-mark-region) ! ! (define-prefix-command 'gnus-group-group-map) ! (define-key gnus-group-mode-map "G" 'gnus-group-group-map) ! (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group) ! (define-key gnus-group-group-map "h" 'gnus-group-make-help-group) ! (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group) ! (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group) ! (define-key gnus-group-group-map "m" 'gnus-group-make-group) ! (define-key gnus-group-group-map "E" 'gnus-group-edit-group) ! (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method) ! (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters) (define-prefix-command 'gnus-group-list-map) ! (define-key gnus-group-mode-map "A" 'gnus-group-list-map) (define-key gnus-group-list-map "k" 'gnus-group-list-killed) (define-key gnus-group-list-map "z" 'gnus-group-list-zombies) (define-key gnus-group-list-map "s" 'gnus-group-list-groups) *************** *** 3408,3414 **** (if pos (goto-char pos) (goto-char beg)) nil))) ! ;; Gnus group mode commands (defun gnus-group-read-group (all &optional no-article group) "Read news in this newsgroup. --- 3419,3495 ---- (if pos (goto-char pos) (goto-char beg)) nil))) ! ;;; Gnus group mode commands ! ! ;; Group marking. ! ! (defun gnus-group-mark-group (n &optional unmark) ! "Mark the current group." ! (interactive "p") ! (let ((buffer-read-only nil) ! group) ! (while (and (> n 0) (setq group (gnus-group-group-name))) ! (beginning-of-line) ! (forward-char 1) ! (delete-char 1) ! (if unmark ! (progn ! (insert " ") ! (setq gnus-group-marked (delete group gnus-group-marked))) ! (insert "#") ! (setq gnus-group-marked (cons group gnus-group-marked))) ! (forward-line 1) ! (setq n (1- n))) ! (gnus-summary-position-cursor) ! n)) ! ! (defun gnus-group-unmark-group (n) ! "Remove the mark from the current group." ! (interactive "p") ! (gnus-group-mark-group n 'unmark)) ! ! (defun gnus-group-mark-region (unmark beg end) ! "Mark all groups between point and mark. ! If UNMARK, remove the mark instead." ! (interactive "P\nr") ! (let ((num (count-lines beg end))) ! (save-excursion ! (goto-char beg) ! (- num (gnus-group-mark-group num unmark))))) ! ! (defun gnus-group-remove-mark (group) ! (and (gnus-group-goto-group group) ! (save-excursion ! (gnus-group-mark-group 1 'unmark)))) ! ! ;; Return a list of groups to work on. Take into consideration N (the ! ;; prefix) and the list of marked groups. ! (defun gnus-group-process-prefix (n) ! (cond (n ! ;; There is a prefix, so we return a list of the N next ! ;; groups. ! (let ((way (if (< n 0) -1 1)) ! (n (abs n)) ! group groups) ! (save-excursion ! (while (and (> n 0) ! (setq group (gnus-group-group-name))) ! (setq groups (cons group groups)) ! (setq n (1- n)) ! (forward-line way))) ! (nreverse groups))) ! (gnus-group-marked ! ;; No prefix, but a list of marked articles. ! (reverse gnus-group-marked)) ! (t ! ;; Neither marked articles or a prefix, so we return the ! ;; current group. ! (let ((group (gnus-group-group-name))) ! (and group (list group)))))) ! ! ! ! ;; Selecting groups. (defun gnus-group-read-group (all &optional no-article group) "Read news in this newsgroup. *************** *** 3464,3469 **** --- 3545,3556 ---- ;; Adjust cursor point. (gnus-group-position-cursor)) + (defun gnus-group-goto-group (group) + "Goto to newsgroup GROUP." + (let ((b (text-property-any (point-min) (point-max) + 'gnus-group (intern group)))) + (and b (goto-char b)))) + (defun gnus-group-next-group (n) "Go to next N'th newsgroup. If N is negative, search backward instead. *************** *** 3527,3533 **** If EXCLUDE-GROUP, do not go to that group." (interactive) (goto-char (point-min)) ! (let ((best 10) unread best-point) (while (setq unread (get-text-property (point) 'gnus-unread)) (if (and (numberp unread) (> unread 0)) --- 3614,3620 ---- If EXCLUDE-GROUP, do not go to that group." (interactive) (goto-char (point-min)) ! (let ((best 100000) unread best-point) (while (setq unread (get-text-property (point) 'gnus-unread)) (if (and (numberp unread) (> unread 0)) *************** *** 3548,3554 **** "Go to the first group with unread articles." (interactive) (goto-char (point-min)) ! (or (get-text-property (point) 'gnus-unread) (gnus-group-next-unread-group 1)) (gnus-group-position-cursor)) --- 3635,3641 ---- "Go to the first group with unread articles." (interactive) (goto-char (point-min)) ! (or (not (zerop (or (get-text-property (point) 'gnus-unread) 0))) (gnus-group-next-unread-group 1)) (gnus-group-position-cursor)) *************** *** 3777,3804 **** read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned." ! (interactive "p") ! (if (or (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Do you really want to mark all articles as read? " ! "Mark all unread articles as read? "))) ! (progn ! (while ! (and (> n 0) ! (progn ! (setq n (1- n)) ! (gnus-group-catchup (gnus-group-group-name) all) ! (gnus-group-update-group-line) ! t) ! (zerop (gnus-group-next-unread-group 1)))))) ! n) (defun gnus-group-catchup-current-all (n) "Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored." ! (interactive "p") (gnus-group-catchup-current n 'all)) (defun gnus-group-catchup (group &optional all) --- 3864,3892 ---- read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned." ! (interactive "P") ! (if (not (or (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Do you really want to mark all articles as read? " ! "Mark all unread articles as read? ")))) ! n ! (let ((groups (gnus-group-process-prefix n)) ! (ret 0)) ! (while groups ! (gnus-group-remove-mark (car groups)) ! (if (not (gnus-group-goto-group (car groups))) ! (setq ret (1+ ret)) ! (gnus-group-catchup (car groups) all) ! (gnus-group-update-group-line)) ! (setq groups (cdr groups))) ! ret))) (defun gnus-group-catchup-current-all (n) "Mark all articles in current newsgroup as read. Cross references (Xref: header) of articles are ignored." ! (interactive "P") (gnus-group-catchup-current n 'all)) (defun gnus-group-catchup (group &optional all) *************** *** 3822,3867 **** (delq (assq 'dormant marked) marked)))))) num)) ! (defun gnus-group-expire-articles (newsgroup) "Expire all expirable articles in the current newsgroup." ! (interactive (list (gnus-group-group-name))) ! (if (not newsgroup) (error "No current newsgroup")) ! (let ((expirable ! (assq 'expire (nth 3 (nth 2 (gnus-gethash newsgroup ! gnus-newsrc-hashtb)))))) ! (and expirable ! (gnus-check-backend-function 'request-expire-articles newsgroup) ! (setcdr expirable ! (gnus-request-expire-articles (cdr expirable) newsgroup))))) (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." (interactive) (message "Expiring...") ! (let ((newsrc (cdr gnus-newsrc-alist))) ! (while newsrc ! (gnus-group-expire-articles (car (car newsrc))) ! (setq newsrc (cdr newsrc)))) (message "Expiring...done")) (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive "p\nnLevel: ") (or (and (>= level 1) (<= level gnus-level-killed)) (error "Illegal level: %d" level)) ! (let (group) ! (while (and (> n 0) ! (setq group (gnus-group-group-name))) ! (and (setq group (gnus-group-group-name)) ! (message "Changed level of %s from %d to %d" ! group (gnus-group-group-level) level) ! (gnus-group-change-level group level (gnus-group-group-level)) ! (gnus-group-update-group-line)) ! (forward-line 1) ! (setq n (1- n)))) ! (gnus-group-position-cursor) ! n) (defun gnus-group-unsubscribe-current-group (arg) "Toggle subscribe from/to unsubscribe current group." --- 3910,3960 ---- (delq (assq 'dormant marked) marked)))))) num)) ! (defun gnus-group-expire-articles (n) "Expire all expirable articles in the current newsgroup." ! (interactive "P") ! (let ((groups (gnus-group-process-prefix n)) ! group) ! (and groups (error "No groups to expire")) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) ! (let ((expirable (assq 'expire ! (nth 3 (nth 2 (gnus-gethash ! group gnus-newsrc-hashtb)))))) ! (and expirable ! (gnus-check-backend-function 'request-expire-articles group) ! (setcdr expirable ! (gnus-request-expire-articles ! (cdr expirable) group))))))) (defun gnus-group-expire-all-groups () "Expire all expirable articles in all newsgroups." (interactive) (message "Expiring...") ! (let ((gnus-group-marked (mapcar (lambda (info) (car info)) ! (cdr gnus-newsrc-alist)))) ! (gnus-group-expire-articles nil)) (message "Expiring...done")) (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive "P\nnLevel: ") (or (and (>= level 1) (<= level gnus-level-killed)) (error "Illegal level: %d" level)) ! (let ((groups (gnus-group-process-prefix n)) ! group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) ! (message "Changed level of %s from %d to %d" ! group (gnus-group-group-level) level) ! (and (gnus-group-change-level group level (gnus-group-group-level)) ! (gnus-group-update-group-line)))) ! (gnus-group-position-cursor)) (defun gnus-group-unsubscribe-current-group (arg) "Toggle subscribe from/to unsubscribe current group." *************** *** 3959,3983 **** The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. ! The return value is the name of the (last) newsgroup that was killed." ! (interactive "p") (let ((buffer-read-only nil) group entry level) ! (while (>= (setq n (1- n)) 0) ! (setq group (gnus-group-group-name)) ! (or group ! (signal 'end-of-buffer nil)) (setq level (gnus-group-group-level)) ! (beginning-of-line) ! (delete-region (point) (progn (forward-line 1) (point))) (if (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (setq gnus-list-of-killed-groups (cons (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups))) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level))) - (if (eobp) - (forward-line -1)) (gnus-group-position-cursor) group)) --- 4052,4074 ---- The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. ! The return value is the name of the (last) group that was killed." ! (interactive "P") (let ((buffer-read-only nil) + (groups (gnus-group-process-prefix n)) group entry level) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) (setq level (gnus-group-group-level)) ! (gnus-delete-line) (if (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (setq gnus-list-of-killed-groups (cons (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups))) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level))) (gnus-group-position-cursor) group)) *************** *** 4014,4022 **** (defun gnus-group-list-all-groups (arg) "List all newsgroups with level ARG or lower. ! Default is 7, which lists all subscribed and most unsubscribed groups." (interactive "P") ! (setq arg (or arg 7)) (gnus-group-list-groups arg t)) (defun gnus-group-list-killed () --- 4105,4114 ---- (defun gnus-group-list-all-groups (arg) "List all newsgroups with level ARG or lower. ! Default is gnus-level-unsubscribed, which lists all subscribed and most ! unsubscribed groups." (interactive "P") ! (setq arg (or arg gnus-level-unsubscribed)) (gnus-group-list-groups arg t)) (defun gnus-group-list-killed () *************** *** 4058,4085 **** "Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked." ! (interactive "p") ! (let ((way (if (< n 0) -1 1)) ! (n (abs n)) ! (w-p (window-start)) ! group) ! (while (and (> n 0) ! (progn ! (or (gnus-get-new-news-in-group ! (setq group (gnus-group-group-name))) ! (progn ! (ding) ! (message "%s error: %s" ! group (gnus-status-message group)))) ! t) ! (zerop (gnus-group-next-group way))) ! (setq n (1- n))) ! (if (/= 0 n) (message "No more newsgroups")) ;; !!! I don't know why the buffer scrolls forward when updating ;; the first line in the group buffer, but it does. So we set the ;; window start forcibly. (set-window-start (get-buffer-window (current-buffer)) w-p) ! n)) (defun gnus-get-new-news-in-group (group) (and group --- 4150,4176 ---- "Check for newly arrived news in the current group (and the N-1 next groups). The difference between N and the number of newsgroup checked is returned. If N is negative, this group and the N-1 previous groups will be checked." ! (interactive "P") ! (let* ((groups (gnus-group-process-prefix n)) ! (ret (if (numberp n) (- n (length groups)) 0)) ! (w-p (window-start)) ! group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) ! (or (gnus-get-new-news-in-group group) ! (progn ! (ding) ! (message "%s error: %s" group (gnus-status-message group)) ! (sit-for 2)))) ;; !!! I don't know why the buffer scrolls forward when updating ;; the first line in the group buffer, but it does. So we set the ;; window start forcibly. (set-window-start (get-buffer-window (current-buffer)) w-p) ! (forward-line 1) ! (gnus-summary-position-cursor) ! ret)) (defun gnus-get-new-news-in-group (group) (and group *************** *** 4093,4099 **** (defun gnus-group-fetch-faq (group) "Fetch the FAQ for the current group." ! (interactive (list (gnus-group-group-name))) (or group (error "No group name given")) (let ((file (concat gnus-group-faq-directory group))) (if (not (file-exists-p file)) --- 4184,4190 ---- (defun gnus-group-fetch-faq (group) "Fetch the FAQ for the current group." ! (interactive (list (gnus-group-real-name (gnus-group-group-name)))) (or group (error "No group name given")) (let ((file (concat gnus-group-faq-directory group))) (if (not (file-exists-p file)) *************** *** 4538,4552 **** (defvar gnus-summary-mode-map nil) (defvar gnus-summary-mark-map nil) (defvar gnus-summary-mscore-map nil) - (defvar gnus-summary-extract-map nil) - (defvar gnus-summary-extract-view-map nil) (defvar gnus-summary-article-map nil) (defvar gnus-summary-thread-map nil) (defvar gnus-summary-goto-map nil) (defvar gnus-summary-exit-map nil) (defvar gnus-summary-various-map nil) (defvar gnus-summary-interest-map nil) - (defvar gnus-summary-process-map nil) (defvar gnus-summary-sort-map nil) (defvar gnus-summary-backend-map nil) (defvar gnus-summary-save-map nil) --- 4629,4640 ---- *************** *** 4686,4702 **** (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above) (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below) ! (define-prefix-command 'gnus-summary-process-map) ! (define-key gnus-summary-mark-map "p" 'gnus-summary-process-map) ! (define-key gnus-summary-process-map "p" 'gnus-summary-mark-as-processable) ! (define-key gnus-summary-process-map "u" 'gnus-summary-unmark-as-processable) ! (define-key gnus-summary-process-map "U" 'gnus-summary-unmark-all-processable) ! (define-key gnus-summary-process-map "s" 'gnus-uu-mark-series) ! (define-key gnus-summary-process-map "r" 'gnus-uu-mark-region) ! (define-key gnus-summary-process-map "R" 'gnus-uu-mark-by-regexp) ! (define-key gnus-summary-process-map "t" 'gnus-uu-mark-thread) ! (define-key gnus-summary-process-map "a" 'gnus-uu-mark-all) ! (define-key gnus-summary-process-map "S" 'gnus-uu-mark-sparse) (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) --- 4774,4780 ---- (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above) (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below) ! (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map) (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) *************** *** 4781,4786 **** --- 4859,4871 ---- (define-key gnus-summary-wash-map "\C-t" 'gnus-article-date-local) (define-key gnus-summary-wash-map "T" 'gnus-article-date-lapsed) + (define-key gnus-summary-wash-map "A" 'gnus-article-highlight) + (define-key gnus-summary-wash-map "a" 'gnus-article-hide) + (define-key gnus-summary-wash-map "H" 'gnus-article-highlight-headers) + (define-key gnus-summary-wash-map "C" 'gnus-article-highlight-citation) + (define-key gnus-summary-wash-map "S" 'gnus-article-highlight-signature) + (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) + (define-prefix-command 'gnus-summary-help-map) (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map) *************** *** 4810,4845 **** (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) ! ! (define-prefix-command 'gnus-summary-extract-map) ! (define-key gnus-summary-mode-map "X" 'gnus-summary-extract-map) ! ; (define-key gnus-summary-extract-map "x" 'gnus-summary-extract-any) ! ; (define-key gnus-summary-extract-map "m" 'gnus-summary-extract-mime) ! (define-key gnus-summary-extract-map "u" 'gnus-uu-decode-uu) ! (define-key gnus-summary-extract-map "U" 'gnus-uu-decode-uu-and-save) ! (define-key gnus-summary-extract-map "s" 'gnus-uu-decode-unshar) ! (define-key gnus-summary-extract-map "S" 'gnus-uu-decode-unshar-and-save) ! (define-key gnus-summary-extract-map "o" 'gnus-uu-decode-save) ! (define-key gnus-summary-extract-map "O" 'gnus-uu-decode-save) ! (define-key gnus-summary-extract-map "b" 'gnus-uu-decode-binhex) ! (define-key gnus-summary-extract-map "B" 'gnus-uu-decode-binhex) ! (define-key gnus-summary-extract-map "p" 'gnus-uu-decode-postscript) ! (define-key gnus-summary-extract-map "P" 'gnus-uu-decode-postscript-and-save) ! ! ! (define-prefix-command 'gnus-summary-extract-view-map) ! (define-key gnus-summary-extract-map "v" 'gnus-summary-extract-view-map) ! (define-key gnus-summary-extract-view-map "u" 'gnus-uu-decode-uu-view) ! (define-key gnus-summary-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) ! (define-key gnus-summary-extract-view-map "s" 'gnus-uu-decode-unshar-view) ! (define-key gnus-summary-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) ! (define-key gnus-summary-extract-view-map "o" 'gnus-uu-decode-save-view) ! (define-key gnus-summary-extract-view-map "O" 'gnus-uu-decode-save-view) ! (define-key gnus-summary-extract-view-map "b" 'gnus-uu-decode-binhex-view) ! (define-key gnus-summary-extract-view-map "B" 'gnus-uu-decode-binhex-view) ! (define-key gnus-summary-extract-view-map "p" 'gnus-uu-decode-postscript-view) ! (define-key gnus-summary-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) ! (define-prefix-command 'gnus-summary-various-map) (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map) --- 4895,4901 ---- (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) ! (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) (define-prefix-command 'gnus-summary-various-map) (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map) *************** *** 5379,5386 **** (goto-char (point-min)) (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" ! (regexp-quote id)))) (or found (beginning-of-line 2))) (if found (let (ref) --- 5435,5443 ---- (goto-char (point-min)) (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at ! (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" ! (regexp-quote id)))) (or found (beginning-of-line 2))) (if found (let (ref) *************** *** 5396,5401 **** --- 5453,5480 ---- gnus-newsgroup-ancient (cons (header-number header) gnus-newsgroup-ancient)))))) + ;; Re-build the thread containing ID. + (defun gnus-rebuild-thread (id) + (let ((dep gnus-newsgroup-dependencies) + (buffer-read-only nil) + parent headers refs thread art) + (while (and id (setq headers + (car (setq art (gnus-gethash (downcase id) dep))))) + (setq parent art) + (setq id (and (setq refs (header-references headers)) + (string-match "\\(<[^>]+>\\) *$" refs) + (substring refs (match-beginning 1) (match-end 1))))) + (setq thread (gnus-make-sub-thread (car parent))) + (gnus-rebuild-remove-articles thread) + (gnus-summary-prepare-threads (list thread) 0))) + + ;; Delete all lines in the summary buffer that correspond to articles + ;; in this thread. + (defun gnus-rebuild-remove-articles (thread) + (and (gnus-summary-goto-article (header-number (car thread))) + (gnus-delete-line)) + (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread))) + (defun gnus-sort-threads (threads) ;; Sort threads as specified in `gnus-thread-sort-functions'. (let ((fun gnus-thread-sort-functions)) *************** *** 6170,6175 **** --- 6249,6263 ---- (read (current-buffer)) 0)))) + (defmacro gnus-nov-read-integer () + '(if (and (<= (following-char) ?9) + (>= (following-char) ?0)) + (prog1 + (read (current-buffer)) + (or (eobp) (forward-char 1))) + (gnus-nov-skip-field) + 0)) + (defmacro gnus-nov-skip-field () '(search-forward "\t" eol 'move)) *************** *** 6238,6245 **** (point))))) (setq ref nil)))) (gnus-nov-field)) ; refs ! (read (current-buffer)) ; chars ! (read (current-buffer)) ; lines (if (/= (following-char) ?\t) nil (forward-char 1) --- 6326,6333 ---- (point))))) (setq ref nil)))) (gnus-nov-field)) ; refs ! (gnus-nov-read-integer) ; chars ! (gnus-nov-read-integer) ; lines (if (/= (following-char) ?\t) nil (forward-char 1) *************** *** 6920,6925 **** --- 7008,7016 ---- (goto-char (point-min)) (while (and (not (eq (car (get-text-property (point) 'gnus)) article)) (zerop (forward-line 1)))) + ;; Skip dummy articles. + (if (eq (gnus-summary-article-mark) ?Z) + (forward-line 1)) (prog1 (if (not (eobp)) article *************** *** 7283,7301 **** (header-subject header)) (forward-line -1) (header-number header))) ! (let ((gnus-override-method gnus-refer-article-method)) (and gnus-refer-article-method (or (gnus-server-opened gnus-refer-article-method) (gnus-open-server gnus-refer-article-method))) (if (gnus-article-prepare message-id nil (gnus-read-header message-id)) (progn ! (gnus-summary-insert-line ! nil gnus-current-headers 0 nil gnus-read-mark nil nil ! (header-subject gnus-current-headers)) ! (forward-line -1) ! (gnus-summary-position-cursor) ! (gnus-summary-update-line) message-id) (message "No such references") nil)))))) --- 7374,7390 ---- (header-subject header)) (forward-line -1) (header-number header))) ! (let ((gnus-override-method gnus-refer-article-method) ! number) (and gnus-refer-article-method (or (gnus-server-opened gnus-refer-article-method) (gnus-open-server gnus-refer-article-method))) (if (gnus-article-prepare message-id nil (gnus-read-header message-id)) (progn ! (setq number (header-number gnus-current-headers)) ! (gnus-rebuild-thread message-id) ! (gnus-summary-goto-subject number) message-id) (message "No such references") nil)))))) *************** *** 7419,7428 **** (list (let ((completion-ignore-case t)) (completing-read "Header name: " ! (mapcar (string) (list string) '("Number" "Subject" "From" "Lines" "Date" ! "Message-ID" "Xref" "References") ! nil 'require-match))) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) --- 7508,7517 ---- (list (let ((completion-ignore-case t)) (completing-read "Header name: " ! (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" ! "Message-ID" "Xref" "References")) ! nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) *************** *** 8145,8151 **** ;; See whether the article is to be put in the cache. (and gnus-use-cache (save-excursion - (gnus-summary-select-article) (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-get-header-by-number article) --- 8234,8239 ---- *************** *** 8461,8467 **** (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark)) (gnus-summary-position-cursor)) ! (defun gnus-summary-catchup (all &optional quietly to-here) "Mark all articles not marked as unread in this newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked. --- 8549,8555 ---- (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark)) (gnus-summary-position-cursor)) ! (defun gnus-summary-catchup (all &optional quietly to-here not-mark) "Mark all articles not marked as unread in this newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. If QUIETLY is non-nil, no questions will be asked. *************** *** 8477,8490 **** (if all "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (let ((unreads (length gnus-newsgroup-unreads))) ! (if (gnus-summary-first-subject (not all)) ! (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark) ! (if to-here (< (point) to-here) t) ! (gnus-summary-search-subject nil (not all))))) ! (- unreads (length gnus-newsgroup-unreads)) ! (or to-here ! (setq gnus-newsgroup-unreads gnus-newsgroup-marked)))) (gnus-summary-position-cursor))) (defun gnus-summary-catchup-to-here (&optional all) --- 8565,8583 ---- (if all "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (if not-mark ! (progn ! (and all (setq gnus-newsgroup-marked nil ! gnus-newsgroup-dormant nil)) ! (setq gnus-newsgroup-unreads gnus-newsgroup-marked)) ! (let ((unreads (length gnus-newsgroup-unreads))) ! (if (gnus-summary-first-subject (not all)) ! (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark) ! (if to-here (< (point) to-here) t) ! (gnus-summary-search-subject nil (not all))))) ! (- unreads (length gnus-newsgroup-unreads)) ! (or to-here ! (setq gnus-newsgroup-unreads gnus-newsgroup-marked))))) (gnus-summary-position-cursor))) (defun gnus-summary-catchup-to-here (&optional all) *************** *** 8504,8510 **** "Mark all articles not marked as unread in this newsgroup as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") ! (gnus-summary-catchup all quietly) ;; Select next newsgroup or exit. (if (eq gnus-auto-select-next 'quietly) (gnus-summary-next-group nil) --- 8597,8603 ---- "Mark all articles not marked as unread in this newsgroup as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") ! (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (eq gnus-auto-select-next 'quietly) (gnus-summary-next-group nil) *************** *** 8711,8724 **** ;; Summary sorting commands ! (defun gnus-summary-sort-by-number (reverse) "Sort summary buffer by article number. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort (cons 'gnus-summary-article-number 'gnus-thread-sort-by-number) reverse)) ! (defun gnus-summary-sort-by-author (reverse) "Sort summary buffer by author name alphabetically. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." --- 8804,8817 ---- ;; Summary sorting commands ! (defun gnus-summary-sort-by-number (&optional reverse) "Sort summary buffer by article number. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort (cons 'gnus-summary-article-number 'gnus-thread-sort-by-number) reverse)) ! (defun gnus-summary-sort-by-author (&optional reverse) "Sort summary buffer by author name alphabetically. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." *************** *** 8734,8740 **** 'gnus-thread-sort-by-author) reverse)) ! (defun gnus-summary-sort-by-subject (reverse) "Sort summary buffer by subject alphabetically. `Re:'s are ignored. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." --- 8827,8833 ---- 'gnus-thread-sort-by-author) reverse)) ! (defun gnus-summary-sort-by-subject (&optional reverse) "Sort summary buffer by subject alphabetically. `Re:'s are ignored. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." *************** *** 8746,8752 **** 'gnus-thread-sort-by-subject) reverse)) ! (defun gnus-summary-sort-by-date (reverse) "Sort summary buffer by date. Argument REVERSE means reverse order." (interactive "P") --- 8839,8845 ---- 'gnus-thread-sort-by-subject) reverse)) ! (defun gnus-summary-sort-by-date (&optional reverse) "Sort summary buffer by date. Argument REVERSE means reverse order." (interactive "P") *************** *** 8759,8765 **** 'gnus-thread-sort-by-date) reverse)) ! (defun gnus-summary-sort-by-score (reverse) "Sort summary buffer by score. Argument REVERSE means reverse order." (interactive "P") --- 8852,8858 ---- 'gnus-thread-sort-by-date) reverse)) ! (defun gnus-summary-sort-by-score (&optional reverse) "Sort summary buffer by score. Argument REVERSE means reverse order." (interactive "P") *************** *** 9163,9168 **** --- 9256,9262 ---- (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail) (define-key gnus-article-mode-map "\C-c\C-M" 'gnus-article-mail-with-original) (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly) + (define-key gnus-article-mode-map [ mouse-2 ] 'gnus-article-push-button) ;; Duplicate almost all summary keystrokes in the article mode map. (let ((commands *************** *** 9593,9617 **** (if (or (not gnus-article-x-face-command) (and (re-search-forward "^\\($\\|X-Face: \\)" nil t) (looking-at "^$"))) ! () ! (let ((face ! (buffer-substring ! (point) ! (progn ! (forward-line 1) ! (while (and (looking-at "[ \t]") ! (zerop (forward-line 1)))) ! (point)))) ! (command gnus-article-x-face-command)) ! (if (symbolp command) ! (and (or (fboundp command) (error "%s is not a function" command)) ! (funcall command face)) ! (let ((process (start-process "gnus-x-face" nil "sh" "-c" command))) ! (if process ! (progn ! (process-send-string process face) ! (process-send-eof process)) ! (error "Couldn't start process")))))))) (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naïve translation of a quoted-printable-encoded article. --- 9687,9702 ---- (if (or (not gnus-article-x-face-command) (and (re-search-forward "^\\($\\|X-Face: \\)" nil t) (looking-at "^$"))) ! nil ! (let ((beg (point)) ! (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) ! (if (symbolp gnus-article-x-face-command) ! (and (or (fboundp gnus-article-x-face-command) ! (error "%s is not a function" ! gnus-article-x-face-command)) ! (funcall gnus-article-x-face-command beg end)) ! (call-process-region beg end "sh" nil 0 nil ! "-c" gnus-article-x-face-command)))))) (defun gnus-article-de-quoted-unreadable (&optional force) "Do a naïve translation of a quoted-printable-encoded article. *************** *** 9624,9629 **** --- 9709,9715 ---- (save-excursion (set-buffer gnus-article-buffer) (let ((case-fold-search t) + (buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) (if (or force (and type (string-match "quoted-printable" type))) (progn *************** *** 9671,9678 **** (concat "Date: " (timezone-make-date-arpa-standard date nil "UT") "\n")) ((eq type 'lapsed) ! (let* ((sec (- (gnus-seconds-since-epoch (current-time-string)) ! (gnus-seconds-since-epoch date))) (units (list (cons 'year (* 365.25 24 60 60)) (cons 'week (* 7 24 60 60)) (cons 'day (* 24 60 60)) --- 9757,9767 ---- (concat "Date: " (timezone-make-date-arpa-standard date nil "UT") "\n")) ((eq type 'lapsed) ! (let* ((sec (- (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! (current-time-string) nil "UT")) ! (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard date nil "UT")))) (units (list (cons 'year (* 365.25 24 60 60)) (cons 'week (* 7 24 60 60)) (cons 'day (* 24 60 60)) *************** *** 9707,9712 **** --- 9796,9803 ---- (interactive) (gnus-article-date-ut 'lapsed)) + (defun gnus-article-maybe-highlight () + (if gnus-visual (gnus-article-highlight))) ;; Article savers. *************** *** 10990,10996 **** (gnus-server-to-method method) (nth 4 info))) 'nnvirtual) (setq virtuals (cons info virtuals)) ! (setq active (gnus-activate-newsgroup (car info))))) (if (and (not gnus-read-active-file) (<= (nth 1 info) level)) (progn --- 11081,11088 ---- (gnus-server-to-method method) (nth 4 info))) 'nnvirtual) (setq virtuals (cons info virtuals)) ! (setq active (gnus-activate-newsgroup (car info)))) ! (setq active nil)) (if (and (not gnus-read-active-file) (<= (nth 1 info) level)) (progn *************** *** 11223,11228 **** --- 11315,11321 ---- "Get active file from NNTP server." (gnus-group-set-mode-line) (let ((methods (cons gnus-select-method gnus-secondary-select-methods)) + (not-first nil) list-type) (setq gnus-have-read-active-file nil) (save-excursion *************** *** 11255,11267 **** (ding) (sit-for 2)) ((eq list-type 'active) ! (gnus-active-to-gnus-format ! (and gnus-have-read-active-file (car methods))) ! (setq gnus-have-read-active-file t)) (t ! (gnus-groups-to-gnus-format ! (and gnus-have-read-active-file (car methods))) ! (setq gnus-have-read-active-file t))))) (t (if (not (gnus-request-list (car methods))) (progn --- 11348,11358 ---- (ding) (sit-for 2)) ((eq list-type 'active) ! (gnus-active-to-gnus-format (and not-first (car methods))) ! (setq not-first t)) (t ! (gnus-groups-to-gnus-format (and not-first (car methods))) ! (setq not-first t))))) (t (if (not (gnus-request-list (car methods))) (progn *************** *** 11838,11847 **** (defun gnus-read-descriptions-file () (message "Reading descriptions file...") ! (if (not (gnus-request-list-newsgroups gnus-select-method)) ! (progn ! (message "Couldn't read newsgroups descriptions") ! nil) (let (group) (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb))) --- 11929,11943 ---- (defun gnus-read-descriptions-file () (message "Reading descriptions file...") ! (cond ! ((not (or (gnus-server-opened gnus-select-method) ! (gnus-open-server gnus-select-method))) ! (message "Couldn't open server") ! nil) ! ((not (gnus-request-list-newsgroups gnus-select-method)) ! (message "Couldn't read newsgroups descriptions") ! nil) ! (t (let (group) (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb))) *************** *** 11865,11871 **** (point) (gnus-point-at-eol))) (forward-line 1)))) (message "Reading descriptions file...done") ! t))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. --- 11961,11967 ---- (point) (gnus-point-at-eol))) (forward-line 1)))) (message "Reading descriptions file...done") ! t)))) (defun gnus-group-get-description (group) ;; Get the description of a group by sending XGTITLE to the server. *************** *** 11935,11941 **** \\{gnus-server-mode-map}" (interactive) ! ; (if gnus-visual (gnus-server-make-menu-bar)) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) --- 12031,12037 ---- \\{gnus-server-mode-map}" (interactive) ! (if gnus-visual (gnus-server-make-menu-bar)) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnbabyl.el dgnus/lisp/nnbabyl.el *** pub/dgnus/lisp/nnbabyl.el Sun Apr 30 22:46:18 1995 --- dgnus/lisp/nnbabyl.el Sat May 6 02:27:45 1995 *************** *** 48,55 **** (defconst nnbabyl-version "nnbabyl 0.1" "nnbabyl version.") ! (defconst nnbabyl-mbox-buffer " *nnbabyl mbox buffer*") ! (defvar nnbabyl-current-group nil) (defvar nnbabyl-status-string "") (defvar nnbabyl-group-alist nil) --- 48,54 ---- (defconst nnbabyl-version "nnbabyl 0.1" "nnbabyl version.") ! (defvar nnbabyl-mbox-buffer nil) (defvar nnbabyl-current-group nil) (defvar nnbabyl-status-string "") (defvar nnbabyl-group-alist nil) *************** *** 85,91 **** (setq art-string (nnbabyl-article-string article)) (set-buffer nnbabyl-mbox-buffer) (if (or (search-forward art-string nil t) ! (progn (goto-char 1) (search-forward art-string nil t))) (progn (setq start --- 84,90 ---- (setq art-string (nnbabyl-article-string article)) (set-buffer nnbabyl-mbox-buffer) (if (or (search-forward art-string nil t) ! (progn (goto-char (point-min)) (search-forward art-string nil t))) (progn (setq start *************** *** 118,124 **** (message "nnbabyl: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char 1) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) --- 117,123 ---- (message "nnbabyl: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) *************** *** 157,163 **** nil (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char 1) (if (search-forward (nnbabyl-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) --- 156,162 ---- nil (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) (if (search-forward (nnbabyl-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) *************** *** 232,238 **** (save-excursion (set-buffer nnbabyl-mbox-buffer) (while articles ! (goto-char 1) (if (search-forward (nnbabyl-article-string (car articles)) nil t) (if (or force (> (nnmail-days-between --- 231,237 ---- (save-excursion (set-buffer nnbabyl-mbox-buffer) (while articles ! (goto-char (point-min)) (if (search-forward (nnbabyl-article-string (car articles)) nil t) (if (or force (> (nnmail-days-between *************** *** 252,258 **** (goto-char (point-min)) (while (not (search-forward (nnbabyl-article-string (car active)) nil t)) ! (setcar (car active) (1+ (car active))) (goto-char (point-min)))) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) rest))) --- 251,257 ---- (goto-char (point-min)) (while (not (search-forward (nnbabyl-article-string (car active)) nil t)) ! (setcar active (1+ (car active))) (goto-char (point-min)))) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) rest))) *************** *** 278,284 **** result) (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char 1) (if (search-forward (nnbabyl-article-string article) nil t) (nnbabyl-delete-mail)) (and last (save-buffer)))) --- 277,283 ---- result) (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) (if (search-forward (nnbabyl-article-string article) nil t) (nnbabyl-delete-mail)) (and last (save-buffer)))) *************** *** 312,318 **** (nnbabyl-possibly-change-newsgroup group) (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char 1) (if (not (search-forward (nnbabyl-article-string article) nil t)) nil (nnbabyl-delete-mail t t) --- 311,317 ---- (nnbabyl-possibly-change-newsgroup group) (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) (if (not (search-forward (nnbabyl-article-string article) nil t)) nil (nnbabyl-delete-mail t t) *************** *** 355,364 **** (defun nnbabyl-possibly-change-newsgroup (newsgroup) (if (or (not nnbabyl-mbox-buffer) ! (not (buffer-name nnbabyl-mbox-buffer))) ! (save-excursion ! (nnbabyl-read-mbox))) ! (if (not nnbabyl-group-alist) (setq nnbabyl-group-alist (nnmail-get-active))) (if newsgroup (if (assoc newsgroup nnbabyl-group-alist) --- 354,362 ---- (defun nnbabyl-possibly-change-newsgroup (newsgroup) (if (or (not nnbabyl-mbox-buffer) ! (buffer-name nnbabyl-mbox-buffer)) ! (save-excursion (nnbabyl-read-mbox))) ! (or nnbabyl-group-alist (setq nnbabyl-group-alist (nnmail-get-active))) (if newsgroup (if (assoc newsgroup nnbabyl-group-alist) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnmbox.el dgnus/lisp/nnmbox.el *** pub/dgnus/lisp/nnmbox.el Sun Apr 30 22:46:18 1995 --- dgnus/lisp/nnmbox.el Sat May 6 01:25:28 1995 *************** *** 86,92 **** (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) (if (or (search-forward art-string nil t) ! (progn (goto-char 1) (search-forward art-string nil t))) (progn (setq start --- 86,92 ---- (setq art-string (nnmbox-article-string article)) (set-buffer nnmbox-mbox-buffer) (if (or (search-forward art-string nil t) ! (progn (goto-char (point-min)) (search-forward art-string nil t))) (progn (setq start *************** *** 117,123 **** (message "nnmbox: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char 1) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) --- 117,123 ---- (message "nnmbox: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) *************** *** 156,162 **** nil (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char 1) (if (search-forward (nnmbox-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) --- 156,162 ---- nil (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-min)) (if (search-forward (nnmbox-article-string article) nil t) (let (start stop) (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) *************** *** 230,236 **** (save-excursion (set-buffer nnmbox-mbox-buffer) (while articles ! (goto-char 1) (if (search-forward (nnmbox-article-string (car articles)) nil t) (if (or force (> (nnmail-days-between --- 230,236 ---- (save-excursion (set-buffer nnmbox-mbox-buffer) (while articles ! (goto-char (point-min)) (if (search-forward (nnmbox-article-string (car articles)) nil t) (if (or force (> (nnmail-days-between *************** *** 278,284 **** result) (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char 1) (if (search-forward (nnmbox-article-string article) nil t) (nnmbox-delete-mail)) (and last (save-buffer)))) --- 278,284 ---- result) (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-min)) (if (search-forward (nnmbox-article-string article) nil t) (nnmbox-delete-mail)) (and last (save-buffer)))) *************** *** 314,320 **** (nnmbox-possibly-change-newsgroup group) (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char 1) (if (not (search-forward (nnmbox-article-string article) nil t)) nil (nnmbox-delete-mail t t) --- 314,320 ---- (nnmbox-possibly-change-newsgroup group) (save-excursion (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-min)) (if (not (search-forward (nnmbox-article-string article) nil t)) nil (nnmbox-delete-mail t t) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/nnmh.el dgnus/lisp/nnmh.el *** pub/dgnus/lisp/nnmh.el Sun Apr 30 22:46:18 1995 --- dgnus/lisp/nnmh.el Sat May 6 01:25:29 1995 *************** *** 107,113 **** (message "nnmh: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char 1) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) --- 107,113 ---- (message "nnmh: Receiving headers... done")) ;; Fold continuation lines. ! (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) 'headers))) diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/texi/gnus.texi dgnus/texi/gnus.texi *** pub/dgnus/texi/gnus.texi Sun Apr 30 22:46:25 1995 --- dgnus/texi/gnus.texi Sat May 6 05:42:34 1995 *************** *** 788,793 **** --- 788,794 ---- * Selecting a Group:: Actually reading news. * Group Subscribing:: Unsubscribing, killing, subscribing. * Group Levels:: Levels? What are those, then? + * Marking Groups:: You can mark groups for later processing. * Foreign Groups:: How to create foreign groups. * Group Parameters:: Each group may have different parameters set. * Listing Groups:: Gnus can list various subsets of the groups. *************** *** 1152,1157 **** --- 1153,1191 ---- @code{gnus-group-default-list-level} will be listed in the group buffer by default. + @node Marking Groups + @section Marking Groups + @cindex marking groups + + If you want to perform some action on several groups, and they appear + subsequently in the group buffer, you would normally just give a + numerical prefix to the command. Most group commands will then do your + bidding on those groups. + + However, if the groups are not in sequential order, you can still + perform an action on several groups. You simply mark the groups first, + and then execute the command. + + @table @kbd + @item # + @kindex # (Group) + @item G m + @kindex G m (Group) + @findex gnus-group-mark-group + Set the mark on the current group (@code{gnus-group-mark-group}). + @item M-# + @kindex M-# (Group) + @item G u + @kindex G u (Group) + @findex gnus-group-unmark-group + Remove the mark from the current group + (@code{gnus-group-unmark-group}). + @item G w + @kindex G w (Group) + @findex gnus-group-mark-region + Mark all groups between point and mark (@code{gnus-group-mark-region}). + @end table + @node Foreign Groups @section Foreign Groups @cindex foreign groups *************** *** 1184,1228 **** and some commands to ease the creation of some special-purpose groups: @table @kbd ! @item M m ! @kindex M m (Group) @findex gnus-group-make-group Make a new group (@code{gnus-group-make-group}). Gnus will prompt you for a name, a method and possibly an @dfn{address}. For an easier way to subscribe to @sc{nntp} groups, @xref{Browse Foreign Server}. ! @item M e ! @kindex M e (Group) @findex gnus-group-edit-group-method Enter a buffer where you can edit the select method of the current group (@code{gnus-group-edit-group-method}). ! @item M p ! @kindex M p (Group) @findex gnus-group-edit-group-parameters Enter a buffer where you can edit the group parameters (@code{gnus-group-edit-group-parameters}). ! @item M E ! @kindex M E (Group) @findex gnus-group-edit-group Enter a buffer where you can edit the group info (@code{gnus-group-edit-group}). ! @item M d ! @kindex M d (Group) @findex gnus-group-make-directory-group Make a directory group. You will be prompted for a directory name (@code{gnus-group-make-directory-group}). ! @item M h ! @kindex M h (Group) @findex gnus-group-make-help-group Make the (ding) Gnus help group (@code{gnus-group-make-help-group}). ! @item M a ! @kindex M a (Group) @findex gnus-group-make-archive-group @vindex gnus-group-archive-directory Make the (ding) Gnus archive group (@code{gnus-group-make-archive-group}). The archive group will be fetched from @code{gnus-group-archive-directory}. ! @item M k ! @kindex M k (Group) @findex gnus-group-make-kiboze-group Make a kiboze group. You will be prompted for a name, for a regexp to match groups to be "included" in the kiboze group, and a series of --- 1218,1262 ---- and some commands to ease the creation of some special-purpose groups: @table @kbd ! @item G m ! @kindex G m (Group) @findex gnus-group-make-group Make a new group (@code{gnus-group-make-group}). Gnus will prompt you for a name, a method and possibly an @dfn{address}. For an easier way to subscribe to @sc{nntp} groups, @xref{Browse Foreign Server}. ! @item G e ! @kindex G e (Group) @findex gnus-group-edit-group-method Enter a buffer where you can edit the select method of the current group (@code{gnus-group-edit-group-method}). ! @item G p ! @kindex G p (Group) @findex gnus-group-edit-group-parameters Enter a buffer where you can edit the group parameters (@code{gnus-group-edit-group-parameters}). ! @item G E ! @kindex G E (Group) @findex gnus-group-edit-group Enter a buffer where you can edit the group info (@code{gnus-group-edit-group}). ! @item G d ! @kindex G d (Group) @findex gnus-group-make-directory-group Make a directory group. You will be prompted for a directory name (@code{gnus-group-make-directory-group}). ! @item G h ! @kindex G h (Group) @findex gnus-group-make-help-group Make the (ding) Gnus help group (@code{gnus-group-make-help-group}). ! @item G a ! @kindex G a (Group) @findex gnus-group-make-archive-group @vindex gnus-group-archive-directory Make the (ding) Gnus archive group (@code{gnus-group-make-archive-group}). The archive group will be fetched from @code{gnus-group-archive-directory}. ! @item G k ! @kindex G k (Group) @findex gnus-group-make-kiboze-group Make a kiboze group. You will be prompted for a name, for a regexp to match groups to be "included" in the kiboze group, and a series of *************** *** 1723,1729 **** @file{~/Mail/}. There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. ! Go to the group buffer and type @kbd{M m}. When prompted, answer @samp{foo} for the name and @samp{nnfolder} for the method. Repeat twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure to include all your mail groups. --- 1757,1763 ---- @file{~/Mail/}. There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. ! Go to the group buffer and type @kbd{G m}. When prompted, answer @samp{foo} for the name and @samp{nnfolder} for the method. Repeat twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure to include all your mail groups. *************** *** 2035,2045 **** @end table If you want to change the group parameters (or anything else of the ! group info) you can use the @kbd{M E} to edit enter a buffer where you can edit the group info. You usually don't want to edit the entire group info, so you'd be better ! off using the @kbd{M p} command to just edit the group parameters. @node Listing Groups @section Listing Groups --- 2069,2079 ---- @end table If you want to change the group parameters (or anything else of the ! group info) you can use the @kbd{G E} to edit enter a buffer where you can edit the group info. You usually don't want to edit the entire group info, so you'd be better ! off using the @kbd{G p} command to just edit the group parameters. @node Listing Groups @section Listing Groups *************** *** 2049,2056 **** @table @kbd @item l ! @itemx G s ! @kindex G s (Group) @kindex l (Group) @findex gnus-group-list-groups List all groups that have unread articles --- 2083,2090 ---- @table @kbd @item l ! @itemx A s ! @kindex A s (Group) @kindex l (Group) @findex gnus-group-list-groups List all groups that have unread articles *************** *** 2058,2065 **** command will list only groups of level ARG and lower. By default, it only lists groups of level five or lower (ie. just subscribed groups). @item L ! @itemx G u ! @kindex G u (Group) @kindex L (Group) @findex gnus-group-list-all-groups List all groups, whether they have unread articles or not --- 2092,2099 ---- command will list only groups of level ARG and lower. By default, it only lists groups of level five or lower (ie. just subscribed groups). @item L ! @itemx A u ! @kindex A u (Group) @kindex L (Group) @findex gnus-group-list-all-groups List all groups, whether they have unread articles or not *************** *** 2067,2087 **** this command will list only groups of level ARG and lower. By default, it lists groups of level seven or lower (ie. just subscribed and unsubscribed groups). ! @item G k ! @kindex G k (Group) @findex gnus-group-list-killed List all killed groups (@code{gnus-group-list-killed}). ! @item G z ! @kindex G z (Group) @findex gnus-group-list-zombies List all zombie groups (@code{gnus-group-list-zombies}). ! @item G m ! @kindex G m (Group) @findex gnus-group-list-matching List all subscribed groups with unread articles that match a regexp (@code{gnus-group-list-matching}). ! @item G M ! @kindex G M (Group) @findex gnus-group-list-all-matching List groups that match a regexp (@code{gnus-group-list-all-matching}). @end table --- 2101,2121 ---- this command will list only groups of level ARG and lower. By default, it lists groups of level seven or lower (ie. just subscribed and unsubscribed groups). ! @item A k ! @kindex A k (Group) @findex gnus-group-list-killed List all killed groups (@code{gnus-group-list-killed}). ! @item A z ! @kindex A z (Group) @findex gnus-group-list-zombies List all zombie groups (@code{gnus-group-list-zombies}). ! @item A m ! @kindex A m (Group) @findex gnus-group-list-matching List all subscribed groups with unread articles that match a regexp (@code{gnus-group-list-matching}). ! @item A M ! @kindex A M (Group) @findex gnus-group-list-all-matching List groups that match a regexp (@code{gnus-group-list-all-matching}). @end table *************** *** 2224,2232 **** @item g @kindex g (Group) @findex gnus-group-get-new-news ! Check server for new articles. ! If the numeric prefix is used, this command will check only groups of ! level ARG and lower (@code{gnus-group-get-new-news}). @item M-g @kindex M-g (Group) @findex gnus-group-get-new-news-this-group --- 2258,2269 ---- @item g @kindex g (Group) @findex gnus-group-get-new-news ! @vindex gnus-group-always-list-unread ! Check server for new articles. If the numeric prefix is used, this ! command will check only groups of level ARG and lower ! (@code{gnus-group-get-new-news}). If ! @code{gnus-group-always-list-unread} is @code{nil}, only groups of level ! ARG and lower will be displayed. @item M-g @kindex M-g (Group) @findex gnus-group-get-new-news-this-group