*** pub/rgnus/lisp/article.el Fri Dec 13 04:48:26 1996 --- rgnus/lisp/article.el Sat Jan 4 08:54:06 1997 *************** *** 1,964 **** - ;;; article.el --- article treatment functions - ;; Copyright (C) 1996 Free Software Foundation, Inc. - - ;; Author: Lars Magne Ingebrigtsen - ;; Keywords: news - - ;; This file is part of GNU Emacs. - - ;; GNU Emacs is free software; you can redistribute it and/or modify - ;; it under the terms of the GNU General Public License as published by - ;; the Free Software Foundation; either version 2, or (at your option) - ;; any later version. - - ;; GNU Emacs is distributed in the hope that it will be useful, - ;; but WITHOUT ANY WARRANTY; without even the implied warranty of - ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;; GNU General Public License for more details. - - ;; You should have received a copy of the GNU General Public License - ;; along with GNU Emacs; see the file COPYING. If not, write to the - ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, - ;; Boston, MA 02111-1307, USA. - - ;;; Commentary: - - ;;; Code: - - (require 'custom) - (require 'nnheader) - (require 'gnus-util) - (require 'message) - (require 'gnus-sum) - - (defgroup article nil - "Article display." - :group 'gnus) - - (defcustom gnus-ignored-headers - '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" - "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" - "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") - "All headers that match this regexp will be hidden. - This variable can also be a list of regexps of headers to be ignored. - If `gnus-visible-headers' is non-nil, this variable will be ignored." - :type '(choice :custom-show nil - regexp - (repeat regexp)) - :group 'article) - - (defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-" - "All headers that do not match this regexp will be hidden. - This variable can also be a list of regexp of headers to remain visible. - If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp) - :group 'article) - - (defcustom gnus-sorted-header-list - '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" - "^Cc:" "^Date:" "^Organization:") - "This variable is a list of regular expressions. - If it is non-nil, headers that match the regular expressions will - be placed first in the article buffer in the sequence specified by - this list." - :type '(repeat regexp) - :group 'article) - - (defcustom gnus-boring-article-headers '(empty followup-to reply-to) - "Headers that are only to be displayed if they have interesting data. - Possible values in this list are `empty', `newsgroups', `followup-to', - `reply-to', and `date'." - :type '(set (const :tag "Headers with no content." empty) - (const :tag "Newsgroups with only one group." newsgroups) - (const :tag "Followup-to identical to newsgroups." followup-to) - (const :tag "Reply-to identical to from." reply-to) - (const :tag "Date less than four days old." date)) - :group 'article) - - (defcustom gnus-signature-separator '("^-- $" "^-- *$") - "Regexp matching signature separator. - This can also be a list of regexps. In that case, it will be checked - from head to tail looking for a separator. Searches will be done from - the end of the buffer." - :type '(repeat string) - :group 'article) - - (defcustom gnus-signature-limit nil - "Provide a limit to what is considered a signature. - If it is a number, no signature may not be longer (in characters) than - that number. If it is a floating point number, no signature may be - longer (in lines) than that number. If it is a function, the function - will be called without any parameters, and if it returns nil, there is - no signature in the buffer. If it is a string, it will be used as a - regexp. If it matches, the text in question is not a signature." - :type '(choice integer number function regexp) - :group 'article) - - (defcustom gnus-hidden-properties '(invisible t intangible t) - "Property list to use for hiding text." - :type 'sexp - :group 'article) - - (defcustom gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String or function to be executed to display an X-Face header. - If it is a string, the command will be executed in a sub-shell - asynchronously. The compressed face will be piped to this command." - :type 'string ;Leave function case to Lisp. - :group 'article) - - (defcustom gnus-article-x-face-too-ugly nil - "Regexp matching posters whose face shouldn't be shown automatically." - :type 'regexp - :group 'article) - - (defcustom gnus-emphasis-alist - (let ((format - "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)") - (types - '(("_" "_" underline) - ("/" "/" italic) - ("\\*" "\\*" bold) - ("_/" "/_" underline-italic) - ("_\\*" "\\*_" underline-bold) - ("\\*/" "/\\*" bold-italic) - ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) - types))) - "Alist that says how to fontify certain phrases. - Each item looks like this: - - (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) - - The first element is a regular expression to be matched. The second - is a number that says what regular expression grouping used to find - the entire emphasized word. The third is a number that says what - regexp grouping should be displayed and highlighted. The fourth - is the face used for highlighting." - :type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) - :group 'article) - - (defface gnus-emphasis-bold '((t (:bold t))) - "Face used for displaying strong emphasized text (*word*)." - :group 'article) - - (defface gnus-emphasis-italic '((t (:italic t))) - "Face used for displaying italic emphasized text (/word/)." - :group 'article) - - (defface gnus-emphasis-underline '((t (:underline t))) - "Face used for displaying underlined emphasized text (_word_)." - :group 'article) - - (defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) - "Face used for displaying underlined bold emphasized text (_*word*_)." - :group 'article) - - (defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) - "Face used for displaying underlined italic emphasized text (_*word*_)." - :group 'article) - - (defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) - "Face used for displaying bold italic emphasized text (/*word*/)." - :group 'article) - - (defface gnus-emphasis-underline-bold-italic - '((t (:bold t :italic t :underline t))) - "Face used for displaying underlined bold italic emphasized text (_/*word*/_)." - :group 'article) - - (eval-and-compile - (autoload 'hexl-hex-string-to-integer "hexl") - (autoload 'timezone-make-date-arpa-standard "timezone") - (autoload 'mail-extract-address-components "mail-extr")) - - ;;; Internal variables. - - (defvar gnus-inhibit-hiding nil) - (defvar gnus-newsgroup-name) - - (defsubst article-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) - (when (memq 'intangible props) - (put-text-property - (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - - (defsubst article-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - - (defun article-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (article-hide-text - b e (cons 'article-type (cons type gnus-hidden-properties)))) - - (defun article-unhide-text-type (b e type) - "Hide text of TYPE between B and E." - (remove-text-properties - b e (cons 'article-type (cons type gnus-hidden-properties))) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - - (defun article-hide-text-of-type (type) - "Hide text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min)) - (e (point-max))) - (while (setq b (text-property-any b e 'article-type type)) - (add-text-properties b (incf b) gnus-hidden-properties))))) - - (defun article-delete-text-of-type (type) - "Delete text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'article-type type)) - (delete-region b (incf b)))))) - - (defun article-delete-invisible-text () - "Delete all invisible text in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'invisible t)) - (delete-region b (incf b)))))) - - (defun article-text-type-exists-p (type) - "Say whether any text of type TYPE exists in the buffer." - (text-property-any (point-min) (point-max) 'article-type type)) - - (defsubst article-header-rank () - "Give the rank of the string HEADER as given by `article-sorted-header-list'." - (let ((list gnus-sorted-header-list) - (i 0)) - (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) - - (defun article-hide-headers (&optional arg delete) - "Toggle whether to hide unwanted headers and possibly sort them as well. - If given a negative prefix, always show; if given a positive prefix, - always hide." - (interactive (article-hidden-arg)) - (if (article-check-hidden-text 'headers arg) - ;; Show boring headers as well. - (article-show-hidden-text 'boring-headers) - ;; This function might be inhibited. - (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (props (nconc (list 'article-type 'headers) - gnus-hidden-properties)) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - want-list beg) - ;; First we narrow to just the headers. - (widen) - (goto-char (point-min)) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (if delete - (delete-region (point-min) (point)) - (article-hide-text (point-min) (point) props))) - ;; Then treat the rest of the header lines. - (narrow-to-region - (point) - (if (search-forward "\n\n" nil t) ; if there's a body - (progn (forward-line -1) (point)) - (point-max))) - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (goto-char (point-min)) - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - ;; Mark the rank of the header. - (put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We make the unwanted headers invisible. - (if delete - (delete-region beg (point-max)) - ;; Suggested by Sudish Joseph . - (article-hide-text-type beg (point-max) 'headers)) - ;; Work around XEmacs lossage. - (put-text-property (point-min) beg 'invisible nil)))))))) - - (defun article-hide-boring-headers (&optional arg) - "Toggle hiding of headers that aren't very interesting. - If given a negative prefix, always show; if given a positive prefix, - always hide." - (interactive (article-hidden-arg)) - (unless (article-check-hidden-text 'boring-headers arg) - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) - (nnheader-narrow-to-headers) - (while list - (setq elem (pop list)) - (goto-char (point-min)) - (cond - ;; Hide empty headers. - ((eq elem 'empty) - (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t) - (forward-line -1) - (article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers))) - ;; Hide boring Newsgroups header. - ((eq elem 'newsgroups) - (when (equal (gnus-fetch-field "newsgroups") - (gnus-group-real-name - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name - ""))) - (article-hide-header "newsgroups"))) - ((eq elem 'followup-to) - (when (equal (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) - (article-hide-header "followup-to"))) - ((eq elem 'reply-to) - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when (and - from reply-to - (equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to)))) - (article-hide-header "reply-to")))) - ((eq elem 'date) - (let ((date (message-fetch-field "date"))) - (when (and date - (< (gnus-days-between (current-time-string) date) - 4)) - (article-hide-header "date"))))))))))) - - (defun article-hide-header (header) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" header ":") nil t) - (article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers)))) - - ;; Written by Per Abrahamsen . - (defun article-treat-overstrike () - "Translate overstrikes into bold text." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (while (search-forward "\b" nil t) - (let ((next (following-char)) - (previous (char-after (- (point) 2)))) - ;; We do the boldification/underlining by hiding the - ;; overstrikes and putting the proper text property - ;; on the letters. - (cond - ((eq next previous) - (article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property (point) (1+ (point)) 'face 'bold)) - ((eq next ?_) - (article-hide-text-type (1- (point)) (1+ (point)) 'overstrike) - (put-text-property - (- (point) 2) (1- (point)) 'face 'underline)) - ((eq previous ?_) - (article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property - (point) (1+ (point)) 'face 'underline)))))))) - - (defun article-fill () - "Format too long lines." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (end-of-line 1) - (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") - (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") - (adaptive-fill-mode t)) - (while (not (eobp)) - (and (>= (current-column) (min fill-column (window-width))) - (/= (preceding-char) ?:) - (fill-paragraph nil)) - (end-of-line 2)))))) - - (defun article-remove-cr () - "Remove carriage returns from an article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t))))) - - (defun article-remove-trailing-blank-lines () - "Remove all trailing blank lines from the article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (delete-region - (point) - (progn - (while (and (not (bobp)) - (looking-at "^[ \t]*$")) - (forward-line -1)) - (forward-line 1) - (point)))))) - - (defun article-display-x-face (&optional force) - "Look for an X-Face header and display it if present." - (interactive (list 'force)) - (save-excursion - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (let ((inhibit-point-motion-hooks t) - (case-fold-search nil) - from) - (save-restriction - (nnheader-narrow-to-headers) - (setq from (message-fetch-field "from")) - (goto-char (point-min)) - (when (and gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) - ;; We now have the area of the buffer where the X-Face is stored. - (let ((beg (point)) - (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command beg end) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) - (process-send-eof "article-x-face"))))))))) - - (defun article-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (article-mime-decode-quoted-printable - (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (goto-char (point-max))) - (goto-char (point-min)))))) - - (defun article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. - This is in no way, shape or form meant as a replacement for real MIME - processing, but is simply a stop-gap measure until MIME support is - written. - If FORCE, decode the article whether it is marked as quoted-printable - or not." - (interactive (list 'force)) - (save-excursion - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (article-decode-rfc1522) - (when (or force - (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (article-mime-decode-quoted-printable (point) (point-max)))))) - - (defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (article-mime-decode-quoted-printable (point-min) (point-max))) - - (defun article-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) - - (defun article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. - If given a negative prefix, always show; if given a positive prefix, - always hide." - (interactive (article-hidden-arg)) - (unless (article-check-hidden-text 'pgp arg) - (save-excursion - (let (buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (article-hide-text-type - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)) - 'pgp)) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) - (widen)))))) - - (defun article-hide-pem (&optional arg) - "Toggle hiding of any PEM headers and signatures in the current article. - If given a negative prefix, always show; if given a positive prefix, - always hide." - (interactive (article-hidden-arg)) - (unless (article-check-hidden-text 'pem arg) - (save-excursion - (let (buffer-read-only end) - (widen) - (goto-char (point-min)) - ;; hide the horrendously ugly "header". - (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (setq end (1+ (match-beginning 0))) - (article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem)) - ;; hide the trailer as well - (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (article-hide-text-type - (match-beginning 0) (match-end 0) 'pem)))))) - - (defun article-hide-signature (&optional arg) - "Hide the signature in the current article. - If given a negative prefix, always show; if given a positive prefix, - always hide." - (interactive (article-hidden-arg)) - (unless (article-check-hidden-text 'signature arg) - (save-excursion - (save-restriction - (let ((buffer-read-only nil)) - (when (article-narrow-to-signature) - (article-hide-text-type (point-min) (point-max) 'signature))))))) - - (defun article-strip-leading-blank-lines () - "Remove all blank lines from the beginning of the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (while (and (not (eobp)) - (looking-at "[ \t]*$")) - (gnus-delete-line)))))) - - (defun article-strip-multiple-blank-lines () - "Replace consecutive blank lines with one empty line." - (interactive) - (save-excursion - (let (buffer-read-only) - ;; First make all blank lines empty. - (goto-char (point-min)) - (while (re-search-forward "^[ \t]+$" nil t) - (replace-match "" nil t)) - ;; Then replace multiple empty lines with a single empty line. - (goto-char (point-min)) - (while (re-search-forward "\n\n\n+" nil t) - (replace-match "\n\n" t t))))) - - (defun article-strip-blank-lines () - "Strip leading, trailing and multiple blank lines." - (interactive) - (article-strip-leading-blank-lines) - (article-remove-trailing-blank-lines) - (article-strip-multiple-blank-lines)) - - (defvar mime::preview/content-list) - (defvar mime::preview-content-info/point-min) - (defun article-narrow-to-signature () - "Narrow to the signature; return t if a signature is found, else nil." - (widen) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - - (when (article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t)))) - - (defun article-search-signature () - "Search the current buffer for the signature separator. - Put point at the beginning of the signature separator." - (let ((cur (point))) - (goto-char (point-max)) - (if (if (stringp gnus-signature-separator) - (re-search-backward gnus-signature-separator nil t) - (let ((seps gnus-signature-separator)) - (while (and seps - (not (re-search-backward (car seps) nil t))) - (pop seps)) - seps)) - t - (goto-char cur) - nil))) - - (defun article-hidden-arg () - "Return the current prefix arg as a number, or 0 if no prefix." - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 0))) - - (defun article-check-hidden-text (type arg) - "Return nil if hiding is necessary. - Arg can be nil or a number. Nil and positive means hide, negative - means show, 0 means toggle." - (save-excursion - (let ((hide (article-hidden-text-p type))) - (cond - ((or (null arg) - (> arg 0)) - nil) - ((< arg 0) - (article-show-hidden-text type)) - (t - (if (eq hide 'hidden) - (article-show-hidden-text type) - nil)))))) - - (defun article-hidden-text-p (type) - "Say whether the current buffer contains hidden text of type TYPE." - (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) - (when pos - (if (get-text-property pos 'invisible) - 'hidden - 'shown)))) - - (defun article-show-hidden-text (type &optional hide) - "Show all hidden text of type TYPE. - If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (beg (point-min))) - (while (gnus-goto-char (text-property-any - beg (point-max) 'article-type type)) - (setq beg (point)) - (forward-char) - (if hide - (article-hide-text beg (point) gnus-hidden-properties) - (article-unhide-text beg (point))) - (setq beg (point))) - t))) - - (defconst article-time-units - `((year . ,(* 365.25 24 60 60)) - (week . ,(* 7 24 60 60)) - (day . ,(* 24 60 60)) - (hour . ,(* 60 60)) - (minute . 60) - (second . 1)) - "Mapping from time units to seconds.") - - (defun article-date-ut (&optional type highlight header) - "Convert DATE date to universal time in the current article. - If TYPE is `local', convert to local time; if it is `lapsed', output - how much time has lapsed since DATE." - (interactive (list 'ut t)) - (let* ((header (or header - (mail-header-date gnus-current-headers) - (message-fetch-field "date") - "")) - (date (if (vectorp header) (mail-header-date header) - header)) - (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") - (inhibit-point-motion-hooks t) - bface eface) - (when (and date (not (string= date ""))) - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (let ((buffer-read-only nil)) - ;; Delete any old Date headers. - (if (re-search-forward date-regexp nil t) - (progn - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) - 'face)) - (message-remove-header date-regexp t) - (beginning-of-line)) - (goto-char (point-max))) - (insert (article-make-date-line date type)) - ;; Do highlighting. - (forward-line -1) - (when (looking-at "\\([^:]+\\): *\\(.*\\)$") - (put-text-property (match-beginning 1) (match-end 1) - 'face bface) - (put-text-property (match-beginning 2) (match-end 2) - 'face eface)))))))) - - (defun article-make-date-line (date type) - "Return a DATE line of TYPE." - (cond - ;; Convert to the local timezone. We have to slap a - ;; `condition-case' round the calls to the timezone - ;; functions since they aren't particularly resistant to - ;; buggy dates. - ((eq type 'local) - (concat "Date: " (condition-case () - (timezone-make-date-arpa-standard date) - (error date)) - "\n")) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (condition-case () - (timezone-make-date-arpa-standard date nil "UT") - (error date)) - "\n")) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " date "\n")) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time - (ignore-errors - (gnus-time-minus - (gnus-encode-date - (timezone-make-date-arpa-standard - (current-time-string now) - (current-time-zone now) "UT")) - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))))) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) - (cond - ((null real-time) - "X-Sent: Unknown\n") - ((zerop sec) - "X-Sent: Now\n") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago\n" - " in the future\n")))))) - (t - (error "Unknown conversion type: %s" type)))) - - (defun article-date-local (&optional highlight) - "Convert the current article date to the local timezone." - (interactive (list t)) - (article-date-ut 'local highlight)) - - (defun article-date-original (&optional highlight) - "Convert the current article date to what it was originally. - This is only useful if you have used some other date conversion - function and want to see what the date was before converting." - (interactive (list t)) - (article-date-ut 'original highlight)) - - (defun article-date-lapsed (&optional highlight) - "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) - (article-date-ut 'lapsed highlight)) - - (defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (article-unhide-text (point-min) (point-max))))) - - (defun article-emphasize (&optional arg) - "Emphasize text according to `gnus-emphasis-alist'." - (interactive (article-hidden-arg)) - (unless (article-check-hidden-text 'emphasis arg) - (save-excursion - (let ((alist gnus-emphasis-alist) - (buffer-read-only nil) - (props (append '(article-type emphasis) - gnus-hidden-properties)) - regexp elem beg invisible visible face) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq beg (point)) - (while (setq elem (pop alist)) - (goto-char beg) - (setq regexp (car elem) - invisible (nth 1 elem) - visible (nth 2 elem) - face (nth 3 elem)) - (while (re-search-forward regexp nil t) - (when (and (match-beginning visible) (match-beginning invisible)) - (article-hide-text - (match-beginning invisible) (match-end invisible) props) - (article-unhide-text-type - (match-beginning visible) (match-end visible) 'emphasis) - (gnus-put-text-property-excluding-newlines - (match-beginning visible) (match-end visible) 'face face) - (goto-char (match-end invisible))))))))) - - (provide 'article) - - ;;; article.el ends here --- 0 ---- *** pub/rgnus/lisp/custom-edit.el Mon Dec 9 02:38:21 1996 --- rgnus/lisp/custom-edit.el Fri Jan 3 19:13:30 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.12 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.15 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 17,25 **** (require 'widget-edit) (require 'easymenu) ! (define-widget-keywords :custom-menu :custom-show :custom-magic ! :custom-state :custom-level :custom-form ! :custom-apply :custom-set-default :custom-reset) ;;; Utilities. --- 17,25 ---- (require 'widget-edit) (require 'easymenu) ! (define-widget-keywords :custom-prefixes :custom-menu :custom-show ! :custom-magic :custom-state :custom-level :custom-form ! :custom-set :custom-save :custom-reset) ;;; Utilities. *************** *** 88,93 **** --- 88,109 ---- (insert "...")) (buffer-string))))) + (defcustom custom-unlispify-tag-names t + "Display tag names as words instead of symbols if non nil." + :group 'customize + :type 'boolean) + + (defun custom-unlispify-tag-name (symbol) + "Convert symbol into a menu entry." + (let ((custom-unlispify-menu-entries custom-unlispify-tag-names)) + (custom-unlispify-menu-entry symbol t))) + + (defun custom-prefix-add (symbol prefixes) + ;; Addd SYMBOL to list of ignored PREFIXES. + (cons (or (get symbol 'custom-prefix) + (concat (symbol-name symbol) "-")) + prefixes)) + ;;; The Custom Mode. (defvar custom-options nil *************** *** 104,113 **** custom-mode-map "Menu used in customization buffers." '("Custom" ! ["Apply" custom-apply t] ! ["Set Default" custom-set-default t] ["Reset" custom-reset t] ! ["Save" custom-save t])) (defcustom custom-mode-hook nil "Hook called when entering custom-mode." --- 120,129 ---- custom-mode-map "Menu used in customization buffers." '("Custom" ! ["Set" custom-set t] ! ["Save" custom-save t] ["Reset" custom-reset t] ! ["Info" (Info-goto-node "(custom)The Customization Buffer") t])) (defcustom custom-mode-hook nil "Hook called when entering custom-mode." *************** *** 123,132 **** \\[widget-backward] Move to previous button or editable field. \\[widget-button-click] Activate button under the mouse pointer. \\[widget-button-press] Activate button under point. ! \\[custom-apply] Apply all modifications. ! \\[custom-set-default] Make all modifications default. \\[custom-reset] Undo all modifications. - \\[custom-save] Save defaults for future emacs sessions. Entry to this mode calls the value of `custom-mode-hook' if that value is non-nil." --- 139,147 ---- \\[widget-backward] Move to previous button or editable field. \\[widget-button-click] Activate button under the mouse pointer. \\[widget-button-press] Activate button under point. ! \\[custom-set] Set all modifications. ! \\[custom-save] Make all modifications default. \\[custom-reset] Undo all modifications. Entry to this mode calls the value of `custom-mode-hook' if that value is non-nil." *************** *** 139,161 **** ;;; Custom Mode Commands. ! (defun custom-apply () ! "Apply changes in all modified options." (interactive) (let ((children custom-options)) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-apply))) children))) ! (defun custom-set-default () ! "Set default in all modified group members." (interactive) (let ((children custom-options)) (mapcar (lambda (child) ! (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-set-default))) ! children))) (defun custom-reset () "Reset all modified group members." --- 154,177 ---- ;;; Custom Mode Commands. ! (defun custom-set () ! "Set changes in all modified options." (interactive) (let ((children custom-options)) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-set))) children))) ! (defun custom-save () ! "Set all modified group members and save them." (interactive) (let ((children custom-options)) (mapcar (lambda (child) ! (when (memq (widget-get child :custom-state) '(modified set)) ! (widget-apply child :custom-save))) ! children)) ! (custom-save-all)) (defun custom-reset () "Reset all modified group members." *************** *** 274,283 **** --- 290,303 ---- (prog1 (if (> (length options) 1) (widget-create (nth 1 entry) + :tag (custom-unlispify-tag-name + (nth 0 entry)) :value (nth 0 entry)) ;; If there is only one entry, don't hide it! (widget-create (nth 1 entry) :custom-state 'unknown + :tag (custom-unlispify-tag-name + (nth 0 entry)) :value (nth 0 entry))) (unless (eq (preceding-char) ?\n) (widget-insert "\n")) *************** *** 285,312 **** options)) (mapcar 'custom-magic-reset custom-options) (widget-create 'push-button ! :tag "Apply" ! :help-echo "Push me to apply all modifications." :action (lambda (widget &optional event) ! (custom-apply))) (widget-insert " ") (widget-create 'push-button ! :tag "Set Default" :help-echo "Push me to make the modifications default." :action (lambda (widget &optional event) ! (custom-set-default))) (widget-insert " ") (widget-create 'push-button :tag "Reset" :help-echo "Push me to undo all modifications.." :action (lambda (widget &optional event) (custom-reset))) - (widget-insert " ") - (widget-create 'push-button - :tag "Save" - :help-echo "Push me to store the new defaults permanently." - :action (lambda (widget &optional event) - (custom-save))) (widget-insert "\n") (widget-setup)) --- 305,326 ---- options)) (mapcar 'custom-magic-reset custom-options) (widget-create 'push-button ! :tag "Set" ! :help-echo "Push me to set all modifications." :action (lambda (widget &optional event) ! (custom-set))) (widget-insert " ") (widget-create 'push-button ! :tag "Save" :help-echo "Push me to make the modifications default." :action (lambda (widget &optional event) ! (custom-save))) (widget-insert " ") (widget-create 'push-button :tag "Reset" :help-echo "Push me to undo all modifications.." :action (lambda (widget &optional event) (custom-reset))) (widget-insert "\n") (widget-setup)) *************** *** 337,348 **** ;;; The `custom-magic' Widget. - (define-widget 'custom-magic 'item - "Status feedback for customization option." - :format "%[%v%]" - :action 'widget-choice-item-action - :value-create 'custom-magic-value-create) - (defface custom-invalid-face '((((class color)) (:foreground "yellow" :background "red")) (t --- 351,356 ---- *************** *** 361,386 **** (:italic t :bold))) "Face used when the customize item has been modified.") ! (defface custom-applied-face '((((class color)) (:foreground "blue" :background "white")) (t (:italic t))) ! "Face used when the customize item has been applied.") (defface custom-saved-face '((t (:underline t))) "Face used when the customize item has been saved.") ! (defcustom custom-magic-alist '((nil "#" underline) ! (unknown "?" italic) ! (hidden "-" default) ! (invalid "x" custom-invalid-face) ! (modified "*" custom-modified-face) ! (applied "+" custom-applied-face) ! (saved "!" custom-saved-face) ! (rogue "@" custom-rogue-face) ! (factory " " nil)) ! "Alist of magic representing a customize items status. ! Each entry is of the form (STATE MAGIC FACE), where STATE is one of the following symbols: --- 369,411 ---- (:italic t :bold))) "Face used when the customize item has been modified.") ! (defface custom-set-face '((((class color)) (:foreground "blue" :background "white")) (t (:italic t))) ! "Face used when the customize item has been set.") ! ! (defface custom-changed-face '((((class color)) ! (:foreground "white" :background "blue")) ! (t ! (:italic t))) ! "Face used when the customize item has been changed.") (defface custom-saved-face '((t (:underline t))) "Face used when the customize item has been saved.") ! (defcustom custom-magic-alist '((nil "#" underline "\ ! uninitialized, you should not see this.") ! (unknown "?" italic "\ ! unknown, you should not see this.") ! (hidden "-" default "\ ! hidden, press the stars `*' on the line above to show.") ! (invalid "x" custom-invalid-face "\ ! the value displayed for this item is invalid and cannot be set.") ! (modified "*" custom-modified-face "\ ! you have edited the item, and can now set it.") ! (set "+" custom-set-face "\ ! you have set this item, but not saved it.") ! (changed ":" custom-changed-face "\ ! this item has been changed outside customize.") ! (saved "!" custom-saved-face "\ ! this item has been saved.") ! (rogue "@" custom-rogue-face "\ ! this item is not prepared for customization.") ! (factory " " nil "\ ! this item is unchanged from its factory setting.")) ! "Alist of customize option states. ! Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where STATE is one of the following symbols: *************** *** 394,401 **** This item is modified, but has an invalid form. `modified' This item is modified, and has a valid form. ! `applied' ! This items current value has been changed temporarily. `saved' This item is marked for saving. `rogue' --- 419,428 ---- This item is modified, but has an invalid form. `modified' This item is modified, and has a valid form. ! `set' ! This item has been set but not saved. ! `changed' ! The current value of this item has been changed temporarily. `saved' This item is marked for saving. `rogue' *************** *** 407,436 **** FACE is a face used to present the state. The list should be sorted most significant first." ! :type '(repeat (list (choice (const nil) ! (const unknown) ! (const hidden) ! (const invalid) ! (const modified) ! (const applied) ! (const saved) ! (const rogue) ! (const factory)) ! string face)) :group 'customize) (defun custom-magic-value-create (widget) ;; Create compact status report for WIDGET. (let* ((parent (widget-get widget :parent)) (state (widget-get parent :custom-state)) (entry (assq state custom-magic-alist)) (magic (nth 1 entry)) ! (face (nth 2 entry))) ! (if (eq (widget-get parent :custom-form) 'lisp) ! (widget-insert "(" magic ")") ! (widget-insert "[" magic "]")) ! (widget-put widget :button-face face))) (defun custom-magic-reset (widget) "Redraw the :custom-magic property of WIDGET." --- 434,546 ---- FACE is a face used to present the state. + DESCRIPTION is a string describing the state. + The list should be sorted most significant first." ! :type '(list (checklist :inline t ! (group (const nil) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const unknown) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const hidden) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const invalid) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const modified) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const set) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const changed) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const saved) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const rogue) ! (string :tag "Magic") ! face ! (string :tag "Description")) ! (group (const factory) ! (string :tag "Magic") ! face ! (string :tag "Description"))) ! (editable-list :inline t ! (group symbol ! (string :tag "Magic") ! face ! (string :tag "Description")))) ! :group 'customize) ! ! (defcustom custom-magic-show 'long ! "Show long description of the state of each customization option." ! :type '(choice (const :tag "no" nil) ! (const short) ! (const long)) :group 'customize) + (defcustom custom-magic-show-button t + "Show a magic button indicating the state of each customization option." + :type 'boolean + :group 'customize) + + (define-widget 'custom-magic 'default + "Show and manipulate state for a customization option." + :format "%v" + :action 'widget-choice-item-action + :value-get 'ignore + :value-create 'custom-magic-value-create + :value-delete 'widget-children-value-delete) + (defun custom-magic-value-create (widget) ;; Create compact status report for WIDGET. (let* ((parent (widget-get widget :parent)) (state (widget-get parent :custom-state)) (entry (assq state custom-magic-alist)) (magic (nth 1 entry)) ! (face (nth 2 entry)) ! (text (nth 3 entry)) ! (lisp (eq (widget-get parent :custom-form) 'lisp)) ! children) ! (when custom-magic-show ! (push (widget-create-child-and-convert widget 'choice-item ! :format "%[%t%]" ! :tag "State") ! children) ! (insert ": ") ! (if (eq custom-magic-show 'long) ! (insert text) ! (insert (symbol-name state))) ! (when lisp ! (insert " (lisp)")) ! (insert "\n")) ! (when custom-magic-show-button ! (when custom-magic-show ! (let ((indent (widget-get parent :indent))) ! (when indent ! (insert-char ? indent)))) ! (push (widget-create-child-and-convert widget 'choice-item ! :button-face face ! :format "%[%t%]" ! :tag (if lisp ! (concat "(" magic ")") ! (concat "[" magic "]"))) ! children) ! (insert " ")) ! (widget-put widget :children children))) (defun custom-magic-reset (widget) "Redraw the :custom-magic property of WIDGET." *************** *** 450,456 **** (let* ((parent (widget-get widget :parent)) (state (widget-get parent :custom-state))) (cond ((memq state '(invalid modified)) ! (error "There are unapplied changes")) ((eq state 'hidden) (widget-put parent :custom-state 'unknown)) (t --- 560,566 ---- (let* ((parent (widget-get widget :parent)) (state (widget-get parent :custom-state))) (cond ((memq state '(invalid modified)) ! (error "There are unset changes")) ((eq state 'hidden) (widget-put parent :custom-state 'unknown)) (t *************** *** 459,478 **** ;;; The `custom' Widget. - (defvar custom-save-needed-p nil - "Non-nil if any customizations need to be saved.") - - (add-hook 'kill-emacs-hook 'custom-save-maybe) - - (defun custom-save-maybe () - (and custom-save-needed-p - (y-or-n-p "You have unsaved customizations, save them now? ") - (custom-save))) - (define-widget 'custom 'default "Customize a user option." ! :convert-widget 'widget-item-convert-widget ! :format "%l%[%t%]: %v%m %h%a" :format-handler 'custom-format-handler :notify 'custom-notify :custom-level 1 --- 569,578 ---- ;;; The `custom' Widget. (define-widget 'custom 'default "Customize a user option." ! :convert-widget 'custom-convert-widget ! :format "%l%[%t%]: %v%m%h%a" :format-handler 'custom-format-handler :notify 'custom-notify :custom-level 1 *************** *** 484,489 **** --- 584,599 ---- :validate 'widget-editable-list-validate :match (lambda (widget value) (symbolp value))) + (defun custom-convert-widget (widget) + ;; Initialize :value and :tag from :args in WIDGET. + (let ((args (widget-get widget :args))) + (when args + (widget-put widget :value (widget-apply widget + :value-to-internal (car args))) + (widget-put widget :tag (custom-unlispify-tag-name (car args))) + (widget-put widget :args nil))) + widget) + (defun custom-format-handler (widget escape) ;; We recognize extra escape sequences. (let* ((buttons (widget-get widget :buttons)) *************** *** 497,509 **** (widget-insert " ") (widget-put widget :buttons buttons))) ((eq escape ?L) ! (push (widget-create-child-and-convert ! widget 'custom-level ! :format "%[%t%]" ! (if (eq state 'hidden) "show" "hide")) ! buttons) ! (widget-insert " ") ! (widget-put widget :buttons buttons)) ((eq escape ?m) (and (eq (preceding-char) ?\n) (widget-get widget :indent) --- 607,614 ---- (widget-insert " ") (widget-put widget :buttons buttons))) ((eq escape ?L) ! (when (eq state 'hidden) ! (widget-insert " ..."))) ((eq escape ?m) (and (eq (preceding-char) ?\n) (widget-get widget :indent) *************** *** 592,598 **** (define-widget 'custom-variable 'custom "Customize variable." ! :format "%l%v%m %h%a" :help-echo "Push me to set or reset this variable." :documentation-property 'variable-documentation :custom-state nil --- 697,703 ---- (define-widget 'custom-variable 'custom "Customize variable." ! :format "%l%v%m%h%a" :help-echo "Push me to set or reset this variable." :documentation-property 'variable-documentation :custom-state nil *************** *** 600,607 **** :custom-form 'edit :value-create 'custom-variable-value-create :action 'custom-variable-action ! :custom-apply 'custom-variable-apply ! :custom-set-default 'custom-variable-set-default :custom-reset 'custom-redraw) (defun custom-variable-value-create (widget) --- 705,712 ---- :custom-form 'edit :value-create 'custom-variable-value-create :action 'custom-variable-action ! :custom-set 'custom-variable-set ! :custom-save 'custom-variable-save :custom-reset 'custom-redraw) (defun custom-variable-value-create (widget) *************** *** 614,619 **** --- 719,725 ---- (symbol (widget-get widget :value)) (options (get symbol 'custom-options)) (child-type (or (get symbol 'custom-type) 'sexp)) + (tag (widget-get widget :tag)) (type (let ((tmp (if (listp child-type) (copy-list child-type) (list child-type)))) *************** *** 638,648 **** ;; Now we can create the child widget. (cond ((eq state 'hidden) ;; Make hidden value easy to show. ! (push (widget-create-child-and-convert ! widget 'custom-level ! :tag (symbol-name symbol) ! :format "%t: %[show%]") ! buttons)) ((eq form 'lisp) ;; In lisp mode edit the saved value when possible. (let* ((value (cond ((get symbol 'saved-value) --- 744,750 ---- ;; Now we can create the child widget. (cond ((eq state 'hidden) ;; Make hidden value easy to show. ! (insert tag ": ...")) ((eq form 'lisp) ;; In lisp mode edit the saved value when possible. (let* ((value (cond ((get symbol 'saved-value) *************** *** 660,669 **** children))) (t ;; Edit mode. ! ! (push (widget-create-child-and-convert widget type ! :tag (symbol-name symbol) ! :value value) children))) ;; Now update the state. (unless (eq (preceding-char) ?\n) --- 762,771 ---- children))) (t ;; Edit mode. ! (push (widget-create-child-and-convert ! widget type ! :tag tag ! :value value) children))) ;; Now update the state. (unless (eq (preceding-char) ?\n) *************** *** 681,708 **** (value (if (default-boundp symbol) (default-value symbol) (widget-get widget :value))) ! (state (if (get symbol 'saved-value) ! (if (condition-case nil ! (equal value ! (eval (car (get symbol 'saved-value)))) ! (error nil)) ! 'saved ! 'applied) ! (if (get symbol 'factory-value) ! (if (condition-case nil ! (equal value ! (eval (car (get symbol 'factory-value)))) ! (error nil)) ! 'factory ! 'applied) ! 'rogue)))) (widget-put widget :custom-state state))) (defvar custom-variable-menu '(("Edit" . custom-variable-edit) ! ("Edit Default" . custom-variable-edit-lisp) ! ("Apply" . custom-variable-apply) ! ("Set Default" . custom-variable-set-default) ("Reset" . custom-redraw) ("Reset to Default" . custom-variable-default) ("Reset to Factory Settings" . custom-variable-factory)) --- 783,815 ---- (value (if (default-boundp symbol) (default-value symbol) (widget-get widget :value))) ! tmp ! (state (cond ((setq tmp (get symbol 'customized-value)) ! (if (condition-case nil ! (equal value (eval (car tmp))) ! (error nil)) ! 'saved ! 'set)) ! ((setq tmp (get symbol 'saved-value)) ! (if (condition-case nil ! (equal value (eval (car tmp))) ! (error nil)) ! 'saved ! 'set)) ! ((setq tmp (get symbol 'factory-value)) ! (if (condition-case nil ! (equal value (eval (car tmp))) ! (error nil)) ! 'factory ! 'set)) ! (t 'rogue)))) (widget-put widget :custom-state state))) (defvar custom-variable-menu '(("Edit" . custom-variable-edit) ! ("Edit Lisp" . custom-variable-edit-lisp) ! ("Set" . custom-variable-set) ! ("Save" . custom-variable-save) ("Reset" . custom-redraw) ("Reset to Default" . custom-variable-default) ("Reset to Factory Settings" . custom-variable-factory)) *************** *** 733,739 **** (widget-put widget :custom-form 'lisp) (custom-redraw widget)) ! (defun custom-variable-apply (widget) "Set the current value for the variable being edited by WIDGET." (let ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) --- 840,846 ---- (widget-put widget :custom-form 'lisp) (custom-redraw widget)) ! (defun custom-variable-set (widget) "Set the current value for the variable being edited by WIDGET." (let ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) *************** *** 741,757 **** (symbol (widget-value widget)) val) (cond ((eq state 'hidden) ! (error "Cannot apply hidden variable.")) ((setq val (widget-apply child :validate)) (error "Invalid %S" val)) ((eq form 'lisp) ! (set symbol (eval (widget-value child)))) (t ! (set symbol (widget-value child)))) (custom-variable-state-set widget) (custom-redraw-magic widget))) ! (defun custom-variable-set-default (widget) "Set the default value for the variable being edited by WIDGET." (let ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) --- 848,866 ---- (symbol (widget-value widget)) val) (cond ((eq state 'hidden) ! (error "Cannot set hidden variable.")) ((setq val (widget-apply child :validate)) (error "Invalid %S" val)) ((eq form 'lisp) ! (set symbol (eval (setq val (widget-value child)))) ! (put symbol 'customized-value (list val))) (t ! (set symbol (widget-value child)) ! (put symbol 'customized-value (list (custom-quote val))))) (custom-variable-state-set widget) (custom-redraw-magic widget))) ! (defun custom-variable-save (widget) "Set the default value for the variable being edited by WIDGET." (let ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) *************** *** 759,777 **** (symbol (widget-value widget)) val) (cond ((eq state 'hidden) ! (error "Cannot apply hidden variable.")) ((setq val (widget-apply child :validate)) (error "Invalid %S" val)) ((eq form 'lisp) - (setq custom-save-needed-p (cons symbol custom-save-needed-p)) (put symbol 'saved-value (list (widget-value child))) (set symbol (eval (widget-value child)))) (t - (setq custom-save-needed-p (cons symbol custom-save-needed-p)) (put symbol 'saved-value (list (custom-quote (widget-value child)))) (set symbol (widget-value child)))) (custom-variable-state-set widget) (custom-redraw-magic widget))) --- 868,886 ---- (symbol (widget-value widget)) val) (cond ((eq state 'hidden) ! (error "Cannot set hidden variable.")) ((setq val (widget-apply child :validate)) (error "Invalid %S" val)) ((eq form 'lisp) (put symbol 'saved-value (list (widget-value child))) (set symbol (eval (widget-value child)))) (t (put symbol 'saved-value (list (custom-quote (widget-value child)))) (set symbol (widget-value child)))) + (put symbol 'customized-value nil) + (custom-save-all) (custom-variable-state-set widget) (custom-redraw-magic widget))) *************** *** 783,788 **** --- 892,898 ---- (set symbol (eval (car (get symbol 'saved-value)))) (error nil)) (error "No default value for %s" symbol)) + (put symbol 'customized-value nil) (widget-put widget :custom-state 'unknown) (custom-redraw widget))) *************** *** 792,800 **** (if (get symbol 'factory-value) (set symbol (eval (car (get symbol 'factory-value)))) (error "No factory default for %S" symbol)) (when (get symbol 'saved-value) ! (setq custom-save-needed-p (cons symbol custom-save-needed-p)) ! (put symbol 'saved-value nil)) (widget-put widget :custom-state 'unknown) (custom-redraw widget))) --- 902,911 ---- (if (get symbol 'factory-value) (set symbol (eval (car (get symbol 'factory-value)))) (error "No factory default for %S" symbol)) + (put symbol 'customized-value nil) (when (get symbol 'saved-value) ! (put symbol 'saved-value nil) ! (custom-save-all)) (widget-put widget :custom-state 'unknown) (custom-redraw widget))) *************** *** 834,839 **** --- 945,956 ---- :offset 0 (const :format "X " x) + (const :format "PM " + pm) + (const :format "Win32 " + win32) + (const :format "DOS " + pc) (const :format "TTY%n" tty))) (group (const :format "Class: " class) *************** *** 858,871 **** (define-widget 'custom-face 'custom "Customize face." ! :format "%l%[%t%]: %s%m %h%a%v" :format-handler 'custom-face-format-handler :help-echo "Push me to set or reset this face." :documentation-property 'face-documentation :value-create 'custom-face-value-create :action 'custom-face-action ! :custom-apply 'custom-face-apply ! :custom-set-default 'custom-face-set-default :custom-reset 'custom-redraw :custom-menu 'custom-face-menu-create) --- 975,988 ---- (define-widget 'custom-face 'custom "Customize face." ! :format "%l%[%t%]: %s%m%h%a%v" :format-handler 'custom-face-format-handler :help-echo "Push me to set or reset this face." :documentation-property 'face-documentation :value-create 'custom-face-value-create :action 'custom-face-action ! :custom-set 'custom-face-set ! :custom-save 'custom-face-save :custom-reset 'custom-redraw :custom-menu 'custom-face-menu-create) *************** *** 883,889 **** widget 'custom-level :format "(%[%t%])\n" :button-face symbol ! (if (eq state 'hidden) "show" "hide")))) (t (custom-format-handler widget escape))) (when child --- 1000,1006 ---- widget 'custom-level :format "(%[%t%])\n" :button-face symbol ! (if (eq state 'hidden) "*** show ***" "hide")))) (t (custom-format-handler widget escape))) (when child *************** *** 908,915 **** (widget-put widget :children (list edit))))) (defvar custom-face-menu ! '(("Apply" . custom-face-apply) ! ("Set Default" . custom-face-set-default) ("Reset to Default" . custom-face-default) ("Reset to Factory Setting" . custom-face-factory)) "Alist of actions for the `custom-face' widget. --- 1025,1032 ---- (widget-put widget :children (list edit))))) (defvar custom-face-menu ! '(("Set" . custom-face-set) ! ("Save" . custom-face-save) ("Reset to Default" . custom-face-default) ("Reset to Factory Setting" . custom-face-factory)) "Alist of actions for the `custom-face' widget. *************** *** 920,926 **** (defun custom-face-state-set (widget) "Set the state of WIDGET." (let ((symbol (widget-value widget))) ! (widget-put widget :custom-state (cond ((get symbol 'saved-face) 'saved) ((get symbol 'factory-face) 'factory) --- 1037,1045 ---- (defun custom-face-state-set (widget) "Set the state of WIDGET." (let ((symbol (widget-value widget))) ! (widget-put widget :custom-state (cond ((get symbol 'customized-face) ! 'set) ! ((get symbol 'saved-face) 'saved) ((get symbol 'factory-face) 'factory) *************** *** 938,959 **** (if answer (funcall answer widget)))) ! (defun custom-face-apply (widget) "Make the face attributes in WIDGET take effect." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (widget-value child))) (custom-face-display-set symbol value) (custom-face-state-set widget) (custom-redraw-magic widget))) ! (defun custom-face-set-default (widget) "Make the face attributes in WIDGET default." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (widget-value child))) (custom-face-display-set symbol value) (put symbol 'saved-face value) (custom-face-state-set widget) (custom-redraw-magic widget))) --- 1057,1080 ---- (if answer (funcall answer widget)))) ! (defun custom-face-set (widget) "Make the face attributes in WIDGET take effect." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (widget-value child))) + (put symbol 'customized-face value) (custom-face-display-set symbol value) (custom-face-state-set widget) (custom-redraw-magic widget))) ! (defun custom-face-save (widget) "Make the face attributes in WIDGET default." (let* ((symbol (widget-value widget)) (child (car (widget-get widget :children))) (value (widget-value child))) (custom-face-display-set symbol value) (put symbol 'saved-face value) + (put symbol 'customized-face nil) (custom-face-state-set widget) (custom-redraw-magic widget))) *************** *** 963,973 **** (child (car (widget-get widget :children))) (value (get symbol 'saved-face))) (unless value ! (error "No saved value for this face") ! (custom-face-display-set symbol value) (widget-value-set child value) (custom-face-state-set widget) ! (custom-redraw-magic widget)))) (defun custom-face-factory (widget) "Restore WIDGET to the face's factory settings." --- 1084,1095 ---- (child (car (widget-get widget :children))) (value (get symbol 'saved-face))) (unless value ! (error "No saved value for this face")) ! (put symbol 'customized-face nil) ! (custom-face-display-set symbol value) (widget-value-set child value) (custom-face-state-set widget) ! (custom-redraw-magic widget))) (defun custom-face-factory (widget) "Restore WIDGET to the face's factory settings." *************** *** 976,983 **** (value (get symbol 'factory-face))) (unless value (error "No factory default for this face")) (when (get symbol 'saved-face) ! (put symbol 'saved-face nil)) (custom-face-display-set symbol value) (widget-value-set child value) (custom-face-state-set widget) --- 1098,1107 ---- (value (get symbol 'factory-face))) (unless value (error "No factory default for this face")) + (put symbol 'customized-face nil) (when (get symbol 'saved-face) ! (put symbol 'saved-face nil) ! (custom-save-all)) (custom-face-display-set symbol value) (widget-value-set child value) (custom-face-state-set widget) *************** *** 1003,1009 **** (let* ((symbol (widget-value widget)) (child (widget-create-child-and-convert widget 'custom-face ! :format "%t %s%m %h%v" :custom-level nil :value symbol))) (custom-magic-reset child) --- 1127,1133 ---- (let* ((symbol (widget-value widget)) (child (widget-create-child-and-convert widget 'custom-face ! :format "%t %s%m%h%v" :custom-level nil :value symbol))) (custom-magic-reset child) *************** *** 1059,1071 **** (define-widget 'custom-group 'custom "Customize group." ! :format "%l%[%t%]: %L\n%m %h%a%v" :documentation-property 'group-documentation :help-echo "Push me to set or reset all members of this group." :value-create 'custom-group-value-create :action 'custom-group-action ! :custom-apply 'custom-group-apply ! :custom-set-default 'custom-group-set-default :custom-reset 'custom-group-reset :custom-menu 'custom-group-menu-create) --- 1183,1195 ---- (define-widget 'custom-group 'custom "Customize group." ! :format "%l%[%t%]:%L\n%m%h%a%v" :documentation-property 'group-documentation :help-echo "Push me to set or reset all members of this group." :value-create 'custom-group-value-create :action 'custom-group-action ! :custom-set 'custom-group-set ! :custom-save 'custom-group-save :custom-reset 'custom-group-reset :custom-menu 'custom-group-menu-create) *************** *** 1076,1087 **** --- 1200,1216 ---- (let* ((level (widget-get widget :custom-level)) (symbol (widget-value widget)) (members (get symbol 'custom-group)) + (prefixes (widget-get widget :custom-prefixes)) + (custom-prefix-list (custom-prefix-add symbol prefixes)) (children (mapcar (lambda (entry) (widget-insert "\n") (prog1 (widget-create-child-and-convert widget (nth 1 entry) :group widget + :tag (custom-unlispify-tag-name + (nth 0 entry)) + :custom-prefixes custom-prefix-list :custom-level (1+ level) :value (nth 0 entry)) (unless (eq (preceding-char) ?\n) *************** *** 1092,1099 **** (custom-group-state-update widget))))) (defvar custom-group-menu ! '(("Apply" . custom-group-apply) ! ("Set Default" . custom-group-set-default) ("Reset" . custom-group-reset)) "Alist of actions for the `custom-group' widget. The key is a string containing the name of the action, the value is a --- 1221,1228 ---- (custom-group-state-update widget))))) (defvar custom-group-menu ! '(("Set" . custom-group-set) ! ("Save" . custom-group-save) ("Reset" . custom-group-reset)) "Alist of actions for the `custom-group' widget. The key is a string containing the name of the action, the value is a *************** *** 1110,1129 **** (if answer (funcall answer widget)))) ! (defun custom-group-apply (widget) ! "Apply changes in all modified group members." (let ((children (widget-get widget :children))) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-apply))) children ))) ! (defun custom-group-set-default (widget) ! "Set default in all modified group members." (let ((children (widget-get widget :children))) (mapcar (lambda (child) ! (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-set-default))) children ))) (defun custom-group-reset (widget) --- 1239,1258 ---- (if answer (funcall answer widget)))) ! (defun custom-group-set (widget) ! "Set changes in all modified group members." (let ((children (widget-get widget :children))) (mapcar (lambda (child) (when (eq (widget-get child :custom-state) 'modified) ! (widget-apply child :custom-set))) children ))) ! (defun custom-group-save (widget) ! "Save all modified group members." (let ((children (widget-get widget :children))) (mapcar (lambda (child) ! (when (memq (widget-get child :custom-state) '(modified set)) ! (widget-apply child :custom-save))) children ))) (defun custom-group-reset (widget) *************** *** 1153,1159 **** (widget-put widget :custom-state found))) (custom-magic-reset widget)) ! ;;; The `custom-save' Command. (defcustom custom-file "~/.emacs" "File used for storing customization information. --- 1282,1288 ---- (widget-put widget :custom-state found))) (custom-magic-reset widget)) ! ;;; The `custom-save-all' Function. (defcustom custom-file "~/.emacs" "File used for storing customization information. *************** *** 1228,1239 **** (unless (eolp) (princ "\n"))))) ! (defun custom-save () "Save all customizations in `custom-file'." - (interactive) (custom-save-variables) (custom-save-faces) - (setq custom-save-needed-p nil) (save-excursion (set-buffer (find-file-noselect custom-file)) (save-buffer))) --- 1357,1366 ---- (unless (eolp) (princ "\n"))))) ! (defun custom-save-all () "Save all customizations in `custom-file'." (custom-save-variables) (custom-save-faces) (save-excursion (set-buffer (find-file-noselect custom-file)) (save-buffer))) *************** *** 1284,1294 **** (let ((item (vector name `(custom-buffer-create '((,symbol custom-group))) t))) ! (if (> custom-menu-nesting 0) (let ((custom-menu-nesting (1- custom-menu-nesting)) ! (custom-prefix-list (cons (or (get symbol 'custom-prefix) ! (concat (symbol-name symbol) "-")) ! custom-prefix-list))) (custom-load-symbol symbol) `(,(custom-unlispify-menu-entry symbol t) ,item --- 1411,1421 ---- (let ((item (vector name `(custom-buffer-create '((,symbol custom-group))) t))) ! (if (and (> custom-menu-nesting 0) ! (< (length (get symbol 'custom-group)) widget-menu-max-size)) (let ((custom-menu-nesting (1- custom-menu-nesting)) ! (custom-prefix-list (custom-prefix-add symbol ! custom-prefix-list))) (custom-load-symbol symbol) `(,(custom-unlispify-menu-entry symbol t) ,item *** pub/rgnus/lisp/custom-opt.el Mon Dec 9 02:38:46 1996 --- rgnus/lisp/custom-opt.el Fri Jan 3 19:13:52 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.12 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Code: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.15 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Code: *** pub/rgnus/lisp/custom.el Mon Dec 9 02:38:18 1996 --- rgnus/lisp/custom.el Fri Jan 3 19:13:26 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.12 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces ! ;; Version: 1.15 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *** pub/rgnus/lisp/gnus-art.el Mon Dec 16 20:10:52 1996 --- rgnus/lisp/gnus-art.el Sat Jan 4 10:40:41 1997 *************** *** 25,37 **** ;;; Code: (require 'gnus) (require 'gnus-sum) - (require 'article) (require 'gnus-spec) (require 'gnus-int) (require 'browse-url) (defcustom gnus-article-save-directory gnus-directory "*Name of the directory articles will be saved in (default \"~/News\")." :group 'article --- 25,195 ---- ;;; Code: + (require 'custom) (require 'gnus) (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) (require 'browse-url) + (defgroup article nil + "Article display." + :group 'gnus) + + (defcustom gnus-ignored-headers + '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" + "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" + "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" + "^Approved:" "^Sender:" "^Received:" "^Mail-from:") + "All headers that match this regexp will be hidden. + This variable can also be a list of regexps of headers to be ignored. + If `gnus-visible-headers' is non-nil, this variable will be ignored." + :type '(choice :custom-show nil + regexp + (repeat regexp)) + :group 'article) + + (defcustom gnus-visible-headers + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-" + "All headers that do not match this regexp will be hidden. + This variable can also be a list of regexp of headers to remain visible. + If this variable is non-nil, `gnus-ignored-headers' will be ignored." + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp) + :group 'article) + + (defcustom gnus-sorted-header-list + '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" + "^Cc:" "^Date:" "^Organization:") + "This variable is a list of regular expressions. + If it is non-nil, headers that match the regular expressions will + be placed first in the article buffer in the sequence specified by + this list." + :type '(repeat regexp) + :group 'article) + + (defcustom gnus-boring-article-headers '(empty followup-to reply-to) + "Headers that are only to be displayed if they have interesting data. + Possible values in this list are `empty', `newsgroups', `followup-to', + `reply-to', and `date'." + :type '(set (const :tag "Headers with no content." empty) + (const :tag "Newsgroups with only one group." newsgroups) + (const :tag "Followup-to identical to newsgroups." followup-to) + (const :tag "Reply-to identical to from." reply-to) + (const :tag "Date less than four days old." date)) + :group 'article) + + (defcustom gnus-signature-separator '("^-- $" "^-- *$") + "Regexp matching signature separator. + This can also be a list of regexps. In that case, it will be checked + from head to tail looking for a separator. Searches will be done from + the end of the buffer." + :type '(repeat string) + :group 'article) + + (defcustom gnus-signature-limit nil + "Provide a limit to what is considered a signature. + If it is a number, no signature may not be longer (in characters) than + that number. If it is a floating point number, no signature may be + longer (in lines) than that number. If it is a function, the function + will be called without any parameters, and if it returns nil, there is + no signature in the buffer. If it is a string, it will be used as a + regexp. If it matches, the text in question is not a signature." + :type '(choice integer number function regexp) + :group 'article) + + (defcustom gnus-hidden-properties '(invisible t intangible t) + "Property list to use for hiding text." + :type 'sexp + :group 'article) + + (defcustom gnus-article-x-face-command + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" + "String or function to be executed to display an X-Face header. + If it is a string, the command will be executed in a sub-shell + asynchronously. The compressed face will be piped to this command." + :type 'string ;Leave function case to Lisp. + :group 'article) + + (defcustom gnus-article-x-face-too-ugly nil + "Regexp matching posters whose face shouldn't be shown automatically." + :type 'regexp + :group 'article) + + (defcustom gnus-emphasis-alist + (let ((format + "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)") + (types + '(("_" "_" underline) + ("/" "/" italic) + ("\\*" "\\*" bold) + ("_/" "/_" underline-italic) + ("_\\*" "\\*_" underline-bold) + ("\\*/" "/\\*" bold-italic) + ("_\\*/" "/\\*_" underline-bold-italic)))) + `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline) + ,@(mapcar + (lambda (spec) + (list + (format format (car spec) (cadr spec)) + 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) + types))) + "Alist that says how to fontify certain phrases. + Each item looks like this: + + (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) + + The first element is a regular expression to be matched. The second + is a number that says what regular expression grouping used to find + the entire emphasized word. The third is a number that says what + regexp grouping should be displayed and highlighted. The fourth + is the face used for highlighting." + :type '(repeat (list :value ("" 0 0 default) + regexp + (integer :tag "Match group") + (integer :tag "Emphasize group") + face)) + :group 'article) + + (defface gnus-emphasis-bold '((t (:bold t))) + "Face used for displaying strong emphasized text (*word*)." + :group 'article) + + (defface gnus-emphasis-italic '((t (:italic t))) + "Face used for displaying italic emphasized text (/word/)." + :group 'article) + + (defface gnus-emphasis-underline '((t (:underline t))) + "Face used for displaying underlined emphasized text (_word_)." + :group 'article) + + (defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) + "Face used for displaying underlined bold emphasized text (_*word*_)." + :group 'article) + + (defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) + "Face used for displaying underlined italic emphasized text (_*word*_)." + :group 'article) + + (defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) + "Face used for displaying bold italic emphasized text (/*word*/)." + :group 'article) + + (defface gnus-emphasis-underline-bold-italic + '((t (:bold t :italic t :underline t))) + "Face used for displaying underlined bold italic emphasized text (_/*word*/_)." + :group 'article) + + (eval-and-compile + (autoload 'hexl-hex-string-to-integer "hexl") + (autoload 'timezone-make-date-arpa-standard "timezone") + (autoload 'mail-extract-address-components "mail-extr")) + (defcustom gnus-article-save-directory gnus-directory "*Name of the directory articles will be saved in (default \"~/News\")." :group 'article *************** *** 303,350 **** (defvar gnus-number-of-articles-to-be-saved nil) ! ;;; Provide a mapping from `gnus-*' commands to Article commands. ! (eval-and-compile ! (mapcar ! (lambda (func) ! (let (afunc gfunc) ! (if (consp func) ! (setq afunc (car func) ! gfunc (cdr func)) ! (setq afunc func ! gfunc (intern (format "gnus-%s" func)))) ! (fset gfunc ! `(lambda (&optional interactive &rest args) ! ,(documentation afunc t) ! (interactive (list t)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (if interactive ! (call-interactively ',afunc) ! (apply ',afunc args))))))) ! '(article-hide-headers ! article-hide-boring-headers ! article-treat-overstrike ! (article-fill . gnus-article-word-wrap) ! article-remove-cr ! article-display-x-face ! article-de-quoted-unreadable ! article-mime-decode-quoted-printable ! article-hide-pgp ! article-hide-pem ! article-hide-signature ! article-remove-trailing-blank-lines ! article-strip-leading-blank-lines ! article-strip-multiple-blank-lines ! article-strip-blank-lines ! article-date-local ! article-date-original ! article-date-lapsed ! article-emphasize ! (article-show-all . gnus-article-show-all-headers)))) ! (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) (defvar gnus-summary-article-menu) (defvar gnus-summary-post-menu) --- 461,1235 ---- (defvar gnus-number-of-articles-to-be-saved nil) ! (defvar gnus-inhibit-hiding nil) ! (defvar gnus-newsgroup-name) ! (defsubst gnus-article-hide-text (b e props) ! "Set text PROPS on the B to E region, extending `intangible' 1 past B." ! (add-text-properties b e props) ! (when (memq 'intangible props) ! (put-text-property ! (max (1- b) (point-min)) ! b 'intangible (cddr (memq 'intangible props))))) ! ! (defsubst gnus-article-unhide-text (b e) ! "Remove hidden text properties from region between B and E." ! (remove-text-properties b e gnus-hidden-properties) ! (when (memq 'intangible gnus-hidden-properties) ! (put-text-property (max (1- b) (point-min)) ! b 'intangible nil))) ! ! (defun gnus-article-hide-text-type (b e type) ! "Hide text of TYPE between B and E." ! (gnus-article-hide-text ! b e (cons 'article-type (cons type gnus-hidden-properties)))) ! ! (defun gnus-article-unhide-text-type (b e type) ! "Hide text of TYPE between B and E." ! (remove-text-properties ! b e (cons 'article-type (cons type gnus-hidden-properties))) ! (when (memq 'intangible gnus-hidden-properties) ! (put-text-property (max (1- b) (point-min)) ! b 'intangible nil))) ! ! (defun gnus-article-hide-text-of-type (type) ! "Hide text of TYPE in the current buffer." ! (save-excursion ! (let ((b (point-min)) ! (e (point-max))) ! (while (setq b (text-property-any b e 'article-type type)) ! (add-text-properties b (incf b) gnus-hidden-properties))))) ! ! (defun gnus-article-delete-text-of-type (type) ! "Delete text of TYPE in the current buffer." ! (save-excursion ! (let ((b (point-min))) ! (while (setq b (text-property-any b (point-max) 'article-type type)) ! (delete-region b (incf b)))))) ! ! (defun gnus-article-delete-invisible-text () ! "Delete all invisible text in the current buffer." ! (save-excursion ! (let ((b (point-min))) ! (while (setq b (text-property-any b (point-max) 'invisible t)) ! (delete-region b (incf b)))))) ! ! (defun gnus-article-text-type-exists-p (type) ! "Say whether any text of type TYPE exists in the buffer." ! (text-property-any (point-min) (point-max) 'article-type type)) ! ! (defsubst gnus-article-header-rank () ! "Give the rank of the string HEADER as given by `article-sorted-header-list'." ! (let ((list gnus-sorted-header-list) ! (i 0)) ! (while list ! (when (looking-at (car list)) ! (setq list nil)) ! (setq list (cdr list)) ! (incf i)) ! i)) ! ! (defun gnus-article-hide-headers (&optional arg delete) ! "Toggle whether to hide unwanted headers and possibly sort them as well. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-article-hidden-arg)) ! (if (gnus-article-check-hidden-text 'headers arg) ! ;; Show boring headers as well. ! (gnus-article-show-hidden-text 'boring-headers) ! ;; This function might be inhibited. ! (unless gnus-inhibit-hiding ! (save-excursion ! (save-restriction ! (let ((buffer-read-only nil) ! (props (nconc (list 'article-type 'headers) ! gnus-hidden-properties)) ! (max (1+ (length gnus-sorted-header-list))) ! (ignored (when (not gnus-visible-headers) ! (cond ((stringp gnus-ignored-headers) ! gnus-ignored-headers) ! ((listp gnus-ignored-headers) ! (mapconcat 'identity gnus-ignored-headers ! "\\|"))))) ! (visible ! (cond ((stringp gnus-visible-headers) ! gnus-visible-headers) ! ((and gnus-visible-headers ! (listp gnus-visible-headers)) ! (mapconcat 'identity gnus-visible-headers "\\|")))) ! (inhibit-point-motion-hooks t) ! want-list beg) ! ;; First we narrow to just the headers. ! (widen) ! (goto-char (point-min)) ! ;; Hide any "From " lines at the beginning of (mail) articles. ! (while (looking-at "From ") ! (forward-line 1)) ! (unless (bobp) ! (if delete ! (delete-region (point-min) (point)) ! (gnus-article-hide-text (point-min) (point) props))) ! ;; Then treat the rest of the header lines. ! (narrow-to-region ! (point) ! (if (search-forward "\n\n" nil t) ; if there's a body ! (progn (forward-line -1) (point)) ! (point-max))) ! ;; Then we use the two regular expressions ! ;; `gnus-ignored-headers' and `gnus-visible-headers' to ! ;; select which header lines is to remain visible in the ! ;; article buffer. ! (goto-char (point-min)) ! (while (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) ! ;; Mark the rank of the header. ! (put-text-property ! (point) (1+ (point)) 'message-rank ! (if (or (and visible (looking-at visible)) ! (and ignored ! (not (looking-at ignored)))) ! (gnus-article-header-rank) ! (+ 2 max))) ! (forward-line 1)) ! (message-sort-headers-1) ! (when (setq beg (text-property-any ! (point-min) (point-max) 'message-rank (+ 2 max))) ! ;; We make the unwanted headers invisible. ! (if delete ! (delete-region beg (point-max)) ! ;; Suggested by Sudish Joseph . ! (gnus-article-hide-text-type beg (point-max) 'headers)) ! ;; Work around XEmacs lossage. ! (put-text-property (point-min) beg 'invisible nil)))))))) ! ! (defun gnus-article-hide-boring-headers (&optional arg) ! "Toggle hiding of headers that aren't very interesting. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-article-hidden-arg)) ! (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) ! (not gnus-show-all-headers)) ! (save-excursion ! (save-restriction ! (let ((buffer-read-only nil) ! (list gnus-boring-article-headers) ! (inhibit-point-motion-hooks t) ! elem) ! (nnheader-narrow-to-headers) ! (while list ! (setq elem (pop list)) ! (goto-char (point-min)) ! (cond ! ;; Hide empty headers. ! ((eq elem 'empty) ! (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t) ! (forward-line -1) ! (gnus-article-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers))) ! ;; Hide boring Newsgroups header. ! ((eq elem 'newsgroups) ! (when (equal (gnus-fetch-field "newsgroups") ! (gnus-group-real-name ! (if (boundp 'gnus-newsgroup-name) ! gnus-newsgroup-name ! ""))) ! (gnus-article-hide-header "newsgroups"))) ! ((eq elem 'followup-to) ! (when (equal (message-fetch-field "followup-to") ! (message-fetch-field "newsgroups")) ! (gnus-article-hide-header "followup-to"))) ! ((eq elem 'reply-to) ! (let ((from (message-fetch-field "from")) ! (reply-to (message-fetch-field "reply-to"))) ! (when (and ! from reply-to ! (equal ! (nth 1 (mail-extract-address-components from)) ! (nth 1 (mail-extract-address-components reply-to)))) ! (gnus-article-hide-header "reply-to")))) ! ((eq elem 'date) ! (let ((date (message-fetch-field "date"))) ! (when (and date ! (< (gnus-days-between (current-time-string) date) ! 4)) ! (gnus-article-hide-header "date"))))))))))) ! ! (defun gnus-article-hide-header (header) ! (save-excursion ! (goto-char (point-min)) ! (when (re-search-forward (concat "^" header ":") nil t) ! (gnus-article-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers)))) ! ! ;; Written by Per Abrahamsen . ! (defun gnus-article-treat-overstrike () ! "Translate overstrikes into bold text." ! (interactive) ! (save-excursion ! (let ((buffer-read-only nil)) ! (while (search-forward "\b" nil t) ! (let ((next (following-char)) ! (previous (char-after (- (point) 2)))) ! ;; We do the boldification/underlining by hiding the ! ;; overstrikes and putting the proper text property ! ;; on the letters. ! (cond ! ((eq next previous) ! (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) ! (put-text-property (point) (1+ (point)) 'face 'bold)) ! ((eq next ?_) ! (gnus-article-hide-text-type (1- (point)) (1+ (point)) 'overstrike) ! (put-text-property ! (- (point) 2) (1- (point)) 'face 'underline)) ! ((eq previous ?_) ! (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) ! (put-text-property ! (point) (1+ (point)) 'face 'underline)))))))) ! (defun gnus-article-fill () ! "Format too long lines." ! (interactive) ! (save-excursion ! (let ((buffer-read-only nil)) ! (widen) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (end-of-line 1) ! (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") ! (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") ! (adaptive-fill-mode t)) ! (while (not (eobp)) ! (and (>= (current-column) (min fill-column (window-width))) ! (/= (preceding-char) ?:) ! (fill-paragraph nil)) ! (end-of-line 2)))))) ! ! (defun gnus-article-remove-cr () ! "Remove carriage returns from an article." ! (interactive) ! (save-excursion ! (let ((buffer-read-only nil)) ! (goto-char (point-min)) ! (while (search-forward "\r" nil t) ! (replace-match "" t t))))) ! ! (defun gnus-article-remove-trailing-blank-lines () ! "Remove all trailing blank lines from the article." ! (interactive) ! (save-excursion ! (let ((buffer-read-only nil)) ! (goto-char (point-max)) ! (delete-region ! (point) ! (progn ! (while (and (not (bobp)) ! (looking-at "^[ \t]*$")) ! (forward-line -1)) ! (forward-line 1) ! (point)))))) ! ! (defun gnus-article-display-x-face (&optional force) ! "Look for an X-Face header and display it if present." ! (interactive (list 'force)) ! (save-excursion ! ;; Delete the old process, if any. ! (when (process-status "article-x-face") ! (delete-process "article-x-face")) ! (let ((inhibit-point-motion-hooks t) ! (case-fold-search nil) ! from) ! (save-restriction ! (nnheader-narrow-to-headers) ! (setq from (message-fetch-field "from")) ! (goto-char (point-min)) ! (when (and gnus-article-x-face-command ! (or force ! ;; Check whether this face is censored. ! (not gnus-article-x-face-too-ugly) ! (and gnus-article-x-face-too-ugly from ! (not (string-match gnus-article-x-face-too-ugly ! from)))) ! ;; Has to be present. ! (re-search-forward "^X-Face: " nil t)) ! ;; We now have the area of the buffer where the X-Face is stored. ! (let ((beg (point)) ! (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) ! ;; We display the face. ! (if (symbolp gnus-article-x-face-command) ! ;; The command is a lisp function, so we call it. ! (if (gnus-functionp gnus-article-x-face-command) ! (funcall gnus-article-x-face-command beg end) ! (error "%s is not a function" gnus-article-x-face-command)) ! ;; The command is a string, so we interpret the command ! ;; as a, well, command, and fork it off. ! (let ((process-connection-type nil)) ! (process-kill-without-query ! (start-process ! "article-x-face" nil shell-file-name shell-command-switch ! gnus-article-x-face-command)) ! (process-send-region "article-x-face" beg end) ! (process-send-eof "article-x-face"))))))))) ! ! (defalias 'gnus-decode-rfc1522 'gnus-article-decode-rfc1522) ! (defun gnus-article-decode-rfc1522 () ! "Hack to remove QP encoding from headers." ! (let ((case-fold-search t) ! (inhibit-point-motion-hooks t) ! (buffer-read-only nil) ! string) ! (save-restriction ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! (goto-char (point-min)) ! (while (re-search-forward ! "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) ! (setq string (match-string 1)) ! (save-restriction ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (delete-region (point-min) (point-max)) ! (insert string) ! (gnus-article-mime-decode-quoted-printable ! (goto-char (point-min)) (point-max)) ! (subst-char-in-region (point-min) (point-max) ?_ ? ) ! (goto-char (point-max))) ! (goto-char (point-min)))))) ! ! (defun gnus-article-de-quoted-unreadable (&optional force) ! "Do a naive translation of a quoted-printable-encoded article. ! This is in no way, shape or form meant as a replacement for real MIME ! processing, but is simply a stop-gap measure until MIME support is ! written. ! If FORCE, decode the article whether it is marked as quoted-printable ! or not." ! (interactive (list 'force)) ! (save-excursion ! (let ((case-fold-search t) ! (buffer-read-only nil) ! (type (gnus-fetch-field "content-transfer-encoding"))) ! (gnus-article-decode-rfc1522) ! (when (or force ! (and type (string-match "quoted-printable" (downcase type)))) ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (gnus-article-mime-decode-quoted-printable (point) (point-max)))))) ! ! (defun gnus-article-mime-decode-quoted-printable-buffer () ! "Decode Quoted-Printable in the current buffer." ! (gnus-article-mime-decode-quoted-printable (point-min) (point-max))) ! ! (defun gnus-article-mime-decode-quoted-printable (from to) ! "Decode Quoted-Printable in the region between FROM and TO." ! (interactive "r") ! (goto-char from) ! (while (search-forward "=" to t) ! (cond ((eq (following-char) ?\n) ! (delete-char -1) ! (delete-char 1)) ! ((looking-at "[0-9A-F][0-9A-F]") ! (subst-char-in-region ! (1- (point)) (point) ?= ! (hexl-hex-string-to-integer ! (buffer-substring (point) (+ 2 (point))))) ! (delete-char 2)) ! ((looking-at "=") ! (delete-char 1)) ! ((gnus-message 3 "Malformed MIME quoted-printable message"))))) ! ! (defun gnus-article-hide-pgp (&optional arg) ! "Toggle hiding of any PGP headers and signatures in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-article-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'pgp arg) ! (save-excursion ! (let (buffer-read-only beg end) ! (widen) ! (goto-char (point-min)) ! ;; Hide the "header". ! (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) ! (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) ! (setq beg (point)) ! ;; Hide the actual signature. ! (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) ! (setq end (1+ (match-beginning 0))) ! (gnus-article-hide-text-type ! end ! (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) ! (match-end 0) ! ;; Perhaps we shouldn't hide to the end of the buffer ! ;; if there is no end to the signature? ! (point-max)) ! 'pgp)) ! ;; Hide "- " PGP quotation markers. ! (when (and beg end) ! (narrow-to-region beg end) ! (goto-char (point-min)) ! (while (re-search-forward "^- " nil t) ! (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) ! (widen)))))) ! ! (defun gnus-article-hide-pem (&optional arg) ! "Toggle hiding of any PEM headers and signatures in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-article-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'pem arg) ! (save-excursion ! (let (buffer-read-only end) ! (widen) ! (goto-char (point-min)) ! ;; hide the horrendously ugly "header". ! (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" ! nil ! t) ! (setq end (1+ (match-beginning 0))) ! (gnus-article-hide-text-type ! end ! (if (search-forward "\n\n" nil t) ! (match-end 0) ! (point-max)) ! 'pem)) ! ;; hide the trailer as well ! (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" ! nil ! t) ! (gnus-article-hide-text-type ! (match-beginning 0) (match-end 0) 'pem)))))) ! ! (defun gnus-article-hide-signature (&optional arg) ! "Hide the signature in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-article-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'signature arg) ! (save-excursion ! (save-restriction ! (let ((buffer-read-only nil)) ! (when (gnus-article-narrow-to-signature) ! (gnus-article-hide-text-type (point-min) (point-max) 'signature))))))) ! ! (defun gnus-article-strip-leading-blank-lines () ! "Remove all blank lines from the beginning of the article." ! (interactive) ! (save-excursion ! (let ((inhibit-point-motion-hooks t) ! buffer-read-only) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (while (and (not (eobp)) ! (looking-at "[ \t]*$")) ! (gnus-delete-line)))))) ! ! (defun gnus-article-strip-multiple-blank-lines () ! "Replace consecutive blank lines with one empty line." ! (interactive) ! (save-excursion ! (let (buffer-read-only) ! ;; First make all blank lines empty. ! (goto-char (point-min)) ! (while (re-search-forward "^[ \t]+$" nil t) ! (replace-match "" nil t)) ! ;; Then replace multiple empty lines with a single empty line. ! (goto-char (point-min)) ! (while (re-search-forward "\n\n\n+" nil t) ! (replace-match "\n\n" t t))))) ! ! (defun gnus-article-strip-blank-lines () ! "Strip leading, trailing and multiple blank lines." ! (interactive) ! (gnus-article-strip-leading-blank-lines) ! (gnus-article-remove-trailing-blank-lines) ! (gnus-article-strip-multiple-blank-lines)) ! ! (defvar mime::preview/content-list) ! (defvar mime::preview-content-info/point-min) ! (defun gnus-article-narrow-to-signature () ! "Narrow to the signature; return t if a signature is found, else nil." ! (widen) ! (when (and (boundp 'mime::preview/content-list) ! mime::preview/content-list) ! ;; We have a MIMEish article, so we use the MIME data to narrow. ! (let ((pcinfo (car (last mime::preview/content-list)))) ! (ignore-errors ! (narrow-to-region ! (funcall (intern "mime::preview-content-info/point-min") pcinfo) ! (point-max))))) ! ! (when (gnus-article-search-signature) ! (forward-line 1) ! ;; Check whether we have some limits to what we consider ! ;; to be a signature. ! (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit ! (list gnus-signature-limit))) ! limit limited) ! (while (setq limit (pop limits)) ! (if (or (and (integerp limit) ! (< (- (point-max) (point)) limit)) ! (and (floatp limit) ! (< (count-lines (point) (point-max)) limit)) ! (and (gnus-functionp limit) ! (funcall limit)) ! (and (stringp limit) ! (not (re-search-forward limit nil t)))) ! () ; This limit did not succeed. ! (setq limited t ! limits nil))) ! (unless limited ! (narrow-to-region (point) (point-max)) ! t)))) ! ! (defun gnus-article-search-signature () ! "Search the current buffer for the signature separator. ! Put point at the beginning of the signature separator." ! (let ((cur (point))) ! (goto-char (point-max)) ! (if (if (stringp gnus-signature-separator) ! (re-search-backward gnus-signature-separator nil t) ! (let ((seps gnus-signature-separator)) ! (while (and seps ! (not (re-search-backward (car seps) nil t))) ! (pop seps)) ! seps)) ! t ! (goto-char cur) ! nil))) ! ! (defun gnus-article-hidden-arg () ! "Return the current prefix arg as a number, or 0 if no prefix." ! (list (if current-prefix-arg ! (prefix-numeric-value current-prefix-arg) ! 0))) ! ! (defun gnus-article-check-hidden-text (type arg) ! "Return nil if hiding is necessary. ! Arg can be nil or a number. Nil and positive means hide, negative ! means show, 0 means toggle." ! (save-excursion ! (let ((hide (gnus-article-hidden-text-p type))) ! (cond ! ((or (null arg) ! (> arg 0)) ! nil) ! ((< arg 0) ! (gnus-article-show-hidden-text type)) ! (t ! (if (eq hide 'hidden) ! (gnus-article-show-hidden-text type) ! nil)))))) ! ! (defun gnus-article-hidden-text-p (type) ! "Say whether the current buffer contains hidden text of type TYPE." ! (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) ! (when pos ! (if (get-text-property pos 'invisible) ! 'hidden ! 'shown)))) ! ! (defun gnus-article-show-hidden-text (type &optional hide) ! "Show all hidden text of type TYPE. ! If HIDE, hide the text instead." ! (save-excursion ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (beg (point-min))) ! (while (gnus-goto-char (text-property-any ! beg (point-max) 'article-type type)) ! (setq beg (point)) ! (forward-char) ! (if hide ! (gnus-article-hide-text beg (point) gnus-hidden-properties) ! (gnus-article-unhide-text beg (point))) ! (setq beg (point))) ! t))) ! ! (defconst article-time-units ! `((year . ,(* 365.25 24 60 60)) ! (week . ,(* 7 24 60 60)) ! (day . ,(* 24 60 60)) ! (hour . ,(* 60 60)) ! (minute . 60) ! (second . 1)) ! "Mapping from time units to seconds.") ! ! (defun gnus-article-date-ut (&optional type highlight header) ! "Convert DATE date to universal time in the current article. ! If TYPE is `local', convert to local time; if it is `lapsed', output ! how much time has lapsed since DATE." ! (interactive (list 'ut t)) ! (let* ((header (or header ! (mail-header-date gnus-current-headers) ! (message-fetch-field "date") ! "")) ! (date (if (vectorp header) (mail-header-date header) ! header)) ! (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") ! (inhibit-point-motion-hooks t) ! bface eface) ! (when (and date (not (string= date ""))) ! (save-excursion ! (save-restriction ! (nnheader-narrow-to-headers) ! (let ((buffer-read-only nil)) ! ;; Delete any old Date headers. ! (if (re-search-forward date-regexp nil t) ! (progn ! (setq bface (get-text-property (gnus-point-at-bol) 'face) ! eface (get-text-property (1- (gnus-point-at-eol)) ! 'face)) ! (message-remove-header date-regexp t) ! (beginning-of-line)) ! (goto-char (point-max))) ! (insert (gnus-article-make-date-line date type)) ! ;; Do highlighting. ! (forward-line -1) ! (when (looking-at "\\([^:]+\\): *\\(.*\\)$") ! (put-text-property (match-beginning 1) (match-end 1) ! 'face bface) ! (put-text-property (match-beginning 2) (match-end 2) ! 'face eface)))))))) ! ! (defun gnus-article-make-date-line (date type) ! "Return a DATE line of TYPE." ! (cond ! ;; Convert to the local timezone. We have to slap a ! ;; `condition-case' round the calls to the timezone ! ;; functions since they aren't particularly resistant to ! ;; buggy dates. ! ((eq type 'local) ! (concat "Date: " (condition-case () ! (timezone-make-date-arpa-standard date) ! (error date)) ! "\n")) ! ;; Convert to Universal Time. ! ((eq type 'ut) ! (concat "Date: " ! (condition-case () ! (timezone-make-date-arpa-standard date nil "UT") ! (error date)) ! "\n")) ! ;; Get the original date from the article. ! ((eq type 'original) ! (concat "Date: " date "\n")) ! ;; Do an X-Sent lapsed format. ! ((eq type 'lapsed) ! ;; If the date is seriously mangled, the timezone functions are ! ;; liable to bug out, so we ignore all errors. ! (let* ((now (current-time)) ! (real-time ! (ignore-errors ! (gnus-time-minus ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! (current-time-string now) ! (current-time-zone now) "UT")) ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT"))))) ! (real-sec (and real-time ! (+ (* (float (car real-time)) 65536) ! (cadr real-time)))) ! (sec (and real-time (abs real-sec))) ! num prev) ! (cond ! ((null real-time) ! "X-Sent: Unknown\n") ! ((zerop sec) ! "X-Sent: Now\n") ! (t ! (concat ! "X-Sent: " ! ;; This is a bit convoluted, but basically we go ! ;; through the time units for years, weeks, etc, ! ;; and divide things to see whether that results ! ;; in positive answers. ! (mapconcat ! (lambda (unit) ! (if (zerop (setq num (ffloor (/ sec (cdr unit))))) ! ;; The (remaining) seconds are too few to ! ;; be divided into this time unit. ! "" ! ;; It's big enough, so we output it. ! (setq sec (- sec (* num (cdr unit)))) ! (prog1 ! (concat (if prev ", " "") (int-to-string ! (floor num)) ! " " (symbol-name (car unit)) ! (if (> num 1) "s" "")) ! (setq prev t)))) ! article-time-units "") ! ;; If dates are odd, then it might appear like the ! ;; article was sent in the future. ! (if (> real-sec 0) ! " ago\n" ! " in the future\n")))))) ! (t ! (error "Unknown conversion type: %s" type)))) ! ! (defun gnus-article-date-local (&optional highlight) ! "Convert the current article date to the local timezone." ! (interactive (list t)) ! (gnus-article-date-ut 'local highlight)) ! ! (defun gnus-article-date-original (&optional highlight) ! "Convert the current article date to what it was originally. ! This is only useful if you have used some other date conversion ! function and want to see what the date was before converting." ! (interactive (list t)) ! (gnus-article-date-ut 'original highlight)) ! ! (defun gnus-article-date-lapsed (&optional highlight) ! "Convert the current article date to time lapsed since it was sent." ! (interactive (list t)) ! (gnus-article-date-ut 'lapsed highlight)) ! ! (defun gnus-article-show-all () ! "Show all hidden text in the article buffer." ! (interactive) ! (save-excursion ! (let ((buffer-read-only nil)) ! (gnus-article-unhide-text (point-min) (point-max))))) ! ! (defun gnus-article-emphasize (&optional arg) ! "Emphasize text according to `gnus-emphasis-alist'." ! (interactive (gnus-article-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'emphasis arg) ! (save-excursion ! (let ((alist gnus-emphasis-alist) ! (buffer-read-only nil) ! (props (append '(gnus-article-type emphasis) ! gnus-hidden-properties)) ! regexp elem beg invisible visible face) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (setq beg (point)) ! (while (setq elem (pop alist)) ! (goto-char beg) ! (setq regexp (car elem) ! invisible (nth 1 elem) ! visible (nth 2 elem) ! face (nth 3 elem)) ! (while (re-search-forward regexp nil t) ! (when (and (match-beginning visible) (match-beginning invisible)) ! (gnus-article-hide-text ! (match-beginning invisible) (match-end invisible) props) ! (gnus-article-unhide-text-type ! (match-beginning visible) (match-end visible) 'emphasis) ! (gnus-put-text-property-excluding-newlines ! (match-beginning visible) (match-end visible) 'face face) ! (goto-char (match-end invisible))))))))) (defvar gnus-summary-article-menu) (defvar gnus-summary-post-menu) *************** *** 417,426 **** (let (result) (let ((file-name-history (nconc split-name file-name-history))) (setq result ! (read-file-name ! (concat prompt " (`M-p' for defaults) ") ! gnus-article-save-directory ! (car split-name)))) (car (push result file-name-history))))))) ;; Create the directory. (gnus-make-directory (file-name-directory file)) --- 1302,1313 ---- (let (result) (let ((file-name-history (nconc split-name file-name-history))) (setq result ! (expand-file-name ! (read-file-name ! (concat prompt " (`M-p' for defaults) ") ! gnus-article-save-directory ! (car split-name)) ! gnus-article-save-directory))) (car (push result file-name-history))))))) ;; Create the directory. (gnus-make-directory (file-name-directory file)) *************** *** 799,805 **** (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t)) ! (let* ((article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) --- 1686,1692 ---- (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t)) ! (let* ((gnus-article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) *************** *** 907,920 **** "Return a string which display status of article washing." (save-excursion (set-buffer gnus-article-buffer) ! (let ((cite (article-hidden-text-p 'cite)) ! (headers (article-hidden-text-p 'headers)) ! (boring (article-hidden-text-p 'boring-headers)) ! (pgp (article-hidden-text-p 'pgp)) ! (pem (article-hidden-text-p 'pem)) ! (signature (article-hidden-text-p 'signature)) ! (overstrike (article-hidden-text-p 'overstrike)) ! (emphasis (article-hidden-text-p 'emphasis)) (mime gnus-show-mime)) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) --- 1794,1807 ---- "Return a string which display status of article washing." (save-excursion (set-buffer gnus-article-buffer) ! (let ((cite (gnus-article-hidden-text-p 'cite)) ! (headers (gnus-article-hidden-text-p 'headers)) ! (boring (gnus-article-hidden-text-p 'boring-headers)) ! (pgp (gnus-article-hidden-text-p 'pgp)) ! (pem (gnus-article-hidden-text-p 'pem)) ! (signature (gnus-article-hidden-text-p 'signature)) ! (overstrike (gnus-article-hidden-text-p 'overstrike)) ! (emphasis (gnus-article-hidden-text-p 'emphasis)) (mime gnus-show-mime)) (format "%c%c%c%c%c%c%c" (if cite ?c ? ) *************** *** 1356,1371 **** (point)) (set-buffer buf)))))) - (defun gnus-article-date-ut (&optional type highlight) - "Convert DATE date to universal time in the current article. - If TYPE is `local', convert to local time; if it is `lapsed', output - how much time has lapsed since DATE." - (interactive (list 'ut t)) - (let ((headers (or gnus-current-headers (gnus-summary-article-header)))) - (save-excursion - (set-buffer gnus-article-buffer) - (article-date-ut type highlight headers)))) - ;;; ;;; Article editing ;;; --- 2243,2248 ---- *************** *** 1704,1714 **** (inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face ! (article-narrow-to-signature)) (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (article-search-signature) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle --- 2581,2591 ---- (inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face ! (gnus-article-narrow-to-signature)) (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) 'face gnus-signature-face) (widen) ! (gnus-article-search-signature) (let ((start (match-beginning 0)) (end (set-marker (make-marker) (1+ (match-end 0))))) (gnus-article-add-button start (1- end) 'gnus-signature-toggle *************** *** 1812,1819 **** (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (if (get-text-property end 'invisible) ! (article-unhide-text end (point-max)) ! (article-hide-text end (point-max) gnus-hidden-properties))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. --- 2689,2696 ---- (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (if (get-text-property end 'invisible) ! (gnus-article-unhide-text end (point-max)) ! (gnus-article-hide-text end (point-max) gnus-hidden-properties))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. *** pub/rgnus/lisp/gnus-async.el Sun Nov 10 10:10:56 1996 --- rgnus/lisp/gnus-async.el Sat Jan 4 09:03:12 1997 *************** *** 257,264 **** (defun gnus-async-prefetched-article-entry (group article) "Return the entry for ARTICLE in GROUP iff it has been prefetched." ! (assq (intern (format "%s-%d" group article)) ! gnus-async-article-alist)) ;;; ;;; Header prefetch --- 257,271 ---- (defun gnus-async-prefetched-article-entry (group article) "Return the entry for ARTICLE in GROUP iff it has been prefetched." ! (let ((entry (assq (intern (format "%s-%d" group article)) ! gnus-async-article-alist))) ! ;; Perhaps something has emptied the buffer? ! (if (and entry ! (= (cadr entry) (caddr entry))) ! (progn ! (gnus-async-delete-prefected-entry entry) ! nil) ! entry))) ;;; ;;; Header prefetch *** pub/rgnus/lisp/gnus-cache.el Mon Dec 16 19:47:18 1996 --- rgnus/lisp/gnus-cache.el Sat Jan 4 10:28:30 1997 *************** *** 28,35 **** (require 'gnus) (require 'gnus-int) (require 'gnus-range) - (require 'gnus-sum) (require 'gnus-start) (defgroup gnus-cache nil "Cache interface." --- 28,36 ---- (require 'gnus) (require 'gnus-int) (require 'gnus-range) (require 'gnus-start) + (eval-when-compile + (require 'gnus-sum)) (defgroup gnus-cache nil "Cache interface." *** pub/rgnus/lisp/gnus-cite.el Fri Dec 13 04:51:03 1996 --- rgnus/lisp/gnus-cite.el Sat Jan 4 08:56:25 1997 *************** *** 361,367 **** (search-forward "\n\n" nil t) (push (cons (point-marker) "") marks) (goto-char (point-max)) ! (article-search-signature) (push (cons (point-marker) "") marks) (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) (let* ((omarks marks)) --- 361,367 ---- (search-forward "\n\n" nil t) (push (cons (point-marker) "") marks) (goto-char (point-max)) ! (gnus-article-search-signature) (push (cons (point-marker) "") marks) (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) (let* ((omarks marks)) *************** *** 421,438 **** See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." ! (interactive (append (article-hidden-arg) (list 'force))) (setq gnus-cited-text-button-line-format-spec (gnus-parse-format gnus-cited-text-button-line-format gnus-cited-text-button-line-format-alist t)) (save-excursion (set-buffer gnus-article-buffer) (cond ! ((article-check-hidden-text 'cite arg) t) ! ((article-text-type-exists-p 'cite) (let ((buffer-read-only nil)) ! (article-hide-text-of-type 'cite))) (t (let ((buffer-read-only nil) (marks (gnus-dissect-cited-text)) --- 421,438 ---- See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." ! (interactive (append (gnus-article-hidden-arg) (list 'force))) (setq gnus-cited-text-button-line-format-spec (gnus-parse-format gnus-cited-text-button-line-format gnus-cited-text-button-line-format-alist t)) (save-excursion (set-buffer gnus-article-buffer) (cond ! ((gnus-article-check-hidden-text 'cite arg) t) ! ((gnus-article-text-type-exists-p 'cite) (let ((buffer-read-only nil)) ! (gnus-article-hide-text-of-type 'cite))) (t (let ((buffer-read-only nil) (marks (gnus-dissect-cited-text)) *************** *** 493,500 **** cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (append (article-hidden-arg) (list 'force))) ! (unless (article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) --- 493,500 ---- cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (append (gnus-article-hidden-arg) (list 'force))) ! (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) *************** *** 507,513 **** (hiden 0) total) (goto-char (point-max)) ! (article-search-signature) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) --- 507,513 ---- (hiden 0) total) (goto-char (point-max)) ! (gnus-article-search-signature) (setq total (count-lines start (point))) (while atts (setq hiden (+ hiden (length (cdr (assoc (cdar atts) *************** *** 572,578 **** (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (article-search-signature) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. --- 572,578 ---- (case-fold-search t) (max (save-excursion (goto-char (point-max)) ! (gnus-article-search-signature) (point))) alist entry start begin end numbers prefix) ;; Get all potential prefixes in `alist'. *** pub/rgnus/lisp/gnus-demon.el Tue Dec 3 05:55:15 1996 --- rgnus/lisp/gnus-demon.el Fri Jan 3 21:21:51 1997 *************** *** 73,79 **** (defvar gnus-demon-idle-has-been-called nil) (defvar gnus-demon-idle-time 0) (defvar gnus-demon-handler-state nil) - (defvar gnus-demon-is-idle nil) (defvar gnus-demon-last-keys nil) (eval-and-compile --- 73,78 ---- *************** *** 188,194 **** (or (not (setq idle (nth 2 handler))) ; Don't care about idle. (and (numberp idle) ; Numerical idle... (< idle gnus-demon-idle-time)) ; Idle timed out. ! gnus-demon-is-idle) ; Or just need to be idle. ;; So we call the handler. (progn (funcall (car handler)) --- 187,193 ---- (or (not (setq idle (nth 2 handler))) ; Don't care about idle. (and (numberp idle) ; Numerical idle... (< idle gnus-demon-idle-time)) ; Idle timed out. ! gnus-demon-idle-time) ; Or just need to be idle. ;; So we call the handler. (progn (funcall (car handler)) *** pub/rgnus/lisp/gnus-group.el Thu Dec 5 20:41:23 1996 --- rgnus/lisp/gnus-group.el Sat Jan 4 10:31:04 1997 *************** *** 277,458 **** (string :tag "Name") (sexp :tag "Method")))) - (defface gnus-group-news-1-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "ForestGreen" :bold t)) - (t - ())) - "Level 1 newsgroup face.") - - (defface gnus-group-news-1-empty-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - ())) - "Level 1 empty newsgroup face.") - - (defface gnus-group-news-2-face - '((((class color) - (background dark)) - (:foreground "turquoise" :bold t)) - (((class color) - (background light)) - (:foreground "CadetBlue4" :bold t)) - (t - ())) - "Level 2 newsgroup face.") - - (defface gnus-group-news-2-empty-face - '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "CadetBlue4")) - (t - ())) - "Level 2 empty newsgroup face.") - - (defface gnus-group-news-3-face - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 3 newsgroup face.") - - (defface gnus-group-news-3-empty-face - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 3 empty newsgroup face.") - - (defface gnus-group-news-low-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" :bold t)) - (t - ())) - "Low level newsgroup face.") - - (defface gnus-group-news-low-empty-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Low level empty newsgroup face.") - - (defface gnus-group-mail-1-face - '((((class color) - (background dark)) - (:foreground "aquamarine1" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink3" :bold t)) - (t - (:bold t))) - "Level 1 mailgroup face.") - - (defface gnus-group-mail-1-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine1")) - (((class color) - (background light)) - (:foreground "DeepPink3")) - (t - (:italic t :bold t))) - "Level 1 empty mailgroup face.") - - (defface gnus-group-mail-2-face - '((((class color) - (background dark)) - (:foreground "aquamarine2" :bold t)) - (((class color) - (background light)) - (:foreground "HotPink3" :bold t)) - (t - (:bold t))) - "Level 2 mailgroup face.") - - (defface gnus-group-mail-2-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine2")) - (((class color) - (background light)) - (:foreground "HotPink3")) - (t - (:bold t))) - "Level 2 empty mailgroup face.") - - (defface gnus-group-mail-3-face - '((((class color) - (background dark)) - (:foreground "aquamarine3" :bold t)) - (((class color) - (background light)) - (:foreground "magenta4" :bold t)) - (t - (:bold t))) - "Level 3 mailgroup face.") - - (defface gnus-group-mail-3-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine3")) - (((class color) - (background light)) - (:foreground "magenta4")) - (t - ())) - "Level 3 empty mailgroup face.") - - (defface gnus-group-mail-low-face - '((((class color) - (background dark)) - (:foreground "aquamarine4" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink4" :bold t)) - (t - (:bold t))) - "Low level mailgroup face.") - - (defface gnus-group-mail-low-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine4")) - (((class color) - (background light)) - (:foreground "DeepPink4")) - (t - (:bold t))) - "Low level empty mailgroup face.") - (defcustom gnus-group-highlight '(;; News. ((and (= unread 0) (not mailp) (eq level 1)) . --- 277,282 ---- *************** *** 2535,2549 **** (interactive "P") (unless (gnus-group-group-name) (error "No group on the current line")) ! (if (not (or (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (if all ! "Do you really want to mark all articles as read? " ! "Mark all unread articles as read? ")))) ! n ! (let ((groups (gnus-group-process-prefix n)) ! (ret 0)) (while groups ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) --- 2359,2378 ---- (interactive "P") (unless (gnus-group-group-name) (error "No group on the current line")) ! (let ((groups (gnus-group-process-prefix n)) ! (ret 0)) ! (if (not ! (or (not gnus-interactive-catchup) ;Without confirmation? ! gnus-expert-user ! (gnus-y-or-n-p ! (format ! (if all ! "Do you really want to mark all articles in %s as read? " ! "Mark all unread articles in %s as read? ") ! (if (= (length groups) 1) ! (car groups) ! (format "these %d groups" (length groups))))))) ! n (while groups ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) *************** *** 3007,3013 **** (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) (run-hooks 'gnus-after-getting-new-news-hook) ! (gnus-group-list-groups)) (defun gnus-group-get-new-news-this-group (&optional n) "Check for newly arrived news in the current group (and the N-1 next groups). --- 2836,2842 ---- (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) (run-hooks 'gnus-after-getting-new-news-hook) ! (gnus-group-list-groups arg)) (defun gnus-group-get-new-news-this-group (&optional n) "Check for newly arrived news in the current group (and the N-1 next groups). *** pub/rgnus/lisp/gnus-msg.el Mon Dec 16 20:10:51 1996 --- rgnus/lisp/gnus-msg.el Sat Jan 4 08:56:25 1997 *************** *** 317,324 **** (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) ! (when (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer))) (save-excursion (set-buffer article-buffer) (save-restriction --- 317,325 ---- (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) ! (if (not (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer)))) ! (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) (save-restriction *************** *** 327,333 **** (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) ! (article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (insert --- 328,334 ---- (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) ! (gnus-article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (insert *************** *** 347,353 **** (or (search-forward "\n\n" nil t) (point))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) ! (article-decode-rfc1522))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject --- 348,354 ---- (or (search-forward "\n\n" nil t) (point))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) ! (gnus-article-decode-rfc1522))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject *** pub/rgnus/lisp/gnus-nocem.el Mon Dec 16 14:25:59 1996 --- rgnus/lisp/gnus-nocem.el Thu Jan 2 16:02:50 1997 *************** *** 188,194 **** (push (mail-header-message-id header) ; But don't come back for gnus-nocem-seen-message-ids)))))) ; second helpings. - (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." (if (fboundp gnus-nocem-verifyer) --- 188,193 ---- *** pub/rgnus/lisp/gnus-salt.el Sat Nov 30 07:04:37 1996 --- rgnus/lisp/gnus-salt.el Fri Jan 3 18:12:59 1997 *************** *** 75,80 **** --- 75,81 ---- "." gnus-pick-article gnus-down-mouse-2 gnus-pick-mouse-pick-region ;;gnus-mouse-2 gnus-pick-mouse-pick + "X" gnus-pick-start-reading "\r" gnus-pick-start-reading)) (defun gnus-pick-make-menu-bar () *************** *** 144,152 **** (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow ! (if (gnus-group-quit-config gnus-newsgroup-name) ! (gnus-summary-exit) ! (gnus-summary-next-group)) (error "No articles have been picked")))) (defun gnus-pick-article (&optional arg) --- 145,156 ---- (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow ! (progn ! (when (or catch-up gnus-mark-unpicked-articles-as-read) ! (gnus-summary-limit-mark-excluded-as-read)) ! (if (gnus-group-quit-config gnus-newsgroup-name) ! (gnus-summary-exit) ! (gnus-summary-next-group))) (error "No articles have been picked")))) (defun gnus-pick-article (&optional arg) *************** *** 705,711 **** (setq beg (point)) ;; Draw "-" lines leftwards. (while (progn ! (forward-char -2) (= (following-char) ? )) (delete-char 1) (insert (car gnus-tree-parent-child-edges))) --- 709,716 ---- (setq beg (point)) ;; Draw "-" lines leftwards. (while (progn ! (unless (bolp) ! (forward-char -2)) (= (following-char) ? )) (delete-char 1) (insert (car gnus-tree-parent-child-edges))) *** pub/rgnus/lisp/gnus-start.el Fri Dec 13 05:30:15 1996 --- rgnus/lisp/gnus-start.el Thu Jan 2 16:03:54 1997 *************** *** 715,720 **** --- 715,721 ---- (buffer-name gnus-dribble-buffer)) (let ((obuf (current-buffer))) (set-buffer gnus-dribble-buffer) + (goto-char (point-max)) (insert string "\n") (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) *** pub/rgnus/lisp/gnus-sum.el Mon Dec 16 18:32:25 1996 --- rgnus/lisp/gnus-sum.el Sat Jan 4 10:36:17 1997 *************** *** 736,873 **** :group 'gnus-group-select :type 'hook) - (defface gnus-summary-selected-face '((t - (:underline t))) - "Face used for selected articles.") - (defcustom gnus-summary-selected-face 'gnus-summary-selected-face "Face used for highlighting the current article in the summary buffer." :group 'gnus-summary-visual :type 'face) - (defface gnus-summary-cancelled-face - '((((class color)) - (:foreground "yellow" :background "black"))) - "Face used for cancelled articles.") - - (defface gnus-summary-high-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :bold t)) - (((class color) - (background light)) - (:foreground "firebrick" :bold t)) - (t - (:bold t))) - "Face used for high interest ticked articles.") - - (defface gnus-summary-low-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :italic t)) - (((class color) - (background light)) - (:foreground "firebrick" :italic t)) - (t - (:italic t))) - "Face used for low interest ticked articles.") - - (defface gnus-summary-normal-ticked-face - '((((class color) - (background dark)) - (:foreground "pink")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - ())) - "Face used for normal interest ticked articles.") - - (defface gnus-summary-high-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :bold t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :bold t)) - (t - (:bold t))) - "Face used for high interest ancient articles.") - - (defface gnus-summary-low-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :italic t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :italic t)) - (t - (:italic t))) - "Face used for low interest ancient articles.") - - (defface gnus-summary-normal-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue")) - (((class color) - (background light)) - (:foreground "RoyalBlue")) - (t - ())) - "Face used for normal interest ancient articles.") - - (defface gnus-summary-high-unread-face - '((t - (:bold t))) - "Face used for high interest unread articles.") - - (defface gnus-summary-low-unread-face - '((t - (:italic t))) - "Face used for low interest unread articles.") - - (defface gnus-summary-normal-unread-face - '((t - ())) - "Face used for normal interest unread articles.") - - (defface gnus-summary-high-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :bold t)) - (t - (:bold t))) - "Face used for high interest read articles.") - - (defface gnus-summary-low-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :italic t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :italic t)) - (t - (:italic t))) - "Face used for low interest read articles.") - - (defface gnus-summary-normal-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Face used for normal interest read articles.") - (defcustom gnus-summary-highlight '(((= mark gnus-canceled-mark) . gnus-summary-cancelled-face) --- 736,746 ---- *************** *** 4514,4520 **** (gnus-error 4 "Strange nov line (%d)" (count-lines (point-min) (point))))) (forward-line 1)) ! (nreverse headers)))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. --- 4387,4406 ---- (gnus-error 4 "Strange nov line (%d)" (count-lines (point-min) (point))))) (forward-line 1)) ! ;; A common bug in inn is that if you have posted an article and ! ;; then retrieves the active file, it will answer correctly -- ! ;; the new article is included. However, a NOV entry for the ! ;; article may not have been generated yet, so this may fail. ! ;; We work around this problem by retrieving the last few ! ;; headers using HEAD. ! (if (not sequence) ! (nreverse headers) ! (let ((gnus-nov-is-evil t) ! (nntp-nov-is-evil t)) ! (nconc ! (nreverse headers) ! (when (gnus-retrieve-headers sequence gnus-newsgroup-name) ! (gnus-get-newsgroup-headers)))))))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. *************** *** 4957,4963 **** (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. If FORCE (the prefix), also save the .newsrc file(s)." ! (interactive) (gnus-summary-update-info) (when force (gnus-save-newsrc-file))) --- 4843,4849 ---- (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. If FORCE (the prefix), also save the .newsrc file(s)." ! (interactive "P") (gnus-summary-update-info) (when force (gnus-save-newsrc-file))) *************** *** 6138,6146 **** gnus-newsgroup-reads))) t) ;; Check NoCeM things. ! (and gnus-use-nocem ! (gnus-nocem-unwanted-article-p ! (mail-header-id (car thread)))))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit --- 6024,6036 ---- gnus-newsgroup-reads))) t) ;; Check NoCeM things. ! (if (and gnus-use-nocem ! (gnus-nocem-unwanted-article-p ! (mail-header-id (car thread)))) ! (progn ! (setq gnus-newsgroup-reads ! (delq number gnus-newsgroup-unreads)) ! t)))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit *************** *** 6556,6562 **** (progn (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) ! (article-delete-invisible-text) (ps-print-buffer-with-faces filename)) (kill-buffer buffer))))) --- 6446,6452 ---- (progn (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) ! (gnus-article-delete-invisible-text) (ps-print-buffer-with-faces filename)) (kill-buffer buffer))))) *************** *** 7021,7027 **** (interactive) (gnus-set-global-variables) (or gnus-expert-user ! (gnus-y-or-n-p "Are you really, really, really sure you want to delete all these messages? ") (error "Phew!")) (gnus-summary-expire-articles t)) --- 6911,6917 ---- (interactive) (gnus-set-global-variables) (or gnus-expert-user ! (gnus-yes-or-no-p "Are you really, really, really sure you want to delete all these messages? ") (error "Phew!")) (gnus-summary-expire-articles t)) *************** *** 7044,7050 **** (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user ! (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " (if (> (length articles) 1) (format "these %s articles" (length articles)) --- 6934,6940 ---- (let ((articles (gnus-summary-work-articles n)) not-deleted) (if (and gnus-novice-user ! (not (gnus-yes-or-no-p (format "Do you really want to delete %s forever? " (if (> (length articles) 1) (format "these %s articles" (length articles)) *************** *** 7452,7458 **** (and (not no-expire) gnus-newsgroup-auto-expire (or (not mark) ! (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark) (= mark gnus-souped-mark) --- 7342,7348 ---- (and (not no-expire) gnus-newsgroup-auto-expire (or (not mark) ! (and (gnus-characterp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) (= mark gnus-read-mark) (= mark gnus-souped-mark) *************** *** 8220,8225 **** --- 8110,8116 ---- (gnus-summary-set-saved-mark article)))) (gnus-kill-buffer save-buffer) (gnus-summary-position-point) + (gnus-set-mode-line 'summary) n)) (defun gnus-summary-pipe-output (&optional arg) *** pub/rgnus/lisp/gnus-undo.el Fri Nov 22 05:14:19 1996 --- rgnus/lisp/gnus-undo.el Fri Jan 3 17:29:56 1997 *************** *** 71,82 **** "\M-\C-_" gnus-undo)) (defun gnus-undo-make-menu-bar () ! (unless (boundp 'gnus-undo-menu) ! (easy-menu-define ! gnus-undo-menu gnus-undo-mode-map "" ! '("Undo" ! ("Undo" ! ["Undo" gnus-undo gnus-undo-actions]))))) (defun gnus-undo-mode (&optional arg) "Minor mode for providing `undo' in Gnus buffers. --- 71,80 ---- "\M-\C-_" gnus-undo)) (defun gnus-undo-make-menu-bar () ! (when nil ! (define-key-after (current-local-map) [menu-bar file gnus-undo] ! (cons "Undo" 'gnus-undo-actions) ! [menu-bar file whatever]))) (defun gnus-undo-mode (&optional arg) "Minor mode for providing `undo' in Gnus buffers. *** pub/rgnus/lisp/gnus-util.el Fri Dec 13 05:30:20 1996 --- rgnus/lisp/gnus-util.el Fri Jan 3 12:13:01 1997 *************** *** 482,487 **** --- 482,488 ---- (defun gnus-read-event-char () "Get the next event." (let ((event (read-event))) + ;; should be gnus-characterp, but this can't be called in XEmacs anyway (cons (and (numberp event) event) event))) (defun gnus-sortable-date (date) *** pub/rgnus/lisp/gnus-win.el Thu Nov 14 20:43:22 1996 --- rgnus/lisp/gnus-win.el Fri Jan 3 18:20:40 1997 *************** *** 65,71 **** (if gnus-carpal '(summary-carpal 4)))) (article (cond ! ((and gnus-use-picons (not (eq gnus-picons-display-where 'article))) '(frame 1.0 (vertical 1.0 (summary 0.25 point) --- 65,72 ---- (if gnus-carpal '(summary-carpal 4)))) (article (cond ! ((and gnus-use-picons ! (eq gnus-picons-display-where 'picons)) '(frame 1.0 (vertical 1.0 (summary 0.25 point) *** pub/rgnus/lisp/gnus-xmas.el Sat Nov 23 21:10:42 1996 --- rgnus/lisp/gnus-xmas.el Sat Jan 4 08:56:24 1997 *************** *** 381,386 **** --- 381,387 ---- (unless (face-differs-from-default-p 'underline) (funcall (intern "set-face-underline-p") 'underline t)) + (fset 'gnus-characterp 'characterp) (fset 'gnus-make-overlay 'make-extent) (fset 'gnus-overlay-put 'set-extent-property) (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) *************** *** 720,727 **** (setq beg (point)) (forward-char) (if hide ! (article-hide-text beg (point) gnus-hidden-properties) ! (article-unhide-text beg (point))) (setq beg (point))) (save-window-excursion (select-window (get-buffer-window (current-buffer))) --- 721,728 ---- (setq beg (point)) (forward-char) (if hide ! (gnus-article-hide-text beg (point) gnus-hidden-properties) ! (gnus-article-unhide-text beg (point))) (setq beg (point))) (save-window-excursion (select-window (get-buffer-window (current-buffer))) *** pub/rgnus/lisp/gnus.el Fri Dec 13 05:12:05 1996 --- rgnus/lisp/gnus.el Sat Jan 4 10:43:11 1997 *************** *** 42,48 **** "Score and kill file handling." :group 'gnus ) ! (defconst gnus-version-number "0.76" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) --- 42,48 ---- "Score and kill file handling." :group 'gnus ) ! (defconst gnus-version-number "0.77" "Version number for this version of Gnus.") (defconst gnus-version (format "Red Gnus v%s" gnus-version-number) *************** *** 80,85 **** --- 80,86 ---- (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) (defalias 'gnus-mode-line-buffer-identification 'identity) + (defalias 'gnus-characterp 'numberp) (defalias 'gnus-key-press-event-p 'numberp)) ;; The XEmacs people think this is evil, so it must go. *************** *** 123,135 **** ;;; Internal variables (defvar gnus-group-buffer "*Group*") (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) - ;;; Splash screen. - (defface gnus-splash-face '((((class color) (background dark)) --- 124,445 ---- ;;; Internal variables + ;; We define these group faces here to avoid the display + ;; update forced when creating new faces. + + (defface gnus-group-news-1-face + '((((class color) + (background dark)) + (:foreground "PaleTurquoise" :bold t)) + (((class color) + (background light)) + (:foreground "ForestGreen" :bold t)) + (t + ())) + "Level 1 newsgroup face.") + + (defface gnus-group-news-1-empty-face + '((((class color) + (background dark)) + (:foreground "PaleTurquoise")) + (((class color) + (background light)) + (:foreground "ForestGreen")) + (t + ())) + "Level 1 empty newsgroup face.") + + (defface gnus-group-news-2-face + '((((class color) + (background dark)) + (:foreground "turquoise" :bold t)) + (((class color) + (background light)) + (:foreground "CadetBlue4" :bold t)) + (t + ())) + "Level 2 newsgroup face.") + + (defface gnus-group-news-2-empty-face + '((((class color) + (background dark)) + (:foreground "turquoise")) + (((class color) + (background light)) + (:foreground "CadetBlue4")) + (t + ())) + "Level 2 empty newsgroup face.") + + (defface gnus-group-news-3-face + '((((class color) + (background dark)) + (:bold t)) + (((class color) + (background light)) + (:bold t)) + (t + ())) + "Level 3 newsgroup face.") + + (defface gnus-group-news-3-empty-face + '((((class color) + (background dark)) + ()) + (((class color) + (background light)) + ()) + (t + ())) + "Level 3 empty newsgroup face.") + + (defface gnus-group-news-low-face + '((((class color) + (background dark)) + (:foreground "DarkTurquoise" :bold t)) + (((class color) + (background light)) + (:foreground "DarkGreen" :bold t)) + (t + ())) + "Low level newsgroup face.") + + (defface gnus-group-news-low-empty-face + '((((class color) + (background dark)) + (:foreground "DarkTurquoise")) + (((class color) + (background light)) + (:foreground "DarkGreen")) + (t + ())) + "Low level empty newsgroup face.") + + (defface gnus-group-mail-1-face + '((((class color) + (background dark)) + (:foreground "aquamarine1" :bold t)) + (((class color) + (background light)) + (:foreground "DeepPink3" :bold t)) + (t + (:bold t))) + "Level 1 mailgroup face.") + + (defface gnus-group-mail-1-empty-face + '((((class color) + (background dark)) + (:foreground "aquamarine1")) + (((class color) + (background light)) + (:foreground "DeepPink3")) + (t + (:italic t :bold t))) + "Level 1 empty mailgroup face.") + + (defface gnus-group-mail-2-face + '((((class color) + (background dark)) + (:foreground "aquamarine2" :bold t)) + (((class color) + (background light)) + (:foreground "HotPink3" :bold t)) + (t + (:bold t))) + "Level 2 mailgroup face.") + + (defface gnus-group-mail-2-empty-face + '((((class color) + (background dark)) + (:foreground "aquamarine2")) + (((class color) + (background light)) + (:foreground "HotPink3")) + (t + (:bold t))) + "Level 2 empty mailgroup face.") + + (defface gnus-group-mail-3-face + '((((class color) + (background dark)) + (:foreground "aquamarine3" :bold t)) + (((class color) + (background light)) + (:foreground "magenta4" :bold t)) + (t + (:bold t))) + "Level 3 mailgroup face.") + + (defface gnus-group-mail-3-empty-face + '((((class color) + (background dark)) + (:foreground "aquamarine3")) + (((class color) + (background light)) + (:foreground "magenta4")) + (t + ())) + "Level 3 empty mailgroup face.") + + (defface gnus-group-mail-low-face + '((((class color) + (background dark)) + (:foreground "aquamarine4" :bold t)) + (((class color) + (background light)) + (:foreground "DeepPink4" :bold t)) + (t + (:bold t))) + "Low level mailgroup face.") + + (defface gnus-group-mail-low-empty-face + '((((class color) + (background dark)) + (:foreground "aquamarine4")) + (((class color) + (background light)) + (:foreground "DeepPink4")) + (t + (:bold t))) + "Low level empty mailgroup face.") + + ;; Summary mode faces. + + (defface gnus-summary-selected-face '((t + (:underline t))) + "Face used for selected articles.") + + (defface gnus-summary-cancelled-face + '((((class color)) + (:foreground "yellow" :background "black"))) + "Face used for cancelled articles.") + + (defface gnus-summary-high-ticked-face + '((((class color) + (background dark)) + (:foreground "pink" :bold t)) + (((class color) + (background light)) + (:foreground "firebrick" :bold t)) + (t + (:bold t))) + "Face used for high interest ticked articles.") + + (defface gnus-summary-low-ticked-face + '((((class color) + (background dark)) + (:foreground "pink" :italic t)) + (((class color) + (background light)) + (:foreground "firebrick" :italic t)) + (t + (:italic t))) + "Face used for low interest ticked articles.") + + (defface gnus-summary-normal-ticked-face + '((((class color) + (background dark)) + (:foreground "pink")) + (((class color) + (background light)) + (:foreground "firebrick")) + (t + ())) + "Face used for normal interest ticked articles.") + + (defface gnus-summary-high-ancient-face + '((((class color) + (background dark)) + (:foreground "SkyBlue" :bold t)) + (((class color) + (background light)) + (:foreground "RoyalBlue" :bold t)) + (t + (:bold t))) + "Face used for high interest ancient articles.") + + (defface gnus-summary-low-ancient-face + '((((class color) + (background dark)) + (:foreground "SkyBlue" :italic t)) + (((class color) + (background light)) + (:foreground "RoyalBlue" :italic t)) + (t + (:italic t))) + "Face used for low interest ancient articles.") + + (defface gnus-summary-normal-ancient-face + '((((class color) + (background dark)) + (:foreground "SkyBlue")) + (((class color) + (background light)) + (:foreground "RoyalBlue")) + (t + ())) + "Face used for normal interest ancient articles.") + + (defface gnus-summary-high-unread-face + '((t + (:bold t))) + "Face used for high interest unread articles.") + + (defface gnus-summary-low-unread-face + '((t + (:italic t))) + "Face used for low interest unread articles.") + + (defface gnus-summary-normal-unread-face + '((t + ())) + "Face used for normal interest unread articles.") + + (defface gnus-summary-high-read-face + '((((class color) + (background dark)) + (:foreground "PaleGreen" + :bold t)) + (((class color) + (background light)) + (:foreground "DarkGreen" + :bold t)) + (t + (:bold t))) + "Face used for high interest read articles.") + + (defface gnus-summary-low-read-face + '((((class color) + (background dark)) + (:foreground "PaleGreen" + :italic t)) + (((class color) + (background light)) + (:foreground "DarkGreen" + :italic t)) + (t + (:italic t))) + "Face used for low interest read articles.") + + (defface gnus-summary-normal-read-face + '((((class color) + (background dark)) + (:foreground "PaleGreen")) + (((class color) + (background light)) + (:foreground "DarkGreen")) + (t + ())) + "Face used for normal interest read articles.") + + + ;;; Splash screen. + (defvar gnus-group-buffer "*Group*") (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) (defface gnus-splash-face '((((class color) (background dark)) *************** *** 1154,1162 **** gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed ! gnus-decode-rfc1522 gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article ! gnus-article-edit-done) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter) --- 1464,1472 ---- gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed ! gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article ! gnus-article-edit-done gnus-decode-rfc1522) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 gnus-dribble-enter) *************** *** 1171,1177 **** ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next gnus-async-prefetch-article gnus-async-prefetch-remove-group gnus-async-halt-prefetch) - ("article" article-decode-rfc1522) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm)))) --- 1481,1486 ---- *** pub/rgnus/lisp/message.el Thu Dec 5 19:57:06 1996 --- rgnus/lisp/message.el Fri Jan 3 18:12:59 1997 *************** *** 970,975 **** --- 970,977 ---- (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) (define-key message-mode-map "\C-c\C-d" 'message-dont-send) + (define-key message-mode-map "\C-c\C-e" 'message-elide-region) + (define-key message-mode-map "\t" 'message-tab)) (easy-menu-define *************** *** 980,986 **** ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] ! ["Caesar (rot13) Region" message-caesar-region t] ["Rename buffer" message-rename-buffer t] ["Spellcheck" ispell-message t] "----" --- 982,989 ---- ["Fill Yanked Message" message-fill-yanked-message t] ["Insert Signature" message-insert-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] ! ["Caesar (rot13) Region" message-caesar-region mark-active] ! ["Elide Region" message-elide-region mark-active] ["Rename buffer" message-rename-buffer t] ["Spellcheck" ispell-message t] "----" *************** *** 1027,1032 **** --- 1030,1036 ---- C-c C-w message-insert-signature (insert `message-signature-file' file). C-c C-y message-yank-original (insert current message, if any). C-c C-q message-fill-yanked-message (fill what was yanked). + C-c C-e message-elide-region (elide the text between point and mark). C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) *************** *** 1228,1233 **** --- 1232,1247 ---- (insert signature)) (goto-char (point-max)) (or (bolp) (insert "\n"))))) + + (defun message-elide-region (b e) + "Elide the text between point and mark. + An ellipsis (\"[...]\") will be inserted where the text was + killed." + (interactive "r") + (kill-region b e) + (unless (bolp) + (insert "\n")) + (insert "\n[...]\n\n")) (defvar message-caesar-translation-table nil) *** pub/rgnus/lisp/nnmail.el Mon Dec 16 14:25:49 1996 --- rgnus/lisp/nnmail.el Fri Jan 3 18:51:37 1997 *************** *** 1047,1053 **** "Remove excessive whitespace from all headers." (goto-char (point-min)) (while (re-search-forward "^\\([^ :]+: \\) +" nil t) ! (replace-match "\\1" t t))) (defun nnmail-remove-list-identifiers () "Remove list identifiers from Subject headers." --- 1047,1053 ---- "Remove excessive whitespace from all headers." (goto-char (point-min)) (while (re-search-forward "^\\([^ :]+: \\) +" nil t) ! (replace-match "\\1" t))) (defun nnmail-remove-list-identifiers () "Remove list identifiers from Subject headers." *** pub/rgnus/lisp/nnml.el Thu Dec 5 19:38:03 1996 --- rgnus/lisp/nnml.el Thu Jan 2 16:21:02 1997 *************** *** 250,256 **** (save-excursion (nnmail-find-file nnml-newsgroups-file))) ! (deffoo nnml-request-expire-articles (articles newsgroup &optional server force) (nnml-possibly-change-directory newsgroup server) (let* ((active-articles (nnheader-directory-articles nnml-current-directory)) --- 250,257 ---- (save-excursion (nnmail-find-file nnml-newsgroups-file))) ! (deffoo nnml-request-expire-articles (articles newsgroup ! &optional server force) (nnml-possibly-change-directory newsgroup server) (let* ((active-articles (nnheader-directory-articles nnml-current-directory)) *** pub/rgnus/lisp/pop3.el Sun Sep 8 12:09:48 1996 --- rgnus/lisp/pop3.el Fri Jan 3 18:58:53 1997 *************** *** 4,10 **** ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 ! ;; Version: 1.2 ;; This file is part of GNU Emacs. --- 4,10 ---- ;; Author: Richard L. Pieri ;; Keywords: mail, pop3 ! ;; Version: 1.3 ;; This file is part of GNU Emacs. *************** *** 79,85 **** (while (<= n message-count) (message (format "Retrieving message %d of %d from %s..." n message-count pop3-mailhost)) - (sit-for 0) (pop3-retr process n crashbuf) (save-excursion (set-buffer crashbuf) --- 79,84 ---- *************** *** 89,95 **** (pop3-quit process) (kill-buffer crashbuf) ) - (sit-for 0) ) (defun pop3-open-server (mailhost port) --- 88,93 ---- *************** *** 120,135 **** (insert output))) (defun pop3-send-command (process command) ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! ;; (if (= (aref command 0) ?P) ! ;; (insert "PASS \r\n") ! ;; (insert command "\r\n")) ! (setq pop3-read-point (point)) ! (goto-char (point-max)) ! (process-send-string process command) ! (process-send-string process "\r\n") ! ) (defun pop3-read-response (process &optional return) "Read the response from the server. --- 118,133 ---- (insert output))) (defun pop3-send-command (process command) ! (set-buffer (process-buffer process)) ! (goto-char (point-max)) ! ;; (if (= (aref command 0) ?P) ! ;; (insert "PASS \r\n") ! ;; (insert command "\r\n")) ! (setq pop3-read-point (point)) ! (goto-char (point-max)) ! (process-send-string process command) ! (process-send-string process "\r\n") ! ) (defun pop3-read-response (process &optional return) "Read the response from the server. *************** *** 253,261 **** (pop3-quit process))))) )) - (eval-and-compile - (if (not (fboundp 'md5)) (autoload 'md5 "md5"))) - (defun pop3-apop (process user) "Send alternate authentication information to the server." (if (not (fboundp 'md5)) (autoload 'md5 "md5")) --- 251,256 ---- *************** *** 296,301 **** --- 291,303 ---- (set-buffer (process-buffer process)) (while (not (re-search-forward "^\\.\r\n" nil t)) (accept-process-output process) + ;; bill@att.com ... to save wear and tear on the heap + (if (> (buffer-size) 20000) (sleep-for 1)) + (if (> (buffer-size) 50000) (sleep-for 1)) + (if (> (buffer-size) 100000) (sleep-for 1)) + (if (> (buffer-size) 200000) (sleep-for 1)) + (if (> (buffer-size) 500000) (sleep-for 1)) + ;; bill@att.com (goto-char start)) (setq pop3-read-point (point-marker)) (goto-char (match-beginning 0)) *** pub/rgnus/lisp/widget-edit.el Mon Dec 9 02:38:28 1996 --- rgnus/lisp/widget-edit.el Fri Jan 3 19:13:37 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.12 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: extensions ! ;; Version: 1.15 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *************** *** 77,83 **** :prefix "widget-" :group 'emacs) ! (defface widget-documentation-face '((t ())) "Face used for documentation text." :group 'widgets) --- 77,89 ---- :prefix "widget-" :group 'emacs) ! (defface widget-documentation-face '((((class color) ! (background dark)) ! (:foreground "lime green")) ! (((class color) ! (background light)) ! (:foreground "dark green")) ! (t nil)) "Face used for documentation text." :group 'widgets) *************** *** 90,101 **** :type 'face :group 'widgets) ! (defface widget-field-face '((((type x) ! (class grayscale color) (background light)) (:background "light gray")) ! (((type x) ! (class grayscale color) (background dark)) (:background "dark gray")) (t --- 96,105 ---- :type 'face :group 'widgets) ! (defface widget-field-face '((((class grayscale color) (background light)) (:background "light gray")) ! (((class grayscale color) (background dark)) (:background "dark gray")) (t *************** *** 106,111 **** --- 110,116 ---- (defcustom widget-menu-max-size 40 "Largest number of items allowed in a popup-menu. Larger menus are read through the minibuffer." + :group 'widgets :type 'integer) ;;; Utility functions. *************** *** 468,477 **** (call-interactively (lookup-key widget-global-map (this-command-keys)))))) ! (defun widget-forward (arg) ! "Move point to the next field or button. ! With optional ARG, move across that many fields." ! (interactive "p") (while (> arg 0) (setq arg (1- arg)) (let ((next (cond ((get-text-property (point) 'button) --- 473,481 ---- (call-interactively (lookup-key widget-global-map (this-command-keys)))))) ! (defun widget-move (arg) ! "Move point to the ARG next field or button. ! ARG may be negative to move backward." (while (> arg 0) (setq arg (1- arg)) (let ((next (cond ((get-text-property (point) 'button) *************** *** 533,545 **** (goto-char (max button field))) (button (goto-char button)) (field (goto-char field))))) ! (widget-echo-help (point))) (defun widget-backward (arg) "Move point to the previous field or button. With optional ARG, move across that many fields." (interactive "p") ! (widget-forward (- arg))) ;;; Setting up the buffer. --- 537,558 ---- (goto-char (max button field))) (button (goto-char button)) (field (goto-char field))))) ! (widget-echo-help (point)) ! (run-hooks 'widget-move-hook)) ! ! (defun widget-forward (arg) ! "Move point to the next field or button. ! With optional ARG, move across that many fields." ! (interactive "p") ! (run-hooks 'widget-forward-hook) ! (widget-move arg)) (defun widget-backward (arg) "Move point to the previous field or button. With optional ARG, move across that many fields." (interactive "p") ! (run-hooks 'widget-backward-hook) ! (widget-move (- arg))) ;;; Setting up the buffer. *************** *** 833,839 **** :format "%t\n") (defun widget-item-convert-widget (widget) ! ;; Initialize :value and :tag from :args in WIDGET. (let ((args (widget-get widget :args))) (when args (widget-put widget :value (widget-apply widget --- 846,852 ---- :format "%t\n") (defun widget-item-convert-widget (widget) ! ;; Initialize :value from :args in WIDGET. (let ((args (widget-get widget :args))) (when args (widget-put widget :value (widget-apply widget *** pub/rgnus/lisp/widget.el Mon Dec 9 02:38:26 1996 --- rgnus/lisp/widget.el Fri Jan 3 19:13:35 1997 *************** *** 4,10 **** ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia ! ;; Version: 1.12 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: --- 4,10 ---- ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia ! ;; Version: 1.15 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: *** pub/rgnus/lisp/ChangeLog Mon Dec 16 20:10:50 1996 --- rgnus/lisp/ChangeLog Sat Jan 4 10:31:04 1997 *************** *** 1,3 **** --- 1,132 ---- + Sat Jan 4 08:35:06 1997 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-start): Don't require gnus-sum. + + * gnus-art.el: All article functions moved here. + + * article.el: Elided. + + * gnus-async.el (gnus-async-prefetched-article-entry): Check for + empty articles. + + * gnus-art.el (gnus-read-save-file-name): Expand file name in + article save dir. + + Fri Jan 3 21:22:21 1997 Paul Stodghill + + * gnus-demon.el (gnus-demon): Use `gnus-demon-idle-time'. + + Tue Dec 31 10:38:43 1996 + + * pop3.el: version 1.3 + + * pop3.el: (pop3-retr): added bill@attmail.com's big buffer sleeps + to save wear and tear on he heap. + + Thu Aug 01 11:53:48 1996 + + * pop3.el: version 1.2 + + * pop3.el: (pop3-apop): minor changes to support XEmacs built-in + md5, or William Perry's modified md5.el. + + * pop3.el: (pop3-movemail): changed to use + pop3-authentication-scheme instead of pop3-use-apop. + + * pop3.el: pop3-use-appop: transformed into + pop3-authentication-scheme. + + * pop3.el: version 1.1 + + * pop3.el: (pop3-apop): new function. Send alternate + authentication information to the server. Requires md5.el. + + * pop3.el: (pop3-open-server): set pop3-timestamp if server + returns one. + + * pop3.el: (pop3-movemail): use APOP authentication if + pop3-use-apop non-nil. + + * pop3.el: pop3-timestamp: added variable + + * pop3.el: pop3-use-apop: added variable + + Fri Jan 3 18:52:23 1997 Wesley Hardaker + + * gnus-group.el (gnus-group-get-new-news): Pass the ARG on to the + listing function. + + Fri Jan 3 18:32:24 1997 Lars Magne Ingebrigtsen + + * article.el (article-hide-boring-headers): Respect + gnus-show-all-headers. + + * gnus-sum.el (gnus-summary-save-article): Update the mode line. + + Fri Jan 3 18:30:50 1997 Erik Toubro Nielsen + + * nnmail.el (nnmail-remove-leading-whitespace): Replacing should + be non-literal. + + Fri Jan 3 18:18:30 1997 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-expire-articles-now): Use + "yes-or-no". + (gnus-summary-delete-article): Ditto. + + Fri Jan 3 18:16:27 1997 Peter Skov Knudsen + + * gnus-win.el (gnus-buffer-configuration): Don't create picons + frame unless needed. + + Fri Jan 3 17:21:30 1997 Lars Magne Ingebrigtsen + + * message.el (message-elide-region): New command and keystroke. + + * gnus-salt.el (gnus-generate-vertical-tree): Check whether we can + go backwards. + + * gnus-group.el (gnus-group-catchup-current): Prompt better. + + * gnus-undo.el (gnus-undo-make-menu-bar): Nonsense. + + Fri Jan 3 16:52:22 1997 Rajappa Iyer + + * gnus-salt.el (gnus-pick-start-reading): Possibly catch up all + unpicked articles. + + Fri Jan 3 12:12:22 1997 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers-xover): Try to get the + few last headers using HEAD in any case to work around a bug in + inn. + + * gnus-xmas.el (gnus-xmas-define): Redefined. + + * gnus.el (gnus-characterp): Made into func. + + Thu Jan 2 16:21:47 1997 Sudish Joseph + + * gnus-util.el (gnus-characterp): New function. + + Wed Dec 18 18:15:39 1996 Jan Vroonhof + + * gnus-start.el (gnus-dribble-enter): Make sure we write at the + end of the dribble file + + Thu Jan 2 16:01:58 1997 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-children): Make NoCeM'ed + articles read. + + Tue Dec 17 20:24:40 1996 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-save-newsrc): Respect the prefix. + + Mon Dec 16 23:47:30 1996 Lars Magne Ingebrigtsen + + * gnus.el: Red Gnus v0.76 is released. + Mon Dec 16 14:33:58 1996 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-bug): Insert nntp server type. *** pub/rgnus/texi/custom.texi Mon Dec 9 02:38:58 1996 --- rgnus/texi/custom.texi Fri Jan 3 19:14:09 1997 *************** *** 13,28 **** @comment node-name, next, previous, up @top The Customization Library ! Version: 1.12 @menu * Introduction:: * User Commands:: * The Customization Buffer:: ! * Declaring Groups:: ! * Declaring Variables:: ! * Declaring Faces:: ! * Utilities:: * The Init File:: * Wishlist:: @end menu --- 13,26 ---- @comment node-name, next, previous, up @top The Customization Library ! Version: 1.15 @menu * Introduction:: * User Commands:: * The Customization Buffer:: ! * Declarations:: ! * Utilities:: * The Init File:: * Wishlist:: @end menu *************** *** 38,45 **** @table @dfn @item factory setting The value specified by the programmer. ! @item default value ! The value specified by the user as the default for this variable. This overwrites the factory setting when starting a new emacs. @item current value The value used by Emacs. This will not be remembered next time you --- 36,43 ---- @table @dfn @item factory setting The value specified by the programmer. ! @item saved value ! The value saved by the user as the default for this variable. This overwrites the factory setting when starting a new emacs. @item current value The value used by Emacs. This will not be remembered next time you *************** *** 80,86 **** groups that match a user specified regular expression. @end table ! @node The Customization Buffer, Declaring Groups, User Commands, Top @comment node-name, next, previous, up @section The Customization Buffer. --- 78,84 ---- groups that match a user specified regular expression. @end table ! @node The Customization Buffer, Declarations, User Commands, Top @comment node-name, next, previous, up @section The Customization Buffer. *************** *** 184,190 **** The state button. This look of this button will indicate the state of the option, e.g. whether it is currently hidden, or whether it has been modified or not. Activating the button will allow you to change the ! state, e.g. apply or reset the changes you have made. This is explained in detail in the following sections. @item [?] --- 182,188 ---- The state button. This look of this button will indicate the state of the option, e.g. whether it is currently hidden, or whether it has been modified or not. Activating the button will allow you to change the ! state, e.g. set or reset the changes you have made. This is explained in detail in the following sections. @item [?] *************** *** 213,241 **** @ref{User Interface,,, widget, The Widget Library}, where some examples of editing are discussed. ! You can either choose to edit the value directly, or edit the default ! value for that variable. The default value is a lisp expression that will be evaluated when you start emacs. The result of the evaluation will be used as the initial value for that variable. Editing the ! default value is for experts only, but if the current value of the variable is of a wrong type (i.e. a symbol where a string is expected), ! the `edit default' mode will always be selected. You can see what mode is currently selected by looking at the state ! button. If it uses parenthesises (like @samp{( )}) it is in `Edit ! default' mode, with square brackets (like @samp{[ ]}) it is normal edit ! mode. You can switch mode by activating the state button, and select ! either @samp{Edit} or @samp{Edit default} from the menu. You can change the state of the variable with the other menu items: @table @samp ! @item Apply When you have made your modifications in the buffer, you need to activate this item to make the modifications take effect. The modifications will be forgotten next time you run emacs. ! @item Set Default Unless you activate this item instead! This will mark the modification as permanent, i.e. the changes will be remembered in the next emacs session. --- 211,239 ---- @ref{User Interface,,, widget, The Widget Library}, where some examples of editing are discussed. ! You can either choose to edit the value directly, or edit the lisp ! value for that variable. The lisp value is a lisp expression that will be evaluated when you start emacs. The result of the evaluation will be used as the initial value for that variable. Editing the ! lisp value is for experts only, but if the current value of the variable is of a wrong type (i.e. a symbol where a string is expected), ! the `edit lisp' mode will always be selected. You can see what mode is currently selected by looking at the state ! button. If it uses parenthesises (like @samp{( )}) it is in edit lisp ! mode, with square brackets (like @samp{[ ]}) it is normal edit mode. ! You can switch mode by activating the state button, and select either ! @samp{Edit} or @samp{Edit lisp} from the menu. You can change the state of the variable with the other menu items: @table @samp ! @item Set When you have made your modifications in the buffer, you need to activate this item to make the modifications take effect. The modifications will be forgotten next time you run emacs. ! @item Save Unless you activate this item instead! This will mark the modification as permanent, i.e. the changes will be remembered in the next emacs session. *************** *** 244,252 **** If you have made some modifications and not yet applied them, you can undo the modification by activating this item. ! @item Reset to Default Activating this item will reset the value of the variable to the last ! value you marked as permanent with `Set Default'. @item Reset to Factory Settings Activating this item will undo all modifications you have made, and --- 242,250 ---- If you have made some modifications and not yet applied them, you can undo the modification by activating this item. ! @item Reset to Saved Activating this item will reset the value of the variable to the last ! value you marked as permanent with `Save'. @item Reset to Factory Settings Activating this item will undo all modifications you have made, and *************** *** 335,344 **** Since there is really no customization needed for the group itself, the menu items in the groups state button will affect all modified group ! members recursively. Thus, if you activate the @samp{Apply} menu item, all variables and faces that have been modified and belong to that group will be applied. For those members that themselves are groups, it will ! work as if you had activated the @samp{Apply} menu item on them as well. @node The State Button, The Customization Buttons, The Group Options, The Customization Buffer @comment node-name, next, previous, up --- 333,342 ---- Since there is really no customization needed for the group itself, the menu items in the groups state button will affect all modified group ! members recursively. Thus, if you activate the @samp{Set} menu item, all variables and faces that have been modified and belong to that group will be applied. For those members that themselves are groups, it will ! work as if you had activated the @samp{Set} menu item on them as well. @node The State Button, The Customization Buttons, The Group Options, The Customization Buffer @comment node-name, next, previous, up *************** *** 362,371 **** applied. @item + ! The current value of this option is different from the default value. @item ! ! The default value of this option is different from the factory setting. @item @@ The factory setting of this option is not known. This occurs when you --- 360,372 ---- applied. @item + ! The item has has been set by the user. ! ! @item : ! The current value of this option is different from the saved value. @item ! ! The saved value of this option is different from the factory setting. @item @@ The factory setting of this option is not known. This occurs when you *************** *** 388,424 **** The last part of the customization buffer looks like this: @example ! [Apply] [Set Default] [Reset] [Save] @end example ! Activating the @samp{[Apply]}, @samp{[Set Default]}, or @samp{[Reset]} button will affect all modified customization items that are visible in the buffer. ! Activating the @samp{[Save]} button will ensure that all customization ! options who are marked as persistent with @samp{Set default} (either ! with the button at the end of the buffer, or with any of the state ! button menus), will actually be saved in your initialization file. ! ! @node Declaring Groups, Declaring Variables, The Customization Buffer, Top @comment node-name, next, previous, up ! @section Declaring Groups ! ! Use @code{defgroup} to declare new customization groups. ! ! @defun defgroup symbol members doc [keyword value]... ! Declare @var{symbol} as a customization group containing @var{members}. ! @var{symbol} does not need to be quoted. ! ! @var{doc} is the group documentation. ! @var{members} should be an alist of the form ((@var{name} ! @var{widget})...) where @var{name} is a symbol and @var{widget} is a ! widget for editing that symbol. Useful widgets are ! @code{custom-variable} for editing variables, @code{custom-face} for ! editing faces, and @code{custom-group} for editing groups.@refill ! The following @var{keyword}'s are defined: @table @code @item :group --- 389,413 ---- The last part of the customization buffer looks like this: @example ! [Set] [Save] [Reset] @end example ! Activating the @samp{[Set]}, @samp{[Save]}, or @samp{[Reset]} button will affect all modified customization items that are visible in the buffer. ! @node Declarations, Utilities, The Customization Buffer, Top @comment node-name, next, previous, up ! @section Declarations ! @menu ! * Declaring Groups:: ! * Declaring Variables:: ! * Declaring Faces:: ! @end menu ! All the customization declarations can be changes by keyword arguments. ! Groups, variables, and faces all share these common keywords: @table @code @item :group *************** *** 435,450 **** should be a string which will be loaded with @code{load-library} unless present in @code{load-history}, or a symbol which will be loaded with @code{require}. @end table ! @end defun Internally, custom uses the symbol property @code{custom-group} to keep track of the group members, and @code{group-documentation} for the documentation string. ! @node Declaring Variables, Declaring Faces, Declaring Groups, Top @comment node-name, next, previous, up ! @section Declaring Variables Use @code{defcustom} to declare user editable variables. --- 424,469 ---- should be a string which will be loaded with @code{load-library} unless present in @code{load-history}, or a symbol which will be loaded with @code{require}. + @item :tag + @var{Value} should be a short string used for identifying the option in + customization menus and buffers. By default the tag will be + automatically created from the options name. @end table ! ! @node Declaring Groups, Declaring Variables, Declarations, Declarations ! @comment node-name, next, previous, up ! @subsection Declaring Groups ! ! Use @code{defgroup} to declare new customization groups. ! ! @defun defgroup symbol members doc [keyword value]... ! Declare @var{symbol} as a customization group containing @var{members}. ! @var{symbol} does not need to be quoted. ! ! @var{doc} is the group documentation. ! ! @var{members} should be an alist of the form ((@var{name} ! @var{widget})...) where @var{name} is a symbol and @var{widget} is a ! widget for editing that symbol. Useful widgets are ! @code{custom-variable} for editing variables, @code{custom-face} for ! editing faces, and @code{custom-group} for editing groups.@refill Internally, custom uses the symbol property @code{custom-group} to keep track of the group members, and @code{group-documentation} for the documentation string. ! The following additional @var{keyword}'s are defined: ! ! @table @code ! @item :prefix ! @var{value} should be a string. If the string is a prefix for the name ! of a member of the group, that prefix will be ignored when creating a ! tag for that member. ! @end table ! ! @node Declaring Variables, Declaring Faces, Declaring Groups, Declarations @comment node-name, next, previous, up ! @subsection Declaring Variables Use @code{defcustom} to declare user editable variables. *************** *** 455,461 **** @var{doc} is the variable documentation. ! The following @var{keyword}'s are defined: @table @code @item :type --- 474,480 ---- @var{doc} is the variable documentation. ! The following additional @var{keyword}'s are defined: @table @code @item :type *************** *** 463,482 **** @item :options @var{value} should be a list of possible members of the specified type. For hooks, this is a list of function names. - @item :group - @var{value} should be a customization group. - Add @var{symbol} to that group. - @item :link - @var{value} should be a widget type. - Add @var{value} to the extrenal links for this customization option. - Useful widget types include @code{custom-manual}, @code{info-link}, and - @code{url-link}. - @item :load - Add @var{value} to the files that should be loaded nefore displaying - this customization option. The value should be iether a string, which - should be a string which will be loaded with @code{load-library} unless - present in @code{load-history}, or a symbol which will be loaded with - @code{require}. @end table @xref{Sexp Types,,,widget,The Widget Library}, for information about --- 482,487 ---- *************** *** 485,493 **** Internally, custom uses the symbol property @code{custom-type} to keep track of the variables type, @code{factory-value} for the program ! specified default value, @code{default-value} for a user specified ! default value, and @code{variable-documentation} for the documentation ! string. Use @code{custom-add-option} to specify that a specific function is useful as an meber of a hook. --- 490,497 ---- Internally, custom uses the symbol property @code{custom-type} to keep track of the variables type, @code{factory-value} for the program ! specified default value, @code{saved-value} for a value saved by the ! user, and @code{variable-documentation} for the documentation string. Use @code{custom-add-option} to specify that a specific function is useful as an meber of a hook. *************** *** 499,507 **** member. For other types variables, the effect is undefined." @end defun ! @node Declaring Faces, Utilities, Declaring Variables, Top @comment node-name, next, previous, up ! @section Declaring Faces Faces are declared with @code{defface}. --- 503,511 ---- member. For other types variables, the effect is undefined." @end defun ! @node Declaring Faces, , Declaring Variables, Declarations @comment node-name, next, previous, up ! @subsection Declaring Faces Faces are declared with @code{defface}. *************** *** 516,540 **** @var{doc} is the face documentation. - The following @var{keyword}'s are defined: - - @table @code - @item :group - @var{value} should be a customization group. - Add @var{symbol} to that group. - @item :link - @var{value} should be a widget type. - Add @var{value} to the extrenal links for this customization option. - Useful widget types include @code{custom-manual}, @code{info-link}, and - @code{url-link}. - @item :load - Add @var{value} to the files that should be loaded nefore displaying - this customization option. The value should be iether a string, which - should be a string which will be loaded with @code{load-library} unless - present in @code{load-history}, or a symbol which will be loaded with - @code{require}. - @end table - @var{spec} should be an alist of the form @samp{((@var{display} @var{atts})...)}. @var{atts} is a list of face attributes and their values. The possible --- 520,525 ---- *************** *** 566,578 **** @end table Internally, custom uses the symbol property @code{factory-face} for the ! program specified default face properties, @code{default-face} for a ! user specified default properties, and @code{face-documentation} for the documentation string.@refill @end defun ! @node Utilities, The Init File, Declaring Faces, Top @comment node-name, next, previous, up @section Utilities --- 551,563 ---- @end table Internally, custom uses the symbol property @code{factory-face} for the ! program specified default face properties, @code{saved-face} for ! properties saved by the user, and @code{face-documentation} for the documentation string.@refill @end defun ! @node Utilities, The Init File, Declarations, Top @comment node-name, next, previous, up @section Utilities *************** *** 595,600 **** --- 580,592 ---- @defun custom-add-load symbol load To the custom option @var{symbol} add the dependency @var{load}. @var{load} should be either a library file name, or a feature name. + @end defun + + @defun custom-menu-create symbol &optional name + Create menu for customization group @var{symbol}. + If optional @var{name} is given, use that as the name of the menu. + Otherwise make up a name from @var{symbol}. + The menu is in a format applicable to @code{easy-menu-define}. @end defun @node The Init File, Wishlist, Utilities, Top *** pub/rgnus/texi/gnus.texi Mon Dec 16 23:44:51 1996 --- rgnus/texi/gnus.texi Sat Jan 4 10:46:22 1997 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Red Gnus 0.76 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Red Gnus 0.77 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 287,293 **** @tex @titlepage ! @title Red Gnus 0.76 Manual @author by Lars Magne Ingebrigtsen @page --- 287,293 ---- @tex @titlepage ! @title Red Gnus 0.77 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 323,329 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Red Gnus 0.76 @end ifinfo --- 323,329 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Red Gnus 0.77 @end ifinfo *************** *** 8691,8697 **** just before the splitting based on these headers is done. The hook is free to modify the buffer contents in any way it sees fit---the buffer is discarded after the splitting has been done, and no changes performed ! in the buffer will show up in any files. @code{article-decode-rfc1522} is one likely function to add to this hook. @vindex nnmail-pre-get-new-mail-hook --- 8691,8697 ---- just before the splitting based on these headers is done. The hook is free to modify the buffer contents in any way it sees fit---the buffer is discarded after the splitting has been done, and no changes performed ! in the buffer will show up in any files. @code{gnus-article-decode-rfc1522} is one likely function to add to this hook. @vindex nnmail-pre-get-new-mail-hook *************** *** 13764,13771 **** --- 13764,13773 ---- Ishikawa Ichiro, @c Ishikawa Francois Felix Ingrand, Lee Iverson, + Rajappa Iyer, Randell Jesup, Fred Johansen, + Peter Skov Knudsen, Shuhei Kobayashi, @c Kobayashi Thor Kristoffersen, Jens Lautenbacher, *************** *** 13780,13785 **** --- 13782,13788 ---- Richard Mlynarik, Lantz Moore, Morioka Tomohiko, @c Morioka + Erik Toubro Nielsen, Hrvoje Niksic, Andy Norman, C. R. Oldham, *************** *** 13801,13806 **** --- 13804,13810 ---- Michael Sperber, Richard Stallman, Greg Stark, + Paul Stodghill, Kurt Swanson, Samuel Tardieu, Teddy, *************** *** 15129,15137 **** A Gnus group info (@pxref{Group Info}) is handed to the backend for alterations. This comes in handy if the backend really carries all the information (as is the case with virtual an imap groups). This function ! may alter the info in any manner it sees fit, and should return the ! (altered) group info. This function may alter the group info ! destructively, so no copying is needed before boogeying. There should be no result data from this function. --- 15133,15140 ---- A Gnus group info (@pxref{Group Info}) is handed to the backend for alterations. This comes in handy if the backend really carries all the information (as is the case with virtual an imap groups). This function ! should destructively alter the info to suit its needs, and should return ! the (altered) group info. There should be no result data from this function. *** pub/rgnus/texi/message.texi Tue Nov 26 12:40:06 1996 --- rgnus/texi/message.texi Fri Jan 3 18:12:59 1997 *************** *** 497,502 **** --- 497,509 ---- rotate the visible portion of the buffer. A numerical prefix says how many places to rotate the text. The default is 13. + @item C-c C-e + @kindex C-c C-e + @findex message-elide-region + Elide the text between point and mark (@code{message-elide-region}). + The text is killed and an ellipsis (@samp{[...]}) will be inserted in + its place. + @item C-c C-t @kindex C-c C-t @findex message-insert-to *** pub/rgnus/texi/widget.texi Mon Dec 9 02:38:54 1996 --- rgnus/texi/widget.texi Fri Jan 3 19:14:07 1997 *************** *** 1,6 **** \input texinfo.tex ! @c $Id: widget.texi,v 1.40 1996/12/08 15:19:41 abraham Exp $ @c %**start of header @setfilename widget --- 1,6 ---- \input texinfo.tex ! @c $Id: widget.texi,v 1.43 1997/01/02 23:00:53 abraham Exp $ @c %**start of header @setfilename widget *************** *** 15,21 **** @comment node-name, next, previous, up @top The Emacs Widget Library ! Version: 1.12 @menu * Introduction:: --- 15,21 ---- @comment node-name, next, previous, up @top The Emacs Widget Library ! Version: 1.15 @menu * Introduction:: *** pub/rgnus/texi/ChangeLog Mon Dec 16 14:10:41 1996 --- rgnus/texi/ChangeLog Fri Jan 3 18:15:31 1997 *************** *** 1,3 **** --- 1,11 ---- + Fri Jan 3 18:13:02 1997 Lars Magne Ingebrigtsen + + * message.texi (Various Commands): Addition. + + Thu Jan 2 16:12:27 1997 Lars Magne Ingebrigtsen + + * gnus.texi (Optional Backend Functions): Fix. + Mon Dec 16 13:53:28 1996 Lars Magne Ingebrigtsen * gnus.texi (Exiting the Summary Buffer): Update.