diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/ChangeLog dgnus/lisp/ChangeLog *** pub/dgnus/lisp/ChangeLog Mon May 8 06:37:53 1995 --- dgnus/lisp/ChangeLog Tue May 9 08:02:46 1995 *************** *** 1,4 **** --- 1,44 ---- + Tue May 9 04:49:53 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-rebuild-remove-articles): Would make all articles + read and go to the wrong article. + (gnus-summary-update-lines): Allow highlighting of a region. + + * gnus-kill.el (gnus-kill-file-mode-map): Three commands bound to + the same key. + + * gnus-vis.el: Hilit code transferred here. + + * gnus-hilit.el: Obsolete file. + + * gnus-cite.el (gnus-cite-face-list): New file. + + * gnus.el (gnus-member-of-valid): New function. + + * gnus-score.el (gnus-score-integer): Reversed comparison. + + * gnus.el (gnus-maintainer): New address. + (gnus-get-unread-articles): Secondary groups would be doubly + activated. + + Mon May 8 11:11:22 1995 Lars Ingebrigtsen + + * gnus-msg.el (gnus-post-news): Use process/prefix. + (gnus-mail-reply-using-mail): Use process/prefix. + (gnus-summary-cancel-article): Ditto. + + * gnus-vis.el (gnus-carpal-mode): New mode and stuff. + + * gnus.el (gnus-configure-windows): New implementation. + (gnus-window-configuration): New syntax. + (gnus-windows-old-to-new): Conversion between old and new. + (gnus-split-window): Obsolete variable. + (gnus-remove-some-windows): New function. + (gnus-bug): Put point a different place. + Sun May 7 01:12:04 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.65 is released. * gnus.el (gnus-get-unread-articles): Would not activate some native groups. diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-cite.el dgnus/lisp/gnus-cite.el *** pub/dgnus/lisp/gnus-cite.el Tue May 9 06:51:30 1995 --- dgnus/lisp/gnus-cite.el Tue May 9 07:00:20 1995 *************** *** 0 **** --- 1,513 ---- + ;;; gnus-cite.el --- Highlight GNUS article. + ;; Copyright (C) 1995 Free Software Foundation, Inc. + + ;; Author: Per Abrahamsen + ;; Keywords: news, mail + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (require 'gnus-vis) + + ;;; Customization: + + (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-cite-hide-percentage 30 + "Only hide cited text if it is larger than this percent of the body.") + + (defvar gnus-cite-hide-absolute 5 + "Only hide cited text if there is at least this number of cited lines.") + + + ;;; 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. + + ;;; Commands: + + (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 skip 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 number) + (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-hide-citation-maybe (&optional force) + "Hide cited text that has an attribution line. + This will do nothing unless at least `gnus-cite-hide-percentage' + percent ans at least `gnus-cite-hide-absolute' lines of the body is + cited text with attributions. When called interactively, these two + variables are ignored. + See also the documentation for `gnus-article-highlight-citation'." + (interactive (list 'force)) + (save-excursion + (set-buffer gnus-article-buffer) + (gnus-cite-parse-maybe) + (goto-char (point-min)) + (search-forward "\n\n") + (let ((start (point)) + (atts gnus-cite-attribution-alist) + (buffer-read-only nil) + (hiden 0) + total) + (goto-char (point-max)) + (re-search-backward gnus-signature-separator nil t) + (setq total (count-lines start (point))) + (while atts + (setq hiden (+ hiden (length (cdr (assoc (cdr (car atts)) + gnus-cite-prefix-alist)))) + atts (cdr atts))) + (if (or force + (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) + (> hiden gnus-cite-hide-absolute))) + (progn + (setq atts gnus-cite-attribution-alist) + (while atts + (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)) + atts (cdr atts)) + (while total + (setq hiden (car total) + total (cdr total)) + (goto-line hiden) + (or (assq hiden gnus-cite-attribution-alist) + (put-text-property (point) (progn (forward-line 1) (point)) + 'invisible t))))))))) + + ;;; 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-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)) + + (provide 'gnus-cite) + + ;;; gnus-cite.el ends here 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 Mon May 8 06:37:47 1995 --- dgnus/lisp/gnus-hilit.el Tue May 9 07:00:39 1995 *************** *** 1,863 **** - ;;; gnus-hilit.el --- Highlight GNUS article. - ;; Copyright (C) 1995 Free Software Foundation, Inc. - - ;; Author: Per Abrahamsen - ;; Keywords: news, mail - ;; Version: 0.6 - - ;;; 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: - - ;; - Ignore lines with only whitespace after the prefix when looking - ;; for potential citations. - ;; - When matching citations with attrubutions using `prefix length' for - ;; sorting, use `first line' as a secondary sort key. - ;; - Make message-id buttons fail gracefully if message-id can't be found. - ;; - 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 "\C-c" 'gnus-article-hide-citation-maybe) - (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-cite-hide-percentage 30 - "Only hide cited text if it is larger than this percent of the body.") - - (defvar gnus-cite-hide-absolute 5 - "Only hide cited text if there is at least this number of cited lines.") - - (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-maybe', and `gnus-article-hide-signature' - to do the hiding. See the documentation for those functions." - (interactive) - (gnus-article-hide-headers) - (gnus-article-hide-citation-maybe) - (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 skip 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 number) - (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-hide-citation-maybe (&optional force) - "Hide cited text that has an attribution line. - This will do nothing unless at least `gnus-cite-hide-percentage' - percent ans at least `gnus-cite-hide-absolute' lines of the body is - cited text with attributions. When called interactively, these two - variables are ignored. - See also the documentation for `gnus-article-highlight-citation'." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) - (goto-char (point-min)) - (search-forward "\n\n") - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (hiden 0) - total) - (goto-char (point-max)) - (re-search-backward gnus-signature-separator nil t) - (setq total (count-lines start (point))) - (while atts - (setq hiden (+ hiden (length (cdr (assoc (cdr (car atts)) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (if (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) - (progn - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hiden (car total) - total (cdr total)) - (goto-line hiden) - (or (assq hiden 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 - - --- 0 ---- diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-kill.el dgnus/lisp/gnus-kill.el *** pub/dgnus/lisp/gnus-kill.el Mon May 8 06:37:47 1995 --- dgnus/lisp/gnus-kill.el Tue May 9 07:17:05 1995 *************** *** 59,67 **** (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author) (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-thread) (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-xref) (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer) (define-key gnus-kill-file-mode-map --- 59,67 ---- (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author) (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-t" 'gnus-kill-file-kill-by-thread) (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-x" 'gnus-kill-file-kill-by-xref) (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer) (define-key gnus-kill-file-mode-map diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-mh.el dgnus/lisp/gnus-mh.el *** pub/dgnus/lisp/gnus-mh.el Mon May 8 06:37:47 1995 --- dgnus/lisp/gnus-mh.el Mon May 8 11:48:44 1995 *************** *** 81,89 **** (gnus-article-show-all-headers) ;; so colors are happy ;; lots of junk to avoid mh-send deleting other windows - (if gnus-split-window - (split-window-vertically) - ) (setq from (gnus-fetch-field "from") subject (let ((subject (or (gnus-fetch-field "subject") --- 81,86 ---- *************** *** 108,117 **** )) ;; save excursion/restriction (mh-find-path) ! (if gnus-split-window ! (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94 ! (mh-send to (or cc "") subject);; shouldn't use according to mhe ! ) ;; note - current buffer is now draft! (save-excursion --- 105,111 ---- )) ;; save excursion/restriction (mh-find-path) ! (mh-send to (or cc "") subject);; shouldn't use according to mhe ;; note - current buffer is now draft! (save-excursion *************** *** 147,168 **** subject (config (current-window-configuration))) ;; need to add this - erik ;;(gnus-article-show-all-headers) - (if gnus-split-window - (progn - (pop-to-buffer gnus-article-buffer) - (split-window-vertically) - (setq buffer (current-buffer)) - )) (setq subject (concat "[" gnus-newsgroup-name "] " ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " (or (gnus-fetch-field "subject") ""))) (setq mh-show-buffer buffer) (mh-find-path) ! (if gnus-split-window ! (mh-send-sub to (or cc "") subject config) ! (mh-send to (or cc "") subject) ! ) (save-excursion (goto-char (point-max)) (insert "\n------- Forwarded Message\n\n") --- 141,153 ---- subject (config (current-window-configuration))) ;; need to add this - erik ;;(gnus-article-show-all-headers) (setq subject (concat "[" gnus-newsgroup-name "] " ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " (or (gnus-fetch-field "subject") ""))) (setq mh-show-buffer buffer) (mh-find-path) ! (mh-send to (or cc "") subject) (save-excursion (goto-char (point-max)) (insert "\n------- Forwarded Message\n\n") 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 Mon May 8 06:37:47 1995 --- dgnus/lisp/gnus-msg.el Tue May 9 06:55:49 1995 *************** *** 37,43 **** "*Local news organization file.") (defvar gnus-post-news-buffer "*post-news*") - (defvar gnus-winconf-post-news nil) (defvar gnus-summary-send-map nil) --- 37,42 ---- *************** *** 82,133 **** (defun gnus-group-post-news () "Post an article." (interactive) - (gnus-set-global-variables) - ;; Save window configuration. - (setq gnus-winconf-post-news (current-window-configuration)) (let ((gnus-newsgroup-name nil)) ! (unwind-protect ! (if gnus-split-window ! (progn ! (pop-to-buffer gnus-article-buffer) ! (widen) ! (split-window-vertically) ! (gnus-post-news 'post)) ! (gnus-post-news 'post nil nil gnus-article-buffer)) ! (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) ! (not (zerop (buffer-size)))) ! ;; Restore last window configuration. ! (and gnus-winconf-post-news ! (set-window-configuration gnus-winconf-post-news))))) ! ;; We don't want to return to summary buffer nor article buffer later. ! (setq gnus-winconf-post-news nil) ! (if (get-buffer gnus-summary-buffer) ! (bury-buffer gnus-summary-buffer)) ! (if (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer))) (defun gnus-summary-post-news () "Post an article." (interactive) (gnus-set-global-variables) ! ;; Save window configuration. ! (setq gnus-winconf-post-news (current-window-configuration)) ! (unwind-protect ! (gnus-post-news 'post gnus-newsgroup-name) ! (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) ! (not (zerop (buffer-size)))) ! ;; Restore last window configuration. ! (and gnus-winconf-post-news ! (set-window-configuration gnus-winconf-post-news)))) ! ;; We don't want to return to article buffer later. ! (if (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer))) ! (defun gnus-summary-followup (yank) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." (interactive "P") (gnus-set-global-variables) (save-window-excursion (gnus-summary-select-article t)) (let ((headers gnus-current-headers) --- 81,101 ---- (defun gnus-group-post-news () "Post an article." (interactive) (let ((gnus-newsgroup-name nil)) ! (gnus-post-news 'post nil nil gnus-article-buffer))) (defun gnus-summary-post-news () "Post an article." (interactive) (gnus-set-global-variables) ! (gnus-post-news 'post gnus-newsgroup-name)) ! (defun gnus-summary-followup (yank &optional yank-articles) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." (interactive "P") (gnus-set-global-variables) + (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (save-window-excursion (gnus-summary-select-article t)) (let ((headers gnus-current-headers) *************** *** 141,184 **** "Do you want to ignore `Followup-To: poster'? ")))) ;; Mail to the poster. Gnus is now RFC1036 compliant. (gnus-summary-reply yank) ! ;; Save window configuration. ! (setq gnus-winconf-post-news (current-window-configuration)) ! (unwind-protect ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer yank) ! (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) ! (not (zerop (buffer-size)))) ! ;; Restore last window configuration. ! (and gnus-winconf-post-news ! (set-window-configuration gnus-winconf-post-news)))) ! ;; We don't want to return to article buffer later. ! (bury-buffer gnus-article-buffer))) (gnus-article-hide-headers-if-wanted)) ! (defun gnus-summary-followup-with-original () "Compose a followup to an article and include the original article." ! (interactive) ! (gnus-summary-followup t)) ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-followup-and-reply (yank) "Compose a followup and do an auto mail to author." (interactive "P") (let ((gnus-auto-mail-to-author t)) ! (gnus-summary-followup yank))) ! (defun gnus-summary-followup-and-reply-with-original () "Compose a followup, include the original, and do an auto mail to author." ! (interactive) ! (gnus-summary-followup-and-reply t)) ! (defun gnus-summary-cancel-article () "Cancel an article you posted." ! (interactive) (gnus-set-global-variables) ! (gnus-summary-select-article t) ! (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) ! (gnus-article-hide-headers-if-wanted)) (defun gnus-summary-supersede-article () "Compose an article that will supersede a previous article. --- 109,146 ---- "Do you want to ignore `Followup-To: poster'? ")))) ;; Mail to the poster. Gnus is now RFC1036 compliant. (gnus-summary-reply yank) ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer ! (or yank-articles (not (not yank)))))) (gnus-article-hide-headers-if-wanted)) ! (defun gnus-summary-followup-with-original (n) "Compose a followup to an article and include the original article." ! (interactive "P") ! (gnus-summary-followup t (gnus-summary-work-articles n))) ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-followup-and-reply (yank &optional yank-articles) "Compose a followup and do an auto mail to author." (interactive "P") (let ((gnus-auto-mail-to-author t)) ! (gnus-summary-followup yank yank-articles))) ! (defun gnus-summary-followup-and-reply-with-original (n) "Compose a followup, include the original, and do an auto mail to author." ! (interactive "P") ! (gnus-summary-followup-and-reply t (gnus-summary-work-articles n))) ! (defun gnus-summary-cancel-article (n) "Cancel an article you posted." ! (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n))) ! (while articles ! (gnus-summary-select-article t nil nil (car articles)) ! (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) ! (gnus-article-hide-headers-if-wanted) ! (setq articles (cdr articles))))) (defun gnus-summary-supersede-article () "Compose an article that will supersede a previous article. *************** *** 240,245 **** --- 202,208 ---- (set-buffer gnus-summary-buffer) (cons (current-buffer) gnus-current-article)))) (from (and header (header-from header))) + (winconf (current-window-configuration)) follow-to real-group) (and gnus-interactive-post (not gnus-expert-user) *************** *** 270,291 **** (funcall gnus-followup-to-function group))))) 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) (make-local-variable 'gnus-article-reply) (make-local-variable 'gnus-article-check-size) --- 233,242 ---- (funcall gnus-followup-to-function group))))) gnus-use-followup-to)) (if post ! (gnus-configure-windows 'post) ! (if yank ! (gnus-configure-windows 'followup-yank) ! (gnus-configure-windows 'followup))) (gnus-overload-functions) (make-local-variable 'gnus-article-reply) (make-local-variable 'gnus-article-check-size) *************** *** 331,339 **** (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (and yank (save-excursion (news-reply-yank-original nil))) (if gnus-post-prepare-function ! (funcall gnus-post-prepare-function group)))))) (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) (message "") t) --- 282,303 ---- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (if (not yank) ! () ! (save-excursion ! (if (not (listp yank)) ! (news-reply-yank-original nil) ! (while yank ! (save-window-excursion ! (gnus-summary-select-article nil nil nil (car yank)) ! (gnus-summary-remove-process-mark (car yank))) ! (let ((mail-reply-buffer gnus-article-buffer)) ! (news-reply-yank-original nil)) ! (setq yank (cdr yank)))))) (if gnus-post-prepare-function ! (funcall gnus-post-prepare-function group))) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf)))) (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) (message "") t) *************** *** 472,482 **** ;; If NNTP server is opened by gnus-inews-news, close it by myself. (or server-running (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) ! (and (fboundp 'bury-buffer) (bury-buffer)) ;; Restore last window configuration. ! (and gnus-winconf-post-news ! (set-window-configuration gnus-winconf-post-news)) ! (setq gnus-winconf-post-news nil))) (defun gnus-inews-check-post () "Check whether the post looks ok." --- 436,444 ---- ;; If NNTP server is opened by gnus-inews-news, close it by myself. (or server-running (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) ! (bury-buffer) ;; Restore last window configuration. ! (and gnus-prev-winconf (set-window-configuration gnus-prev-winconf)))) (defun gnus-inews-check-post () "Check whether the post looks ok." *************** *** 594,599 **** --- 556,563 ---- (newsgroups nil) (message-id nil) (distribution nil)) + (or (gnus-member-of-valid 'post gnus-newsgroup-name) + (error "This backend does not support cancelling")) (save-excursion ;; Get header info. from original article. (save-restriction *************** *** 1071,1077 **** ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (yank) "Reply mail to news author. If prefix argument YANK is non-nil, original article is yanked automatically. Customize the variable gnus-mail-reply-method to use another mailer." --- 1035,1041 ---- ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (yank &optional yank-articles) "Reply mail to news author. If prefix argument YANK is non-nil, original article is yanked automatically. Customize the variable gnus-mail-reply-method to use another mailer." *************** *** 1079,1109 **** ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (setq gnus-winconf-post-news (current-window-configuration)) (gnus-summary-select-article t) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (bury-buffer gnus-article-buffer) ! (funcall gnus-mail-reply-method yank)) (gnus-article-hide-headers-if-wanted)) ! (defun gnus-summary-reply-with-original () "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." ! (interactive) ! (gnus-summary-reply t)) (defun gnus-summary-mail-forward (post) "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." (interactive "P") (gnus-summary-select-article t) ! (setq gnus-winconf-post-news (current-window-configuration)) ! (if gnus-split-window ! (widen) ! (switch-to-buffer gnus-article-buffer) ! (widen) ! (delete-other-windows) ! (bury-buffer gnus-article-buffer)) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (if post (gnus-forward-using-post) --- 1043,1069 ---- ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (gnus-summary-select-article t) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (bury-buffer gnus-article-buffer) ! (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))) (gnus-article-hide-headers-if-wanted)) ! (defun gnus-summary-reply-with-original (n) "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." ! (interactive "P") ! (gnus-summary-reply t (gnus-summary-work-articles n))) (defun gnus-summary-mail-forward (post) "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." (interactive "P") (gnus-summary-select-article t) ! (switch-to-buffer gnus-article-buffer) ! (widen) ! (bury-buffer gnus-article-buffer) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (if post (gnus-forward-using-post) *************** *** 1120,1126 **** Customize the variable `gnus-mail-other-window-method' to use another mailer." (interactive) - (setq gnus-winconf-post-news (current-window-configuration)) (let ((gnus-newsgroup-name gnus-newsgroup-name)) (funcall gnus-mail-other-window-method))) --- 1080,1085 ---- *************** *** 1130,1141 **** --- 1089,1103 ---- (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) (group (gnus-group-real-name gnus-newsgroup-name)) (cur (cons (current-buffer) (cdr gnus-article-current))) + (winconf (current-window-configuration)) from subject date to reply-to message-of references message-id sender follow-to cc sendto elt) (set-buffer (get-buffer-create "*mail*")) (mail-mode) (make-local-variable 'gnus-article-reply) (setq gnus-article-reply cur) + (make-local-variable 'gnus-prev-winconf) + (setq gnus-prev-winconf winconf) (use-local-map (copy-keymap mail-mode-map)) (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) (if (and (buffer-modified-p) *************** *** 1215,1233 **** (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (if yank ! (let ((last (point))) ! (save-excursion ! (mail-yank-original nil)) ! (run-hooks 'news-reply-header-hook) ! (goto-char last)))) ! (let ((mail (current-buffer))) ! (if yank ! (progn ! (gnus-configure-windows '(0 1 0)) ! (switch-to-buffer mail)) ! (gnus-configure-windows '(0 0 1)) ! (switch-to-buffer-other-window mail)))))) (defun gnus-mail-yank-original () (interactive) --- 1177,1203 ---- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (if (not yank) ! (gnus-configure-windows 'reply) ! (let ((last (point)) ! end) ! (if (not (listp yank)) ! (progn ! (save-excursion ! (mail-yank-original nil)) ! (run-hooks 'news-reply-header-hook)) ! (while yank ! (save-window-excursion ! (gnus-summary-select-article nil nil nil (car yank)) ! (gnus-summary-remove-process-mark (car yank))) ! (save-excursion ! (mail-yank-original nil) ! (setq end (point))) ! (run-hooks 'news-reply-header-hook) ! (goto-char end) ! (setq yank (cdr yank)))) ! (goto-char last)) ! (gnus-configure-windows 'reply-yank)))))) (defun gnus-mail-yank-original () (interactive) *************** *** 1237,1258 **** (defun gnus-mail-send-and-exit () (interactive) ! (let ((cbuf (current-buffer))) (mail-send-and-exit nil) (if (get-buffer gnus-group-buffer) (progn ! (save-excursion ! (set-buffer cbuf) ! (let ((reply gnus-article-reply)) ! (if (gnus-buffer-exists-p (car-safe reply)) ! (progn ! (set-buffer (car reply)) ! (and (cdr reply) ! (gnus-summary-mark-article-as-replied ! (cdr reply))))))) ! (and gnus-winconf-post-news ! (set-window-configuration gnus-winconf-post-news)) ! (setq gnus-winconf-post-news nil))))) (defun gnus-forward-make-subject () (concat "[" (if (memq 'mail (assoc (symbol-name --- 1207,1224 ---- (defun gnus-mail-send-and-exit () (interactive) ! (let ((reply gnus-article-reply) ! (winconf gnus-prev-winconf)) (mail-send-and-exit nil) (if (get-buffer gnus-group-buffer) (progn ! (if (gnus-buffer-exists-p (car-safe reply)) ! (progn ! (set-buffer (car reply)) ! (and (cdr reply) ! (gnus-summary-mark-article-as-replied ! (cdr reply))))) ! (and winconf (set-window-configuration winconf)))))) (defun gnus-forward-make-subject () (concat "[" (if (memq 'mail (assoc (symbol-name *************** *** 1306,1314 **** (defun gnus-mail-other-window-using-mail () "Compose mail other window using mail." ! (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)) (provide 'gnus-msg) --- 1272,1283 ---- (defun gnus-mail-other-window-using-mail () "Compose mail other window using mail." ! (let ((winconf (current-window-configuration))) ! (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf))) (provide 'gnus-msg) 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 Mon May 8 06:37:47 1995 --- dgnus/lisp/gnus-score.el Tue May 9 06:03:21 1995 *************** *** 75,82 **** (defvar gnus-header-index nil) (defvar gnus-score-index nil) - (defvar gnus-winconf-edit-score nil) - (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap) ;;; Summary mode score maps. --- 75,80 ---- *************** *** 606,614 **** "Edit the current score alist." (interactive (list gnus-current-score-file)) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) ! (setq gnus-winconf-edit-score (current-window-configuration)) ! (gnus-configure-windows 'article) ! (pop-to-buffer (find-file-noselect file)) (message (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits")) (gnus-score-mode)) --- 604,614 ---- "Edit the current score alist." (interactive (list gnus-current-score-file)) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) ! (let ((winconf (current-window-configuration))) ! (gnus-configure-windows 'article) ! (pop-to-buffer (find-file-noselect file)) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf)) (message (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits")) (gnus-score-mode)) *************** *** 618,626 **** (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) ! (setq gnus-winconf-edit-score (current-window-configuration)) ! (gnus-configure-windows 'article) ! (pop-to-buffer (find-file-noselect file)) (message (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits")) (gnus-score-mode)) --- 618,628 ---- (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) ! (let ((winconf (current-window-configuration))) ! (gnus-configure-windows 'article) ! (pop-to-buffer (find-file-noselect file)) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf)) (message (substitute-command-keys "\\\\[gnus-score-edit-done] to save edits")) (gnus-score-mode)) *************** *** 999,1006 **** ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (and (funcall match-func match ! (or (aref (car (car articles)) gnus-score-index) 0)) (progn (setq found t) (setcdr (car articles) (+ score (cdr (car articles)))))) --- 1001,1009 ---- ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (and (funcall match-func ! (or (aref (car (car articles)) gnus-score-index) 0) ! match) (progn (setq found t) (setcdr (car articles) (+ score (cdr (car articles)))))) *************** *** 1483,1493 **** (defun gnus-score-edit-done () "Save the score file and return to the summary buffer." (interactive) ! (let ((bufnam (buffer-file-name (current-buffer)))) (save-buffer) (kill-buffer (current-buffer)) ! (and gnus-winconf-edit-score ! (set-window-configuration gnus-winconf-edit-score)) (gnus-score-remove-from-cache bufnam) (gnus-score-load-file bufnam))) --- 1486,1496 ---- (defun gnus-score-edit-done () "Save the score file and return to the summary buffer." (interactive) ! (let ((bufnam (buffer-file-name (current-buffer))) ! (winconf gnus-prev-winconf)) (save-buffer) (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) (gnus-score-load-file bufnam))) 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 Mon May 8 06:37:49 1995 --- dgnus/lisp/gnus-uu.el Tue May 9 07:08:43 1995 *************** *** 416,423 **** (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) (file (concat gnus-uu-work-dir (make-temp-name "forward"))) buf) - (setq gnus-winconf-post-news (current-window-configuration)) (gnus-uu-decode-save n file) (gnus-uu-add-file file) (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) --- 416,423 ---- (gnus-uu-initialize) (let ((gnus-uu-save-in-digest t) (file (concat gnus-uu-work-dir (make-temp-name "forward"))) + (winconf (current-window-configuration)) buf) (gnus-uu-decode-save n file) (gnus-uu-add-file file) (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) *************** *** 1617,1625 **** (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction (set-buffer gnus-post-news-buffer) ! (goto-char 1) ! (re-search-forward (regexp-quote mail-header-separator)) ! (beginning-of-line) (forward-line -1) (narrow-to-region 1 (point)) (or (mail-fetch-field "mime-version") --- 1617,1624 ---- (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction (set-buffer gnus-post-news-buffer) ! (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line -1) (narrow-to-region 1 (point)) (or (mail-fetch-field "mime-version") *************** *** 1719,1725 **** (goto-char 1) (if (not (re-search-forward (if gnus-uu-post-separate-description ! gnus-uu-post-binary-separator (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) (error "Internal error: No binary/header separator")) (beginning-of-line) --- 1718,1725 ---- (goto-char 1) (if (not (re-search-forward (if gnus-uu-post-separate-description ! (concat "^" (regexp-quote gnus-uu-post-binary-separator) ! "$") (concat "^" (regexp-quote mail-header-separator) "$")) nil t)) (error "Internal error: No binary/header separator")) (beginning-of-line) *************** *** 1809,1815 **** (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) ! (if (re-search-forward gnus-uu-post-binary-separator nil t) (progn (replace-match "") (forward-line 1))) --- 1809,1817 ---- (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) ! (if (re-search-forward ! (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") ! nil t) (progn (replace-match "") (forward-line 1))) 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 Mon May 8 06:37:49 1995 --- dgnus/lisp/gnus-vis.el Tue May 9 07:00:20 1995 *************** *** 1,4 **** ! ;;; gnus-visual: display-oriented parts of Gnus. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ! ;;; gnus-vis: display-oriented parts of Gnus. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 27,32 **** --- 27,34 ---- (require 'gnus) (require (if gnus-xemacs 'auc-menu 'easymenu)) + ;;; summary highligts + (defvar gnus-summary-selected-face 'underline "*Face used for highlighting the current article in the summary buffer.") *************** *** 49,60 **** ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)") (eval-and-compile ! (autoload 'nnkiboze-generate-groups "nnkiboze")) ;; Newsgroup buffer - ;; Make a menu bar item. (defun gnus-group-make-menu-bar () (easy-menu-define gnus-group-reading-menu --- 51,146 ---- ((= (gnus-summary-article-mark) gnus-replied-mark) . underline)") + ;;; article highlights + + (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-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.") + + + (eval-and-compile ! (autoload 'nnkiboze-generate-groups "nnkiboze") ! (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t)) ! ! ;;; ! ;;; gnus-menu ! ;;; ;; Newsgroup buffer (defun gnus-group-make-menu-bar () (easy-menu-define gnus-group-reading-menu *************** *** 147,152 **** --- 233,239 ---- ) + ;; Server mode (defun gnus-server-make-menu-bar () (easy-menu-define gnus-server-menu *************** *** 163,168 **** --- 250,266 ---- ["Exit" gnus-server-exit t] ))) + ;; Browse mode + (defun gnus-browse-make-menu-bar () + (easy-menu-define + gnus-browse-menu + gnus-browse-mode-map + "" + '("Browse" + ["Subscribe" gnus-browse-unsubscribe-current-group t] + ["Exit" gnus-browse-exit t] + ))) + ;; Summary buffer (defun gnus-summary-make-menu-bar () *************** *** 270,275 **** --- 368,374 ---- ("Mail articles" ["Respool article" gnus-summary-respool-article t] ["Move article" gnus-summary-move-article t] + ["Copy article" gnus-summary-copy-article t] ["Edit article" gnus-summary-edit-article t] ["Delete article" gnus-summary-delete-article t]) )) *************** *** 421,426 **** --- 520,529 ---- )) ) + ;;; + ;;; summary highlights + ;;; + (if gnus-xemacs (defun gnus-visual-highlight-selected-summary () (if gnus-summary-selected-face *************** *** 522,527 **** (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook))) (provide 'gnus-vis) ! ;;; gnus-visual.el ends here --- 625,1024 ---- (easy-menu-add gnus-article-treatment-menu)) gnus-article-mode-hook))) + ;;; + ;;; gnus-carpal + ;;; + + (defvar gnus-carpal-group-buffer-buttons + '(("next" . gnus-group-next-unread-group) + ("prev" . gnus-group-prev-unread-group) + ("read" . gnus-group-read-group) + ("select" . gnus-group-select-group) + ("catch up" . gnus-group-catchup-current) + ("new news" . gnus-group-get-new-news-this-group) + ("toggle sub" . gnus-group-unsubscribe-current-group) + ("subscribe" . gnus-group-unsubscribe-group) + ("kill" . gnus-group-kill-group) + ("yank" . gnus-group-yank-group) + ("describe" . gnus-group-describe-group) + "list" + ("subscribed" . gnus-group-list-groups) + ("all" . gnus-group-list-all-groups) + ("killed" . gnus-group-list-killed) + ("zombies" . gnus-group-list-zombies) + ("matching" . gnus-group-list-matching) + ("post" . gnus-group-post-news) + ("mail" . gnus-group-mail) + ("new news" . gnus-group-get-new-news) + ("browse foreign" . gnus-group-browse-foreign) + ("exit" . gnus-group-exit))) + + (defvar gnus-carpal-summary-buffer-buttons + '("mark" + ("read" . gnus-summary-mark-as-read-forward) + ("tick" . gnus-summary-tick-article-forward) + ("clear" . gnus-summary-clear-mark-forward) + ("expirable" . gnus-summary-mark-as-expirable) + "move" + ("scroll" . gnus-summary-next-page) + ("next unread" . gnus-summary-next-unread-article) + ("prev unread" . gnus-summary-prev-unread-article) + ("first" . gnus-summary-first-unread-article) + ("best" . gnus-summary-best-unread-article) + "article" + ("headers" . gnus-summary-toggle-header) + ("uudecode" . gnus-uu-decode-uu) + ("enter digest" . gnus-summary-enter-digest-group) + ("fetch parent" . gnus-summary-refer-parent-article) + "mail" + ("move" . gnus-summary-move-article) + "threads" + ("lower" . gnus-summary-lower-thread) + ("kill" . gnus-summary-kill-thread) + "post" + ("post" . gnus-summary-post-news) + ("mail" . gnus-summary-mail) + ("followup" . gnus-summary-followup-with-original) + ("reply" . gnus-summary-reply-with-original) + ("cancel" . gnus-summary-cancel-article) + "misc" + ("exit" . gnus-summary-exit) + ("fed up" . gnus-summary-catchup-and-goto-next))) + + (defvar gnus-carpal-server-buffer-buttons + '(("add" . gnus-server-add-server) + ("browse" . gnus-server-browse-server) + ("list" . gnus-server-list-servers) + ("kill" . gnus-server-kill-server) + ("yank" . gnus-server-yank-server) + ("copy" . gnus-server-copy-server) + ("exit" . gnus-server-exit))) + + (defvar gnus-carpal-browse-buffer-buttons + '(("subscribe" . gnus-browse-unsubscribe-current-group) + ("exit" . gnus-browse-exit))) + + (defvar gnus-carpal-group-buffer "*Carpal Group*") + (defvar gnus-carpal-summary-buffer "*Carpal Summary*") + (defvar gnus-carpal-server-buffer "*Carpal Server*") + (defvar gnus-carpal-browse-buffer "*Carpal Browse*") + + (defvar gnus-carpal-attached-buffer nil) + + (defvar gnus-carpal-mode-hook nil + "*Hook run in carpal mode buffers.") + + (defvar gnus-carpal-button-face 'bold + "*Face used on carpal buttons.") + + (defvar gnus-carpal-mode-map nil) + (put 'gnus-carpal-mode 'mode-class 'special) + + (if gnus-carpal-mode-map + nil + (setq gnus-carpal-mode-map (make-keymap)) + (suppress-keymap gnus-carpal-mode-map) + (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) + (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) + (define-key gnus-carpal-mode-map [mouse-2] 'gnus-carpal-select)) + + (defun gnus-carpal-mode () + "Major mode clicking with mouse or keys on buttons. + + All normal editing commands are switched off. + \\ + The following commands are available: + + \\{gnus-carpal-mode-map}" + (interactive) + (kill-all-local-variables) + (setq mode-line-modified "-- ") + (setq major-mode 'gnus-carpal-mode) + (setq mode-name "Gnus Carpal") + (setq mode-line-process nil) + (use-local-map gnus-carpal-mode-map) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) + (make-local-variable 'gnus-carpal-attached-buffer) + (run-hooks 'gnus-carpal-mode-hook)) + + + (defun gnus-carpal-setup-buffer (type) + (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) + (if (get-buffer buffer) + () + (set-buffer (get-buffer-create buffer)) + (gnus-carpal-mode) + (setq gnus-carpal-attached-buffer + (intern (format "gnus-%s-buffer" type))) + (gnus-add-current-to-buffer-list) + (let ((buttons (symbol-value + (intern (format "gnus-carpal-%s-buffer-buttons" type)))) + (buffer-read-only nil) + button) + (while buttons + (setq button (car buttons) + buttons (cdr buttons)) + (if (stringp button) + (insert button " ") + (set-text-properties + (point) + (progn (insert (car button)) (point)) + (list 'gnus-callback (cdr button) + 'face gnus-carpal-button-face)) + (insert " "))) + (let ((fill-column (- (window-width) 2))) + (fill-region (point-min) (point-max))))))) + + (defun gnus-carpal-select () + "Select the button under point." + (interactive) + (let ((func (get-text-property (point) 'gnus-callback))) + (if (null func) + () + (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) + (call-interactively func)))) + + ;;; + ;;; article highlights + ;;; + + ;; Written by Per Abrahamsen . + + ;;; Internal Variables: + + (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-maybe', and `gnus-article-hide-signature' + to do the hiding. See the documentation for those functions." + (interactive) + (gnus-article-hide-headers) + (gnus-article-hide-citation-maybe) + (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-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-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-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-vis) ! ;;; gnus-vis.el ends here diff --exclude=*.elc --exclude=*~ --exclude=*-[0-9] --exclude=gnus --exclude=readme --context --recursive pub/dgnus/lisp/gnus-vm.el dgnus/lisp/gnus-vm.el *** pub/dgnus/lisp/gnus-vm.el Mon May 8 06:37:49 1995 --- dgnus/lisp/gnus-vm.el Tue May 9 07:09:20 1995 *************** *** 32,37 **** --- 32,44 ---- (require 'vm)) (require 'gnus) + (eval-and-compile + (autoload 'vm-mode "vm") + (autoload 'vm-save-message "vm") + (autoload 'vm-forward-message "vm") + (autoload 'vm-reply "vm") + (autoload 'vm-mail "vm")) + (defvar gnus-vm-inhibit-window-system nil "*Inhibit loading `win-vm' if using a window-system.") *************** *** 103,109 **** (widen) (let ((vm-folder (gnus-vm-make-folder)) (vm-forward-message-hook ! (append vm-forward-message-hook '((lambda () (save-excursion (mail-position-on-field "Subject") --- 110,116 ---- (widen) (let ((vm-folder (gnus-vm-make-folder)) (vm-forward-message-hook ! (append (symbol-value 'vm-forward-message-hook) '((lambda () (save-excursion (mail-position-on-field "Subject") *************** *** 116,123 **** (defun gnus-vm-init-reply-buffer (buffer) (make-local-variable 'gnus-summary-buffer) ! (setq gnus-summary-buffer buffer ! vm-mail-buffer nil) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-y" 'gnus-yank-article)) --- 123,130 ---- (defun gnus-vm-init-reply-buffer (buffer) (make-local-variable 'gnus-summary-buffer) ! (setq gnus-summary-buffer buffer) ! (set 'vm-mail-buffer nil) (use-local-map (copy-keymap (current-local-map))) (local-set-key "\C-c\C-y" 'gnus-yank-article)) *************** *** 223,229 **** (not (or mail-citation-hook mail-yank-hooks))) (save-excursion (while (< (point) end) ! (insert vm-included-text-prefix) (forward-line 1))) (push-mark end) (cond --- 230,236 ---- (not (or mail-citation-hook mail-yank-hooks))) (save-excursion (while (< (point) end) ! (insert (symbol-value 'vm-included-text-prefix)) (forward-line 1))) (push-mark end) (cond 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 Mon May 8 06:37:50 1995 --- dgnus/lisp/gnus.el Tue May 9 08:11:40 1995 *************** *** 722,741 **** (defvar gnus-use-full-window t "*If non-nil, use the entire Emacs screen.") ! ; for split windows. maybe a better way? ! (defvar gnus-split-window nil ! "*If non-nil, put the article buffer in left-hand side of the window .") ! ! (defvar gnus-window-configuration ! '((newsgroups (1 0 0)) ! (summary (0 1 0)) ! (article (0 3 10))) ! "*Specify window configurations for each action. ! The format of the variable is either a list of (ACTION (G S A)), where ! G, S, and A are the relative height of group, summary, and article ! windows, respectively, or a list of (ACTION FUNCTION), where FUNCTION ! is a function that will be called with ACTION as an argument. ACTION ! can be `summary', `newsgroups', or `article'.") (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) "*Function to compose a reply. --- 722,788 ---- (defvar gnus-use-full-window t "*If non-nil, use the entire Emacs screen.") ! (defvar gnus-window-configuration nil ! "Obsolete variable. See `gnus-buffer-configuration'.") ! ! (defconst gnus-buffer-configuration ! '((group ([group 1.0 point] ! (if gnus-carpal [group-carpal 4]))) ! (summary ([summary 1.0 point] ! (if gnus-carpal [summary-carpal 4]))) ! (article ([summary 0.25 point] ! (if gnus-carpal [summary-carpal 4]) ! [article 1.0])) ! (server ([server 1.0 point] ! (if gnus-carpal [server-carpal 2]))) ! (browse ([browse 1.0 point] ! (if gnus-carpal [browse-carpal 2]))) ! (group-mail ([mail 1.0 point])) ! (summary-mail ([mail 1.0 point])) ! (summary-reply ([article 0.5] ! [mail 1.0 point])) ! (info ([nil 1.0 point])) ! (summary-faq ([summary 0.25] ! [article 1.0 point])) ! (edit-group ([group 0.5] ! [edit-group 1.0 point])) ! (edit-server ([server 0.5] ! [edit-server 1.0 point])) ! (post ([post 1.0 point])) ! (reply ([article 0.5] ! [mail 1.0 point])) ! (reply-yank ([mail 1.0 point])) ! (followup ([article 0.5] ! [post 1.0 point])) ! (followup-yank ([post 1.0 point]))) ! "Window configuration for all possible Gnus buffers. ! This variable is a list of lists. Each of these lists has a NAME and ! a RULE. The NAMEs are commonsense names like `group', which names a ! rule used when displaying the group buffer; `summary', which names a ! rule for what happens when you enter a group and do not display an ! article buffer; and so on. See the value of this variable for a ! complete list of NAMEs. ! ! Each RULE is a list of vectors. The first element in this vector is ! the name of the buffer to be displayed; the second element is the ! percentage of the screen this buffer is to occupy (a number in the ! 0.0-0.99 range); the optional third element is `point', which should ! be present to denote which buffer point is to go to after making this ! buffer configuration.") ! ! (defvar gnus-window-to-buffer ! '((group . gnus-group-buffer) ! (summary . gnus-summary-buffer) ! (article . gnus-article-buffer) ! (server . gnus-server-buffer) ! (browse . "*Gnus Browse Server*") ! (edit-group . gnus-group-edit-buffer) ! (edit-server . gnus-server-edit-buffer) ! (mail . "*mail*") ! (post . gnus-post-news-buffer))) ! ! (defvar gnus-carpal nil ! "*If non-nil, display clickable icons.") (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) "*Function to compose a reply. *************** *** 1314,1323 **** (defvar gnus-have-read-active-file nil) ! (defconst gnus-maintainer "Lars Magne Ingebrigtsen " "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.65" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1361,1370 ---- (defvar gnus-have-read-active-file nil) ! (defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)" "The mail address of the Gnus maintainer.") ! (defconst gnus-version "(ding) Gnus v0.66" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1468,1474 **** (defvar gnus-current-kill-article nil) ;; Save window configuration. ! (defvar gnus-winconf-edit-group nil) ;; Format specs (defvar gnus-summary-line-format-spec nil) --- 1515,1521 ---- (defvar gnus-current-kill-article nil) ;; Save window configuration. ! (defvar gnus-prev-winconf nil) ;; Format specs (defvar gnus-summary-line-format-spec nil) *************** *** 1544,1565 **** (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") --- 1591,1617 ---- (autoload 'gnus-Folder-save-name "gnus-mh") (autoload 'gnus-folder-save-name "gnus-mh") ! ;; gnus-vis misc (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-browse-make-menu-bar "gnus-vis") (autoload 'gnus-visual-highlight-selected-summary "gnus-vis") (autoload 'gnus-visual-summary-highlight-line "gnus-vis") + (autoload 'gnus-carpal-setup-buffer "gnus-vis") ! ;; gnus-vis article ! (autoload 'gnus-article-push-button "gnus-vis" nil t) ! (autoload 'gnus-article-highlight "gnus-vis" nil t) ! (autoload 'gnus-article-hide "gnus-vis" nil t) ! (autoload 'gnus-article-highlight-headers "gnus-vis" nil t) ! (autoload 'gnus-article-highlight-signature "gnus-vis" nil t) ! (autoload 'gnus-article-add-buttons "gnus-vis" nil t) ! ! ;; gnus-cite ! (autoload 'gnus-article-highlight-citation "gnus-cite" nil t) ! (autoload 'gnus-article-hide-citation-maybe "gnus-cite" nil t) ;; gnus-kill (autoload 'gnus-kill "gnus-kill") *************** *** 1915,1924 **** (if (get-buffer gnus-work-buffer) (progn (set-buffer gnus-work-buffer) - (gnus-add-current-to-buffer-list) (erase-buffer)) (set-buffer (get-buffer-create gnus-work-buffer)) ! (buffer-disable-undo (current-buffer)))) ;; Article file names when saving. --- 1967,1976 ---- (if (get-buffer gnus-work-buffer) (progn (set-buffer gnus-work-buffer) (erase-buffer)) (set-buffer (get-buffer-create gnus-work-buffer)) ! (buffer-disable-undo (current-buffer)) ! (gnus-add-current-to-buffer-list))) ;; Article file names when saving. *************** *** 2254,2373 **** (gnus-kill-buffer (car gnus-buffer-list)) (setq gnus-buffer-list (cdr gnus-buffer-list)))) ! (defun gnus-configure-windows (action &optional force) ! "Configure Gnus windows according to the next ACTION. ! The ACTION is either a symbol, such as `summary', or a ! configuration list such as `(1 1 2)'. If ACTION is not a list, ! configuration list is got from the variable gnus-window-configuration. ! If FORCE is non-nil, the updating will be done whether it is necessary ! or not." ! (let* ((windows ! (if (listp action) action ! (if (listp gnus-window-configuration) ! (car (cdr (assq action gnus-window-configuration))) ! gnus-window-configuration))) ! (grpwin (get-buffer-window gnus-group-buffer)) ! (subwin (get-buffer-window gnus-summary-buffer)) ! (artwin (get-buffer-window gnus-article-buffer)) ! (winsum nil) ! (height nil) ! (grpheight 0) ! (subheight 0) ! (artheight 0) ! ;; Make split-window-vertically leave focus in upper window. ! (split-window-keep-point t)) ! (if (and (symbolp windows) (fboundp windows)) ! (funcall windows action) ! (if (and (not force) ! (or (null windows) ;No configuration is specified. ! (and (eq (null grpwin) ! (zerop (nth 0 windows))) ! (eq (null subwin) ! (zerop (nth 1 windows))) ! (eq (null artwin) ! (zerop (nth 2 windows)))))) ! ;; No need to change window configuration. ! nil ! (select-window (or grpwin subwin artwin (selected-window))) ! ;; First of all, compute the height of each window. ! (cond (gnus-use-full-window ! ;; Take up the entire screen. ! (delete-other-windows) ! (setq height (window-height (selected-window)))) ! (t ! (setq height (+ (if grpwin (window-height grpwin) 0) ! (if subwin (window-height subwin) 0) ! (if artwin (window-height artwin) 0))))) ! ;; The group buffer exits always. So, use it to extend the ! ;; group window so as to get enough window space. ! (switch-to-buffer gnus-group-buffer 'norecord) ! (and (get-buffer gnus-summary-buffer) ! (delete-windows-on gnus-summary-buffer)) ! (and (get-buffer gnus-article-buffer) ! (delete-windows-on gnus-article-buffer)) ! ;; Compute expected window height. ! (setq winsum (apply (function +) windows)) ! (if (not (zerop (nth 0 windows))) ! (setq grpheight (max window-min-height ! (/ (* height (nth 0 windows)) winsum)))) ! (if (not (zerop (nth 1 windows))) ! (setq subheight (max window-min-height ! (/ (* height (nth 1 windows)) winsum)))) ! (if (not (zerop (nth 2 windows))) ! (if gnus-split-window ;hack by erik ! (setq artheight height) ! (setq artheight (max window-min-height ! (/ (* height (nth 2 windows)) winsum))))) ! (setq height (+ grpheight subheight artheight)) ! (enlarge-window (max 0 (- height (window-height (selected-window))))) ! ;; Then split the window. ! (if (and (not (zerop artheight)) ! (or (not (zerop grpheight)) ! (not (zerop subheight)))) ! (if gnus-split-window ! (split-window-horizontally) ! (split-window-vertically (+ grpheight subheight)))) ! (and (not (zerop grpheight)) ! (not (zerop subheight)) ! (split-window-vertically grpheight)) ! ;; Then select buffers in each window. ! (or (zerop grpheight) ! (progn ! (switch-to-buffer gnus-group-buffer 'norecord) ! (other-window 1))) ! (or (zerop subheight) (progn ! (switch-to-buffer gnus-summary-buffer 'norecord) ! (other-window 1))) ! (or (zerop artheight) ! (progn ! ;; If article buffer does not exist, it will be created ! ;; and initialized. ! (gnus-article-setup-buffer) ! (switch-to-buffer gnus-article-buffer 'norecord) ! (setq buffer-read-only t) ; !!! Why!?! ! (bury-buffer gnus-summary-buffer) ! (bury-buffer gnus-group-buffer))) ! (or (zerop subheight) (progn ! (pop-to-buffer gnus-summary-buffer) ! ;; It seems that some code in this function will set ! ;; buffer-read-only to nil. I have absolutely no idea ! ;; why. ! (setq buffer-read-only t))))))) ; !!! Why!?! ! ! (defun gnus-window-configuration-split (action) ! (switch-to-buffer gnus-group-buffer t) ! (delete-other-windows) ! (split-window-horizontally) ! (cond ((memq action '(newsgoups summary)) ! (if (gnus-buffer-exists-p gnus-summary-buffer) ! (switch-to-buffer-other-window gnus-summary-buffer))) ! ((eq action 'article) ! (switch-to-buffer gnus-summary-buffer t) ! (other-window 1) ! (gnus-article-setup-buffer) ! (switch-to-buffer gnus-article-buffer t)))) (defun gnus-version () "Version numbers of this version of Gnus." --- 2306,2445 ---- (gnus-kill-buffer (car gnus-buffer-list)) (setq gnus-buffer-list (cdr gnus-buffer-list)))) ! (defun gnus-windows-old-to-new (setting) ! (if (or (listp setting) ! (not (and gnus-window-configuration ! (memq setting '(group summary article))))) ! setting ! (let* ((setting (if (eq setting 'group) 'newsgroup setting)) ! (elem (cdr (assq setting gnus-window-configuration))) ! (total (apply '+ elem)) ! (types '(group summary article)) ! (i 0) ! perc ! out) ! (while (< i 3) ! (or (zerop (nth i elem)) (progn ! (setq perc (/ (* 1.0 (nth 0 elem)) total)) ! (setq out (cons (if (eq setting (nth i types)) ! (vector (nth i types) perc 'point) ! (vector (nth i types) perc)) ! out)))) ! (setq i (1+ i))) ! (nreverse out)))) ! ! (defun gnus-configure-windows (setting) ! (setq setting (gnus-windows-old-to-new setting)) ! (let ((r (if (symbolp setting) ! (cdr (assq setting gnus-buffer-configuration)) ! setting)) ! (in-buf (current-buffer)) ! rule val window w height hor ohor heights sub jump-buffer ! rel total to-buf) ! (or r (error "No such setting: %s" setting)) ! ! ;; Either remove all windows or just remove all Gnus windows. ! (if gnus-use-full-window ! (delete-other-windows) ! (gnus-remove-some-windows) ! (switch-to-buffer nntp-server-buffer)) ! ! (while r ! (setq hor (car r) ! ohor nil) ! ! ;; We have to do the (possible) horizontal splitting before the ! ;; vertical. ! (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal)) ! (progn ! (setq hor (cdr hor)) ! (split-window nil nil t))) ! ! ;; Go through the rules and eval the elements that are to be ! ;; evaled. ! (while hor ! (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor)))) (progn ! ;; Expand short buffer name. ! (setq w (aref val 0)) ! (and (setq w (cdr (assq w gnus-window-to-buffer))) ! (progn ! (setq val (apply 'vector (mapcar (lambda (v) v) val))) ! (aset val 0 w))) ! (setq ohor (cons val ohor)))) ! (setq hor (cdr hor))) ! (setq rule (cons (nreverse ohor) rule)) ! (setq r (cdr r))) ! (setq rule (nreverse rule)) ! ! ;; We tally the window sizes. ! (setq total (window-height)) ! (while rule ! (setq hor (car rule)) ! (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal)) ! (setq hor (cdr hor))) ! (setq sub 0) ! (while hor ! (setq rel (aref (car hor) 1) ! heights (cons ! (cond ((and (floatp rel) (= 1.0 rel)) ! 'x) ! ((integerp rel) ! rel) ! (t ! (max (floor (* total rel)) 4))) ! heights) ! sub (+ sub (if (numberp (car heights)) (car heights) 0)) ! hor (cdr hor))) ! (setq heights (nreverse heights) ! hor (car rule)) ! ! ;; We then go through these heighs and create windows for them. ! (while heights ! (setq height (car heights) ! heights (cdr heights)) ! (and (eq height 'x) ! (setq height (- total sub))) ! (and heights ! (split-window nil height)) ! (setq to-buf (aref (car hor) 0)) ! (switch-to-buffer ! (cond ((not to-buf) ! in-buf) ! ((symbolp to-buf) ! (symbol-value (aref (car hor) 0))) ! (t ! (aref (car hor) 0)))) ! (and (> (length (car hor)) 2) ! (eq (aref (car hor) 2) 'point) ! (setq jump-buffer (current-buffer))) ! (other-window 1) ! (setq hor (cdr hor))) ! ! (setq rule (cdr rule))) ! ! ;; Finally, we pop to the buffer that's supposed to have point. ! (pop-to-buffer jump-buffer) ! jump-buffer)) ! ! (defun gnus-remove-some-windows () ! (let ((buffers gnus-window-to-buffer) ! (first t) ! buf) ! (while buffers ! (setq buf (cdr (car buffers))) ! (and (symbolp buf) (setq buf (symbol-value buf))) ! (and buf (get-buffer-window buf) ! (progn ! (set-buffer buf) ! (if first ! (progn ! (switch-to-buffer nntp-server-buffer) ! (setq first nil)) ! (delete-window (get-buffer-window buf))))) ! (setq buffers (cdr buffers))) ! (set-buffer nntp-server-buffer))) (defun gnus-version () "Version numbers of this version of Gnus." *************** *** 2391,2403 **** "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. ! (cond ((eq major-mode 'gnus-group-mode) ! (gnus-configure-windows '(1 0 0)) ;Take all windows. ! (pop-to-buffer gnus-group-buffer)) ! ((eq major-mode 'gnus-summary-mode) ! (gnus-configure-windows '(0 1 0)) ;Take all windows. ! (pop-to-buffer gnus-summary-buffer))) ! (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes))))) (defun gnus-bug () "Send a bug report to the Gnus maintainers." --- 2463,2471 ---- "Find Info documentation of Gnus." (interactive) ;; Enlarge info window if needed. ! (let ((mode major-mode)) ! (gnus-configure-windows 'info) ! (Info-goto-node (car (cdr (assq mode gnus-info-nodes)))))) (defun gnus-bug () "Send a bug report to the Gnus maintainers." *************** *** 2409,2416 **** (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (format "%s\n%s\n\n" (gnus-version) (emacs-version))) ! (gnus-debug) (message "")) (defun gnus-debug () --- 2477,2486 ---- (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version))) ! (let ((b (point))) ! (gnus-debug) ! (goto-char (- b 3))) (message "")) (defun gnus-debug () *************** *** 3034,3040 **** (progn (switch-to-buffer gnus-group-buffer) (gnus-add-current-to-buffer-list) ! (gnus-group-mode)))) (defun gnus-group-list-groups (level &optional unread) "List newsgroups with level LEVEL or lower that have unread alticles. --- 3104,3111 ---- (progn (switch-to-buffer gnus-group-buffer) (gnus-add-current-to-buffer-list) ! (gnus-group-mode) ! (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) (defun gnus-group-list-groups (level &optional unread) "List newsgroups with level LEVEL or lower that have unread alticles. *************** *** 3667,3673 **** "Jump to the server buffer." (interactive) (gnus-server-setup-buffer) ! (switch-to-buffer gnus-server-buffer) (gnus-server-prepare)) (defun gnus-group-make-group (name method address) --- 3738,3744 ---- "Jump to the server buffer." (interactive) (gnus-server-setup-buffer) ! (gnus-configure-windows 'server) (gnus-server-prepare)) (defun gnus-group-make-group (name method address) *************** *** 3715,3730 **** (interactive) (gnus-group-edit-group-done 'part 'group))) (part (or part 'info)) info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "No group on current line")) ! (setq gnus-winconf-edit-group (current-window-configuration)) ! (pop-to-buffer gnus-group-edit-buffer) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) ;; Suggested by Hallvard B Furuseth . (use-local-map (copy-keymap emacs-lisp-mode-map)) (local-set-key "\C-c\C-c" done-func) ;; We modify the func to let it know what part it is editing. (setcar (cdr (nth 4 done-func)) (list 'quote part)) (setcar (cdr (cdr (nth 4 done-func))) group) --- 3786,3804 ---- (interactive) (gnus-group-edit-group-done 'part 'group))) (part (or part 'info)) + (winconf (current-window-configuration)) info) (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "No group on current line")) ! (set-buffer (get-buffer-create gnus-group-edit-buffer)) ! (gnus-configure-windows 'edit-group) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) ;; Suggested by Hallvard B Furuseth . (use-local-map (copy-keymap emacs-lisp-mode-map)) (local-set-key "\C-c\C-c" done-func) + (make-local-variable 'gnus-prev-winconf) + (setq gnus-prev-winconf winconf) ;; We modify the func to let it know what part it is editing. (setcar (cdr (nth 4 done-func)) (list 'quote part)) (setcar (cdr (cdr (nth 4 done-func))) group) *************** *** 3772,3785 **** "Get info from buffer, update variables and jump to the group buffer." (set-buffer (get-buffer-create gnus-group-edit-buffer)) (goto-char (point-min)) ! (let ((form (read (current-buffer)))) (if (eq part 'info) (gnus-group-set-info form) (gnus-group-set-info form group part)) (kill-buffer (current-buffer)) ! (and gnus-winconf-edit-group ! (set-window-configuration gnus-winconf-edit-group)) ! (setq gnus-winconf-edit-group nil) (set-buffer gnus-group-buffer) (gnus-group-update-group (gnus-group-group-name)) (gnus-group-position-cursor))) --- 3846,3858 ---- "Get info from buffer, update variables and jump to the group buffer." (set-buffer (get-buffer-create gnus-group-edit-buffer)) (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (winconf gnus-prev-winconf)) (if (eq part 'info) (gnus-group-set-info form) (gnus-group-set-info form group part)) (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) (gnus-group-update-group (gnus-group-group-name)) (gnus-group-position-cursor))) *************** *** 4478,4514 **** ;;; Browse Server Mode ;;; ! (defvar gnus-browse-server-mode-hook nil) ! (defvar gnus-browse-server-mode-map nil) ! (put 'gnus-browse-server-mode 'mode-class 'special) ! (if gnus-browse-server-mode-map nil ! (setq gnus-browse-server-mode-map (make-keymap)) ! (suppress-keymap gnus-browse-server-mode-map) ! (define-key gnus-browse-server-mode-map " " 'gnus-browse-read-group) ! (define-key gnus-browse-server-mode-map "=" 'gnus-browse-read-group) ! (define-key gnus-browse-server-mode-map "n" 'gnus-browse-next-group) ! (define-key gnus-browse-server-mode-map "p" 'gnus-browse-prev-group) ! (define-key gnus-browse-server-mode-map "\177" 'gnus-browse-prev-group) ! (define-key gnus-browse-server-mode-map "N" 'gnus-browse-next-group) ! (define-key gnus-browse-server-mode-map "P" 'gnus-browse-prev-group) ! (define-key gnus-browse-server-mode-map "\M-n" 'gnus-browse-next-group) ! (define-key gnus-browse-server-mode-map "\M-p" 'gnus-browse-prev-group) ! (define-key gnus-browse-server-mode-map "\r" 'gnus-browse-read-group) ! (define-key gnus-browse-server-mode-map "u" 'gnus-browse-unsubscribe-current-group) ! (define-key gnus-browse-server-mode-map "l" 'gnus-browse-exit) ! (define-key gnus-browse-server-mode-map "L" 'gnus-browse-exit) ! (define-key gnus-browse-server-mode-map "q" 'gnus-browse-exit) ! (define-key gnus-browse-server-mode-map "Q" 'gnus-browse-exit) ! (define-key gnus-browse-server-mode-map "\C-c\C-c" 'gnus-browse-exit) ! (define-key gnus-browse-server-mode-map "?" 'gnus-browse-describe-briefly) ! (define-key gnus-browse-server-mode-map "\C-c\C-i" 'gnus-info-find-node) ) (defvar gnus-browse-current-method nil) (defvar gnus-browse-return-buffer nil) (defun gnus-browse-foreign-server (method &optional return-buffer) (setq gnus-browse-current-method method) (setq gnus-browse-return-buffer return-buffer) --- 4551,4589 ---- ;;; Browse Server Mode ;;; ! (defvar gnus-browse-mode-hook nil) ! (defvar gnus-browse-mode-map nil) ! (put 'gnus-browse-mode 'mode-class 'special) ! (if gnus-browse-mode-map nil ! (setq gnus-browse-mode-map (make-keymap)) ! (suppress-keymap gnus-browse-mode-map) ! (define-key gnus-browse-mode-map " " 'gnus-browse-read-group) ! (define-key gnus-browse-mode-map "=" 'gnus-browse-read-group) ! (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group) ! (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group) ! (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group) ! (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group) ! (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group) ! (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group) ! (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group) ! (define-key gnus-browse-mode-map "\r" 'gnus-browse-read-group) ! (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group) ! (define-key gnus-browse-mode-map "l" 'gnus-browse-exit) ! (define-key gnus-browse-mode-map "L" 'gnus-browse-exit) ! (define-key gnus-browse-mode-map "q" 'gnus-browse-exit) ! (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit) ! (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit) ! (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly) ! (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node) ) (defvar gnus-browse-current-method nil) (defvar gnus-browse-return-buffer nil) + (defvar gnus-browse-buffer "*Gnus Browse Server*") + (defun gnus-browse-foreign-server (method &optional return-buffer) (setq gnus-browse-current-method method) (setq gnus-browse-return-buffer return-buffer) *************** *** 4520,4531 **** (error "Unable to contact server: %s" (gnus-status-message method))) (or (gnus-request-list method) (error "Couldn't request list: %s" (gnus-status-message method))) ! (set-buffer (get-buffer-create "*Gnus Browse Server*")) (gnus-add-current-to-buffer-list) (buffer-disable-undo (current-buffer)) (let ((buffer-read-only nil)) (erase-buffer)) ! (gnus-browse-server-mode) (setq mode-line-buffer-identification (format "(ding) Browse Server {%s:%s}" (car method) (car (cdr method)))) --- 4595,4608 ---- (error "Unable to contact server: %s" (gnus-status-message method))) (or (gnus-request-list method) (error "Couldn't request list: %s" (gnus-status-message method))) ! (get-buffer-create gnus-browse-buffer) (gnus-add-current-to-buffer-list) + (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) + (gnus-configure-windows 'browse) (buffer-disable-undo (current-buffer)) (let ((buffer-read-only nil)) (erase-buffer)) ! (gnus-browse-mode) (setq mode-line-buffer-identification (format "(ding) Browse Server {%s:%s}" (car method) (car (cdr method)))) *************** *** 4554,4576 **** (goto-char 1) (gnus-group-position-cursor))) ! (defun gnus-browse-server-mode () "Major mode for browsing a foreign server." (interactive) (kill-all-local-variables) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) ! (setq major-mode 'gnus-browse-server-mode) (setq mode-name "Browse Server") (setq mode-line-process nil) ! (use-local-map gnus-browse-server-mode-map) (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (setq buffer-read-only t) ! (run-hooks 'gnus-browse-server-mode-hook)) (defun gnus-browse-read-group () "Not implemented, and will probably never be." --- 4631,4654 ---- (goto-char 1) (gnus-group-position-cursor))) ! (defun gnus-browse-mode () "Major mode for browsing a foreign server." (interactive) (kill-all-local-variables) + (if gnus-visual (gnus-browse-make-menu-bar)) (setq mode-line-modified "-- ") (make-local-variable 'mode-line-format) (setq mode-line-format (copy-sequence mode-line-format)) (and (equal (nth 3 mode-line-format) " ") (setcar (nthcdr 3 mode-line-format) "")) ! (setq major-mode 'gnus-browse-mode) (setq mode-name "Browse Server") (setq mode-line-process nil) ! (use-local-map gnus-browse-mode-map) (buffer-disable-undo (current-buffer)) (setq truncate-lines t) (setq buffer-read-only t) ! (run-hooks 'gnus-browse-mode-hook)) (defun gnus-browse-read-group () "Not implemented, and will probably never be." *************** *** 4635,4649 **** (defun gnus-browse-exit () "Quit browsing and return to the group buffer." (interactive) ! (if (eq major-mode 'gnus-browse-server-mode) (kill-buffer (current-buffer))) ! (switch-to-buffer (or gnus-browse-return-buffer gnus-group-buffer))) (defun gnus-browse-describe-briefly () "Give a one line description of the group mode commands." (interactive) (message ! (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) ;;; --- 4713,4729 ---- (defun gnus-browse-exit () "Quit browsing and return to the group buffer." (interactive) ! (if (eq major-mode 'gnus-browse-mode) (kill-buffer (current-buffer))) ! (if gnus-browse-return-buffer ! (gnus-configure-windows 'server) ! (gnus-configure-windows 'group))) (defun gnus-browse-describe-briefly () "Give a one line description of the group mode commands." (interactive) (message ! (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) ;;; *************** *** 5026,5031 **** --- 5106,5112 ---- (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode) + (and gnus-carpal (gnus-carpal-setup-buffer 'summary)) t))) (defun gnus-set-global-variables () *************** *** 5117,5130 **** (and gnus-visual (run-hooks 'gnus-visual-summary-update-hook)))))) ! (defun gnus-summary-update-lines () ;; Rehighlight summary buffer according to `gnus-summary-highlight'. ! (and (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char (point-min)) ! (while (not (eobp)) ! (gnus-summary-update-line) ! (forward-line 1))))) (defun gnus-summary-number-of-articles-in-thread (thread &optional char) ;; Sum up all elements (and sub-elements) in a list. --- 5198,5213 ---- (and gnus-visual (run-hooks 'gnus-visual-summary-update-hook)))))) ! (defun gnus-summary-update-lines (&optional beg end) ;; Rehighlight summary buffer according to `gnus-summary-highlight'. ! (let ((beg (or beg (point-min))) ! (end (or end (point-max)))) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char beg) ! (while (and (not (eobp)) (< (point) end)) ! (gnus-summary-update-line) ! (forward-line 1))))) (defun gnus-summary-number-of-articles-in-thread (thread &optional char) ;; Sum up all elements (and sub-elements) in a list. *************** *** 5151,5157 **** (gnus-set-global-variables) (gnus-kill-buffer kill-buffer) (gnus-configure-windows 'summary) - (pop-to-buffer gnus-summary-buffer) (gnus-set-mode-line 'summary) (gnus-summary-position-cursor) (message "") --- 5234,5239 ---- *************** *** 5165,5177 **** (gnus-group-next-unread-group 1))) nil) ((eq did-select 'quit) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'newsgroup) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) (gnus-kill-buffer kill-buffer) ! (switch-to-buffer gnus-group-buffer) (gnus-group-next-unread-group 1) (signal 'quit nil)) (t --- 5247,5257 ---- (gnus-group-next-unread-group 1))) nil) ((eq did-select 'quit) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) (gnus-kill-buffer kill-buffer) ! (gnus-configure-windows 'group) (gnus-group-next-unread-group 1) (signal 'quit nil)) (t *************** *** 5204,5210 **** (save-excursion (if kill-buffer (let ((gnus-summary-buffer kill-buffer)) ! (gnus-configure-windows 'newsgroups t)))) ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. --- 5284,5290 ---- (save-excursion (if kill-buffer (let ((gnus-summary-buffer kill-buffer)) ! (gnus-configure-windows 'group)))) ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. *************** *** 5218,5224 **** (gnus-summary-first-unread-article)) (gnus-configure-windows 'article) (gnus-configure-windows 'summary)) - (pop-to-buffer gnus-summary-buffer) (gnus-set-mode-line 'summary) (gnus-summary-position-cursor) ;; If in async mode, we send some info to the backend. --- 5298,5303 ---- *************** *** 5367,5373 **** (gnus-simplify-subject-re (header-subject (car headers))))) (progn ! (setq roots (cons (car headers) roots)) (setcdr prev (cdr headers))) (setq prev headers)) (setq headers (cdr headers))))) --- 5446,5459 ---- (gnus-simplify-subject-re (header-subject (car headers))))) (progn ! (if (not (< (or (cdr (assq (header-number (car headers)) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-expunge-below)) ! (setq roots (cons (car headers) roots)) ! (setq gnus-newsgroup-unreads ! (delq (header-number (car headers)) ! gnus-newsgroup-unreads))) (setcdr prev (cdr headers))) (setq prev headers)) (setq headers (cdr headers))))) *************** *** 5504,5515 **** (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))) --- 5590,5603 ---- (substring refs (match-beginning 1) (match-end 1))))) (setq thread (gnus-make-sub-thread (car parent))) (gnus-rebuild-remove-articles thread) ! (let ((beg (point))) ! (gnus-summary-prepare-threads (list thread) 0) ! (gnus-summary-update-lines beg (point))))) ;; Delete all lines in the summary buffer that correspond to articles ;; in this thread. (defun gnus-rebuild-remove-articles (thread) ! (and (gnus-summary-goto-subject (header-number (car thread))) (gnus-delete-line)) (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread))) *************** *** 6777,6783 **** (gnus-set-global-variables) ;; Fix by Ilja Weis . (let ((group gnus-newsgroup-name)) ! (gnus-summary-exit t) (gnus-summary-jump-to-group group) (save-excursion (set-buffer gnus-group-buffer) --- 6865,6871 ---- (gnus-set-global-variables) ;; Fix by Ilja Weis . (let ((group gnus-newsgroup-name)) ! (gnus-summary-exit) (gnus-summary-jump-to-group group) (save-excursion (set-buffer gnus-group-buffer) *************** *** 6849,6858 **** (gnus-summary-clear-local-variables) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. ! (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) - (gnus-configure-windows 'article) - (gnus-configure-windows 'newsgroups) ;; Return to group mode buffer. (if (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf)) --- 6937,6944 ---- (gnus-summary-clear-local-variables) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. ! (gnus-configure-windows 'group) (gnus-summary-clear-local-variables) ;; Return to group mode buffer. (if (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf)) *************** *** 6886,6897 **** (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) ;; Return to group selection mode. ! (gnus-configure-windows 'newsgroups) (if (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) - (pop-to-buffer gnus-group-buffer) (if (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (if (gnus-buffer-exists-p quit-buffer) --- 6972,6982 ---- (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) ;; Return to group selection mode. ! (gnus-configure-windows 'group) (if (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (if (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (if (gnus-buffer-exists-p quit-buffer) *************** *** 6903,6910 **** (defun gnus-summary-fetch-faq (group) "Fetch the FAQ for the current group." (interactive (list gnus-newsgroup-name)) ! (gnus-configure-windows 'article) ! (pop-to-buffer gnus-article-buffer) (find-file (concat gnus-group-faq-directory group))) ;; Suggested by Per Abrahamsen . --- 6988,6994 ---- (defun gnus-summary-fetch-faq (group) "Fetch the FAQ for the current group." (interactive (list gnus-newsgroup-name)) ! (gnus-configure-windows 'summary-faq) (find-file (concat gnus-group-faq-directory group))) ;; Suggested by Per Abrahamsen . *************** *** 7064,7071 **** "Expand summary window to show headers full window." (interactive) (gnus-set-global-variables) ! (gnus-configure-windows 'summary) ! (pop-to-buffer gnus-summary-buffer)) (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." --- 7148,7154 ---- "Expand summary window to show headers full window." (interactive) (gnus-set-global-variables) ! (gnus-configure-windows 'summary)) (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." *************** *** 7108,7114 **** article) (if all-headers (gnus-article-show-all-headers)) (gnus-configure-windows 'article) - (pop-to-buffer gnus-summary-buffer) nil))) (defun gnus-summary-set-current-mark (&optional current-mark) --- 7191,7196 ---- *************** *** 7262,7268 **** ;; Selected subject is different from current article's. (gnus-summary-display-article article) (gnus-configure-windows 'article) - (pop-to-buffer gnus-summary-buffer) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-article-prev-page lines)))) (gnus-summary-position-cursor)) --- 7344,7349 ---- *************** *** 9296,9306 **** (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 ! (list "#" "\M-#" "\C-c\M-#" "\r" "n" "p" "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r" "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" --- 9377,9388 ---- (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) ! (define-key gnus-article-mode-map "\r" 'gnus-article-push-button) ;; Duplicate almost all summary keystrokes in the article mode map. (let ((commands ! (list "#" "\M-#" "\C-c\M-#" "n" "p" "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r" "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" "c" "x" "X" *************** *** 9363,9369 **** (save-excursion (set-buffer (get-buffer-create gnus-article-buffer)) (gnus-add-current-to-buffer-list) ! (gnus-article-mode)))) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." --- 9445,9452 ---- (save-excursion (set-buffer (get-buffer-create gnus-article-buffer)) (gnus-add-current-to-buffer-list) ! (gnus-article-mode) ! (and gnus-carpal (gnus-carpal-setup-buffer 'article))))) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." *************** *** 10050,10056 **** "Reconfigure windows to show summary buffer." (interactive) (gnus-configure-windows 'article) - (pop-to-buffer gnus-summary-buffer) (gnus-summary-goto-subject gnus-current-article)) (defun gnus-article-describe-briefly () --- 10133,10138 ---- *************** *** 10674,10679 **** --- 10756,10766 ---- (funcall (gnus-get-function method 'request-create-group) (gnus-group-real-name group) (nth 1 method)))) + (defun gnus-member-of-valid (symbol group) + (memq symbol (assoc + (format "%s" (car (gnus-find-method-for-group group))) + gnus-valid-select-methods))) + (defun gnus-find-method-for-group (group &optional info) (or gnus-override-method (and (not group) *************** *** 12107,12113 **** () (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) ! (gnus-server-mode)))) (defun gnus-server-prepare () (setq gnus-server-mode-line-format-spec --- 12194,12201 ---- () (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) ! (gnus-server-mode) ! (and gnus-carpal (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () (setq gnus-server-mode-line-format-spec *************** *** 12132,12138 **** (defalias 'gnus-server-position-cursor 'gnus-goto-colon) - (defvar gnus-winconf-edit-server nil) (defconst gnus-server-edit-buffer "*Gnus edit server*") (defun gnus-server-update-server (server) --- 12220,12225 ---- *************** *** 12303,12310 **** (interactive (list (gnus-server-server-name))) (or server (error "No server on current line")) ! (setq gnus-winconf-edit-server (current-window-configuration)) ! (pop-to-buffer gnus-server-edit-buffer) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) (use-local-map (copy-keymap (current-local-map))) --- 12390,12399 ---- (interactive (list (gnus-server-server-name))) (or server (error "No server on current line")) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf (current-window-configuration)) ! (get-buffer-create gnus-server-edit-buffer) ! (gnus-configure-windows 'edit-server) (gnus-add-current-to-buffer-list) (emacs-lisp-mode) (use-local-map (copy-keymap (current-local-map))) *************** *** 12322,12336 **** (interactive) (set-buffer (get-buffer-create gnus-server-edit-buffer)) (goto-char (point-min)) ! (let ((form (read (current-buffer)))) ! (gnus-server-set-info server form)) ! (kill-buffer (current-buffer)) ! (and gnus-winconf-edit-server ! (set-window-configuration gnus-winconf-edit-server)) ! (setq gnus-winconf-edit-server nil) ! (set-buffer gnus-server-buffer) ! (gnus-server-update-server (gnus-server-server-name)) ! (gnus-server-position-cursor)) (defun gnus-server-read-server (server) "Browse a server." --- 12411,12424 ---- (interactive) (set-buffer (get-buffer-create gnus-server-edit-buffer)) (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (winconf gnus-prev-winconf)) ! (gnus-server-set-info server form) ! (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) ! (set-buffer gnus-server-buffer) ! (gnus-server-update-server (gnus-server-server-name)) ! (gnus-server-position-cursor))) (defun gnus-server-read-server (server) "Browse a server." 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 Mon May 8 06:37:54 1995 --- dgnus/texi/gnus.texi Mon May 8 17:23:03 1995 *************** *** 2792,2798 **** @kindex S R (Summary) @findex gnus-summary-reply-with-original Mail a reply to the author of the current article and include the ! original message (@code{gnus-summary-reply-with-original}). @item S o m @kindex S o m (Summary) @findex gnus-summary-mail-forward --- 2792,2799 ---- @kindex S R (Summary) @findex gnus-summary-reply-with-original Mail a reply to the author of the current article and include the ! original message (@code{gnus-summary-reply-with-original}). This ! command uses the process/prefix convention. @item S o m @kindex S o m (Summary) @findex gnus-summary-mail-forward *************** *** 2891,2897 **** @kindex F (Summary) @findex gnus-summary-followup-with-original Post a followup to the current article and include the original message ! (@code{gnus-summary-followup-with-original}). @item S u @kindex S u (Summary) @findex gnus-uu-post-news --- 2892,2899 ---- @kindex F (Summary) @findex gnus-summary-followup-with-original Post a followup to the current article and include the original message ! (@code{gnus-summary-followup-with-original}). This command uses the ! process/prefix convention. @item S u @kindex S u (Summary) @findex gnus-uu-post-news *************** *** 3065,3070 **** --- 3067,3073 ---- @findex gnus-summary-followup-and-reply-with-original Post a followup and send a reply to the current article and include the original message (@code{gnus-summary-followup-and-reply-with-original}). + This command uses the process/prefix convention. @end table Here's a list of variables that are relevant to both mailing and *************** *** 5779,5815 **** @vindex gnus-use-full-window If non-@code{nil}, Gnus will delete all other windows and occupy the entire Emacs screen by itself. It is @code{t} by default. ! @item gnus-window-configuration ! @vindex gnus-window-configuration ! This variable describes how much space each Gnus buffer should be given, ! compared to the other Gnus buffers. Here's an example: ! ! @lisp ! (setq gnus-window-configuration ! '((summary (0 1 0)) ! (groups (1 0 0)) ! (article (0 3 10)))) ! @end lisp ! ! This variable is a list of lists, where each of these small lists is on ! the form @var{(action (g s a))}. As you can see, there are three ! possible @var{action}s - @code{group} (which is what happens when ! you first start Gnus, or returns from the summary buffer), ! @code{summary} (which is what happens when there are no unread articles ! in the group, and @code{article} (which is what happens when there ! is an unread article in the group). ! ! We see that in the first two actions, the respective buffers will fill ! the screen, and in the last, the article buffer will take ten lines for ! each three the summary buffer gets. ! ! @findex gnus-window-configuration-split ! This variable can also have a function as its value. In that case, ! whenever Gnus tries to configure the Gnus buffers, that function will be ! called with the @var{action} as its parameter. There is one pre-made ! function supplied, @code{gnus-window-configuration-split}, which may be ! suitable if you have a very wide Emacs window, and want to have the ! summary buffer and the article buffer side by side. @end table @node Various Various --- 5782,5871 ---- @vindex gnus-use-full-window If non-@code{nil}, Gnus will delete all other windows and occupy the entire Emacs screen by itself. It is @code{t} by default. ! ! @item gnus-buffer-configuration ! @vindex gnus-buffer-configuration ! This variable describes how much space each Gnus buffer should be given. ! Here's an excerpt of this variable: ! ! @lisp ! ((group ([group 1.0 point] ! (if gnus-carpal [group-carpal 4]))) ! (article ([summary 0.25 point] ! [article 1.0]))) ! @end lisp ! ! This is an alist. The @dfn{key} is a symbol that names some action or ! other. For instance, when displaying the group buffer, the window ! configuration function will use @code{group} as the key. A full list of ! possible names is listed below. ! ! The @dfn{value} is a @dfn{rule} that says how much space each buffer ! should occupy. To take the @code{article} rule as an example - ! ! @lisp ! (article ([summary 0.25 point] ! [article 1.0])) ! @end lisp ! ! This rule says that the summary buffer should occupy 25% of the screen, ! and that it is placed over the article buffer. As you may have noticed, ! 100% + 25% is actually 125% (yup, I saw y'all reaching for that ! calculator there). However, the special number @code{1.0} is used to ! signal that this buffer should soak up all the rest of the space ! avaiable after the rest of the buffers have taken whatever they need. ! There should be only one buffer with the @code{1.0} size spec. ! ! Point will be put in the buffer that has the optional third element ! @code{point}. ! ! Here's a more complicated example: ! ! @lisp ! (article ([group 4] ! [summary 0.25 point] ! (if gnus-carpal [summary-carpal 4]) ! [article 1.0]) ! @end lisp ! ! If the size spec is an integer instead of a floating point number, ! then that number will be used to say how many lines a buffer should ! occupy, not a percentage. ! ! If an element is a list instead of a vector, this list will be ! @code{eval}ed. If the result is non-@code{nil}, it will be used. This ! means that there will be three buffers if @code{gnus-carpal} is ! @code{nil}, and four buffers if @code{gnus-carpal} is non-@code{nil}. ! ! Not complicated enough for you? Well, try this on for size: ! ! @lisp ! (article ([group 1.0] ! [gnus-carpal 4]) ! ((horizontal 0.5) ! [summary 0.25 point] ! [summary-carpal 4] ! [article 1.0])) ! @end lisp ! ! Whoops. Two buffers with the mystery 100% tag. And what's that ! @code{horizontal} thingie? ! ! If the first element in one of the rule lists is a list with ! @code{horizontal} as the first element, Gnus will split the window ! horizontally, giving you two windows side-by-side. Inside each of these ! strips you may carry on all you like in the normal fashion. The number ! following @code{horizontal} says what percentage of the screen is to be ! given to this strip. ! ! Here's a list of all possible keys: ! ! @code{group}, @code{summary}, @code{article}, @code{server}, ! @code{browse}, @code{group-mail}, @code{summary-mail}, ! @code{summary-reply}, @code{info}, @code{summary-faq}, ! @code{edit-group}, @code{edit-server}, @code{reply}, @code{reply-yank}, ! @code{followup}, @code{followup-yank}. ! @end table @node Various Various