*** pub/sgnus/lisp/custom.el Mon May 27 01:00:35 1996 --- sgnus/lisp/custom.el Wed May 29 06:30:31 1996 *************** *** 1,12 **** ;;; custom.el --- User friendly customization support. ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ! ;; ;; Author: Per Abrahamsen ;; Keywords: help ;; Version: 0.5 ;;; Commentary: ! ;; ;; WARNING: This package is still under construction and not all of ;; the features below are implemented. ;; --- 1,30 ---- ;;; custom.el --- User friendly customization support. ! ! ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. ! ;; Author: Per Abrahamsen ;; Keywords: help ;; Version: 0.5 + ;; 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: ! ;; WARNING: This package is still under construction and not all of ;; the features below are implemented. ;; *************** *** 15,21 **** ;; editing a text file in some arcane syntax is user hostile in the ;; extreme, and to most users emacs lisp definitely count as arcane. ;; ! ;; The intension is that authors of emacs lisp packages declare the ;; variables intended for user customization with `custom-declare'. ;; Custom can then automatically generate a customization buffer with ;; `custom-buffer-create' where the user can edit the package --- 33,39 ---- ;; editing a text file in some arcane syntax is user hostile in the ;; extreme, and to most users emacs lisp definitely count as arcane. ;; ! ;; The intent is that authors of emacs lisp packages declare the ;; variables intended for user customization with `custom-declare'. ;; Custom can then automatically generate a customization buffer with ;; `custom-buffer-create' where the user can edit the package *************** *** 46,63 **** ;; - Make it possible to declare default value and type for a single ;; variable, storing the data in a symbol property. ;; - Syntactic sugar for CUSTOM declarations. ! ;; - Use W3 for variable documenation. ;;; Code: ;;; Compatibility: (or (fboundp 'buffer-substring-no-properties) ;; Introduced in Emacs 19.29. (defun buffer-substring-no-properties (beg end) "Return the text from BEG to END, without text properties, as a string." (let ((string (buffer-substring beg end))) ! (custom-set-text-properties 0 (length string) nil string) string))) (or (fboundp 'add-to-list) --- 64,105 ---- ;; - Make it possible to declare default value and type for a single ;; variable, storing the data in a symbol property. ;; - Syntactic sugar for CUSTOM declarations. ! ;; - Use W3 for variable documentation. ;;; Code: ;;; Compatibility: + (defun custom-xmas-add-text-properties (start end props &optional object) + (add-text-properties start end props object) + (put-text-property start end 'start-open t object) + (put-text-property start end 'end-open t object)) + + (defun custom-xmas-put-text-property (start end prop value &optional object) + (put-text-property start end prop value object) + (put-text-property start end 'start-open t object) + (put-text-property start end 'end-open t object)) + + (defun custom-xmas-extent-start-open () + (map-extents (lambda (extent arg) + (set-extent-property extent 'start-open t)) + nil (point) (min (1+ (point)) (point-max)))) + + (if (string-match "XEmacs\\|Lucid" emacs-version) + (progn + (fset 'custom-add-text-properties 'custom-xmas-add-text-properties) + (fset 'custom-put-text-property 'custom-xmas-put-text-property) + (fset 'custom-extent-start-open 'custom-xmas-extent-start-open)) + (fset 'custom-add-text-properties 'add-text-properties) + (fset 'custom-put-text-property 'put-text-property) + (fset 'custom-extent-start-open 'ignore)) + (or (fboundp 'buffer-substring-no-properties) ;; Introduced in Emacs 19.29. (defun buffer-substring-no-properties (beg end) "Return the text from BEG to END, without text properties, as a string." (let ((string (buffer-substring beg end))) ! (set-text-properties 0 (length string) nil string) string))) (or (fboundp 'add-to-list) *************** *** 153,176 **** (and (fboundp 'set-face-underline-p) (funcall 'set-face-underline-p 'underline t)))) ! (defun custom-xmas-set-text-properties (start end props &optional buffer) ! "You should NEVER use this function. It is ideologically blasphemous. ! It is provided only to ease porting of broken FSF Emacs programs." ! (if (stringp buffer) ! nil ! (map-extents (lambda (extent ignored) ! (remove-text-properties ! start end ! (list (extent-property extent 'text-prop) nil) ! buffer)) ! buffer start end nil nil 'text-prop) ! (add-text-properties start end props buffer))) ! ! (if (string-match "XEmacs" emacs-version) ! (fset 'custom-set-text-properties 'gnus-xmas-set-text-properties) ! (fset 'custom-set-text-properties 'set-text-properties)) ! (or (fboundp 'event-point) ;; Missing in Emacs 19.29. (defun event-point (event) "Return the character position of the given mouse-motion, button-press, --- 195,212 ---- (and (fboundp 'set-face-underline-p) (funcall 'set-face-underline-p 'underline t)))) ! (or (fboundp 'set-text-properties) ! ;; Missing in XEmacs 19.12. ! (defun set-text-properties (start end props &optional buffer) ! (if (or (null buffer) (bufferp buffer)) ! (if props ! (while props ! (custom-put-text-property ! start end (car props) (nth 1 props) buffer) ! (setq props (nthcdr 2 props))) ! (remove-text-properties start end ()))))) ! (or (fboundp 'event-closest-point) ;; Missing in Emacs 19.29. (defun event-point (event) "Return the character position of the given mouse-motion, button-press, *************** *** 250,261 **** (> emacs-minor-version 28)))) (setq intangible 'intangible) (setq intangible 'intangible-if-it-had-been-working)) ! "The symbol making text intangible") (defconst rear-nonsticky (if (string-match "XEmacs" emacs-version) 'end-open 'rear-nonsticky) ! "The symbol making text proeprties non-sticky in the rear end.") (defconst front-sticky (if (string-match "XEmacs" emacs-version) 'front-closed --- 286,297 ---- (> emacs-minor-version 28)))) (setq intangible 'intangible) (setq intangible 'intangible-if-it-had-been-working)) ! "The symbol making text intangible.") (defconst rear-nonsticky (if (string-match "XEmacs" emacs-version) 'end-open 'rear-nonsticky) ! "The symbol making text properties non-sticky in the rear end.") (defconst front-sticky (if (string-match "XEmacs" emacs-version) 'front-closed *************** *** 347,353 **** (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." ! (put-text-property from to 'category category))) ;;; External Data: ;; --- 383,389 ---- (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." ! (custom-put-text-property from to 'category category))) ;;; External Data: ;; *************** *** 400,409 **** ;; The following functions are part of the public interface to the ;; CUSTOM datastructure. Each CUSTOM describes a group of variables, ;; a single variable, or a component of a structured variable. The ! ;; CUSTOM instances are part of two hiearachies, the first is the ;; `part-of' hierarchy in which each CUSTOM is a component of another ;; CUSTOM, except for the top level CUSTOM which is contained in ! ;; `custom-data'. The second hiearachy is a `is-a' type hierarchy ;; where each CUSTOM is a leaf in the hierarchy defined by the `type' ;; property and `custom-type-properties'. --- 436,445 ---- ;; The following functions are part of the public interface to the ;; CUSTOM datastructure. Each CUSTOM describes a group of variables, ;; a single variable, or a component of a structured variable. The ! ;; CUSTOM instances are part of two hierarchies, the first is the ;; `part-of' hierarchy in which each CUSTOM is a component of another ;; CUSTOM, except for the top level CUSTOM which is contained in ! ;; `custom-data'. The second hierarchy is a `is-a' type hierarchy ;; where each CUSTOM is a leaf in the hierarchy defined by the `type' ;; property and `custom-type-properties'. *************** *** 502,507 **** --- 538,554 ---- ((type . const) (tag . "Off") (default . nil)))) + (triggle (type . choice) + ;; On/Off/Default. + (data ((type . const) + (tag . "On ") + (default . t)) + ((type . const) + (tag . "Off") + (default . nil)) + ((type . const) + (tag . "Def") + (default . custom:asis)))) (choice (type . default) ;; See `custom-match'. (query . custom-choice-query) *************** *** 609,625 **** (type . string)) "\n" ((tag . "Bold") ! (default . nil) ! (type . toggle)) " " ((tag . "Italic") ! (default . nil) ! (type . toggle)) " " ((tag . "Underline") (hidden . t) ! (default . nil) ! (type . toggle))) (default . (custom-face-lookup "default" "default" "default" nil nil nil)) (type . list)) --- 656,672 ---- (type . string)) "\n" ((tag . "Bold") ! (default . custom:asis) ! (type . triggle)) " " ((tag . "Italic") ! (default . custom:asis) ! (type . triggle)) " " ((tag . "Underline") (hidden . t) ! (default . custom:asis) ! (type . triggle))) (default . (custom-face-lookup "default" "default" "default" nil nil nil)) (type . list)) *************** *** 710,715 **** --- 757,765 ---- (defconst custom-invalid '__invalid__ "Special value representing an invalid field.") + (defconst custom:asis 'custom:asis) + ;; Bad, ugly, and horrible kludge. + (defun custom-property (custom property) "Extract from CUSTOM property PROPERTY." (let ((entry (assq property custom))) *************** *** 735,741 **** (cdr entry))) (defun custom-property-set (custom property value) ! "Set CUSTOM PROPERY to VALUE by side effect. CUSTOM must have at least one property already." (let ((entry (assq property custom))) (if entry --- 785,791 ---- (cdr entry))) (defun custom-property-set (custom property value) ! "Set CUSTOM PROPERTY to VALUE by side effect. CUSTOM must have at least one property already." (let ((entry (assq property custom))) (if entry *************** *** 884,890 **** ;; FIELD datatype. The FIELD instance hold information about a ;; specific editing field in the customization buffer. ;; ! ;; Each FIELD can be seen as an instanciation of a CUSTOM. (defvar custom-field-last nil) ;; Last field containing point. --- 934,940 ---- ;; FIELD datatype. The FIELD instance hold information about a ;; specific editing field in the customization buffer. ;; ! ;; Each FIELD can be seen as an instantiation of a CUSTOM. (defvar custom-field-last nil) ;; Last field containing point. *************** *** 943,949 **** (defun custom-field-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE. ! If optional ORIGINAL is non-nil, concider VALUE for the original value." (let ((inhibit-point-motion-hooks t)) (funcall (custom-property (custom-field-custom field) 'accept) field value original))) --- 993,999 ---- (defun custom-field-accept (field value &optional original) "Store a new value into field FIELD, taking it from VALUE. ! If optional ORIGINAL is non-nil, consider VALUE for the original value." (let ((inhibit-point-motion-hooks t)) (funcall (custom-property (custom-field-custom field) 'accept) field value original))) *************** *** 1054,1059 **** --- 1104,1110 ---- (end (make-marker)) (data (vector repeat nil start end)) field) + (custom-extent-start-open) (insert-before-markers "\n") (backward-char 1) (set-marker start (point)) *************** *** 1106,1112 **** (cons (nreverse matches) values))) (defun custom-repeat-extract (custom field) ! "Extract list of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) --- 1157,1163 ---- (cons (nreverse matches) values))) (defun custom-repeat-extract (custom field) ! "Extract list of children's values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) *************** *** 1153,1159 **** (custom-default-quote custom value))) (defun custom-pair-extract (custom field) ! "Extract cons of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) --- 1204,1210 ---- (custom-default-quote custom value))) (defun custom-pair-extract (custom field) ! "Extract cons of children's values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) *************** *** 1174,1180 **** (custom-default-quote custom value))) (defun custom-list-extract (custom field) ! "Extract list of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) --- 1225,1231 ---- (custom-default-quote custom value))) (defun custom-list-extract (custom field) ! "Extract list of children's values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) *************** *** 1283,1289 **** (face-tag (custom-face-tag custom)) current) (if face-tag ! (put-text-property from (+ from (length (custom-tag custom))) 'face (funcall face-tag field value))) (if original (custom-field-original-set field value)) --- 1334,1340 ---- (face-tag (custom-face-tag custom)) current) (if face-tag ! (custom-put-text-property from (+ from (length (custom-tag custom))) 'face (funcall face-tag field value))) (if original (custom-field-original-set field value)) *************** *** 1369,1377 **** () (setq begin (point) found (custom-insert (custom-property custom 'none) nil)) ! (add-text-properties begin (point) ! (list rear-nonsticky t ! 'face custom-field-uninitialized-face))) (or original (custom-field-original-set found (custom-field-original field))) (custom-field-accept found value original) --- 1420,1429 ---- () (setq begin (point) found (custom-insert (custom-property custom 'none) nil)) ! (custom-add-text-properties ! begin (point) ! (list rear-nonsticky t ! 'face custom-field-uninitialized-face))) (or original (custom-field-original-set found (custom-field-original field))) (custom-field-accept found value original) *************** *** 1379,1390 **** (custom-field-move field from end)))) (defun custom-choice-extract (custom field) ! "Extract childs value." (let ((value (custom-field-value field))) (custom-field-extract (custom-field-custom value) value))) (defun custom-choice-validate (custom field) ! "Validate childs value." (let ((value (custom-field-value field)) (custom (custom-field-custom field))) (if (or (eq value custom-nil) --- 1431,1442 ---- (custom-field-move field from end)))) (defun custom-choice-extract (custom field) ! "Extract child's value." (let ((value (custom-field-value field))) (custom-field-extract (custom-field-custom value) value))) (defun custom-choice-validate (custom field) ! "Validate child's value." (let ((value (custom-field-value field)) (custom (custom-field-custom field))) (if (or (eq value custom-nil) *************** *** 1492,1499 **** (defun custom-face-hack (field value) "Face that should be used for highlighting FIELD containing VALUE." (let* ((custom (custom-field-custom field)) ! (face (eval (funcall (custom-property custom 'export) ! custom value)))) (if (custom-facep face) face nil))) (defun custom-const-insert (custom level) --- 1544,1551 ---- (defun custom-face-hack (field value) "Face that should be used for highlighting FIELD containing VALUE." (let* ((custom (custom-field-custom field)) ! (form (funcall (custom-property custom 'export) custom value)) ! (face (apply (car form) (cdr form)))) (if (custom-facep face) face nil))) (defun custom-const-insert (custom level) *************** *** 1502,1508 **** (face (custom-field-face field)) (from (point))) (custom-text-insert (custom-tag custom)) ! (add-text-properties from (point) (list 'face face rear-nonsticky t)) (custom-documentation-insert custom) --- 1554,1560 ---- (face (custom-field-face field)) (from (point))) (custom-text-insert (custom-tag custom)) ! (custom-add-text-properties from (point) (list 'face face rear-nonsticky t)) (custom-documentation-insert custom) *************** *** 1513,1519 **** "Update face of FIELD." (let ((from (custom-field-start field)) (custom (custom-field-custom field))) ! (put-text-property from (+ from (length (custom-tag custom))) 'face (custom-field-face field)))) (defun custom-const-valid (custom value) --- 1565,1571 ---- "Update face of FIELD." (let ((from (custom-field-start field)) (custom (custom-field-custom field))) ! (custom-put-text-property from (+ from (length (custom-tag custom))) 'face (custom-field-face field)))) (defun custom-const-valid (custom value) *************** *** 1672,1678 **** (cond ((eq value custom-nil) (cons start "Uninitialized field")) ((and (consp value) (eq (car value) custom-invalid)) ! (cons start "Unparseable field content")) ((custom-valid custom value) nil) (t --- 1724,1730 ---- (cond ((eq value custom-nil) (cons start "Uninitialized field")) ((and (consp value) (eq (car value) custom-invalid)) ! (cons start "Unparsable field content")) ((custom-valid custom value) nil) (t *************** *** 1802,1810 **** (let ((from (point))) (insert tag) (custom-category-set from (point) 'custom-button-properties) ! (put-text-property from (point) 'custom-tag field) (if data ! (add-text-properties from (point) (list 'custom-data data))))) (defun custom-documentation-insert (custom &rest ignore) "Insert documentation from CUSTOM in current buffer." --- 1854,1862 ---- (let ((from (point))) (insert tag) (custom-category-set from (point) 'custom-button-properties) ! (custom-put-text-property from (point) 'custom-tag field) (if data ! (custom-add-text-properties from (point) (list 'custom-data data))))) (defun custom-documentation-insert (custom &rest ignore) "Insert documentation from CUSTOM in current buffer." *************** *** 1823,1833 **** "Describe how to execute COMMAND." (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (custom-set-text-properties from (point) (list 'face custom-button-face mouse-face custom-mouse-face 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) --- 1875,1887 ---- "Describe how to execute COMMAND." (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (set-text-properties from (point) (list 'face custom-button-face mouse-face custom-mouse-face 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command ! 'start-open t ! 'end-open t)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) *************** *** 1836,1842 **** ;; The Customization major mode and interactive commands. (defvar custom-mode-map nil ! "Keymap for Custum Mode.") (if custom-mode-map nil (setq custom-mode-map (make-sparse-keymap)) --- 1890,1896 ---- ;; The Customization major mode and interactive commands. (defvar custom-mode-map nil ! "Keymap for Custom Mode.") (if custom-mode-map nil (setq custom-mode-map (make-sparse-keymap)) *************** *** 2149,2160 **** (insert-char (custom-padding custom) (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (custom-set-text-properties from (point) (list 'custom-field field 'custom-tag field 'face (custom-field-face field) ! front-sticky t)))) (defun custom-field-read (field) ;; Read the screen content of FIELD. --- 2203,2215 ---- (insert-char (custom-padding custom) (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (set-text-properties from (point) (list 'custom-field field 'custom-tag field 'face (custom-field-face field) ! 'start-open t ! 'end-open t)))) (defun custom-field-read (field) ;; Read the screen content of FIELD. *************** *** 2170,2176 **** ;; Deactivate FIELD. (let ((before-change-functions nil) (after-change-functions nil)) ! (put-text-property (custom-field-start field) (custom-field-end field) 'face (custom-field-face field)))) (defun custom-field-enter (field) --- 2225,2231 ---- ;; Deactivate FIELD. (let ((before-change-functions nil) (after-change-functions nil)) ! (custom-put-text-property (custom-field-start field) (custom-field-end field) 'face (custom-field-face field)))) (defun custom-field-enter (field) *************** *** 2188,2194 **** (setq pos (1- pos))) (if (< pos (point)) (goto-char pos)))) ! (put-text-property start end 'face custom-field-active-face))) (defun custom-field-resize (field) ;; Resize FIELD after change. --- 2243,2249 ---- (setq pos (1- pos))) (if (< pos (point)) (goto-char pos)))) ! (custom-put-text-property start end 'face custom-field-active-face))) (defun custom-field-resize (field) ;; Resize FIELD after change. *************** *** 2270,2276 **** (let ((field custom-field-was)) (custom-assert '(prog1 field (setq custom-field-was nil))) ;; Prevent mixing fields properties. ! (put-text-property begin end 'custom-field field) ;; Update the field after modification. (if (eq (custom-field-property begin) field) (let ((field-end (custom-field-end field))) --- 2325,2331 ---- (let ((field custom-field-was)) (custom-assert '(prog1 field (setq custom-field-was nil))) ;; Prevent mixing fields properties. ! (custom-put-text-property begin end 'custom-field field) ;; Update the field after modification. (if (eq (custom-field-property begin) field) (let ((field-end (custom-field-end field))) *** pub/sgnus/lisp/gnus-cite.el Mon May 27 01:00:35 1996 --- sgnus/lisp/gnus-cite.el Wed May 29 04:21:55 1996 *************** *** 117,125 **** ;;; Internal Variables: ! (defvar gnus-article-length nil) ! ;; Length of article last time we parsed it. ! ;; BUG! KLUDGE! UGLY! FIX ME! (defvar gnus-cite-prefix-alist nil) ;; Alist of citation prefixes. --- 117,123 ---- ;;; Internal Variables: ! (defvar gnus-cite-article nil) (defvar gnus-cite-prefix-alist nil) ;; Alist of citation prefixes. *************** *** 416,422 **** (defun gnus-cite-parse-maybe (&optional force) ;; Parse if the buffer has changes since last time. ! (if (eq gnus-article-length (- (point-max) (point-min))) () ;;Reset parser information. (setq gnus-cite-prefix-alist nil --- 414,420 ---- (defun gnus-cite-parse-maybe (&optional force) ;; Parse if the buffer has changes since last time. ! (if (equal gnus-cite-article gnus-article-current) () ;;Reset parser information. (setq gnus-cite-prefix-alist nil *************** *** 428,434 **** gnus-cite-parse-max-size (> (buffer-size) gnus-cite-parse-max-size)) () ! (setq gnus-article-length (- (point-max) (point-min))) (gnus-cite-parse)))) (defun gnus-cite-parse () --- 426,433 ---- gnus-cite-parse-max-size (> (buffer-size) gnus-cite-parse-max-size)) () ! (setq gnus-cite-article (cons (car gnus-article-current) ! (cdr gnus-article-current))) (gnus-cite-parse)))) (defun gnus-cite-parse () *** pub/sgnus/lisp/gnus-ems.el Mon May 27 01:00:35 1996 --- sgnus/lisp/gnus-ems.el Wed May 29 00:23:25 1996 *************** *** 41,46 **** --- 41,47 ---- (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) (defalias 'gnus-make-local-hook 'make-local-hook) + (defalias 'gnus-add-hook 'add-hook) (defalias 'gnus-character-to-event 'identity) (defalias 'gnus-add-text-properties 'add-text-properties) (defalias 'gnus-put-text-property 'put-text-property) *** pub/sgnus/lisp/gnus-msg.el Mon May 27 01:00:36 1996 --- sgnus/lisp/gnus-msg.el Wed May 29 00:23:25 1996 *************** *** 138,144 **** (defun gnus-inews-add-send-actions (winconf buffer article) (gnus-make-local-hook 'message-sent-hook) ! (add-hook 'message-sent-hook 'gnus-inews-do-gcc) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) --- 138,144 ---- (defun gnus-inews-add-send-actions (winconf buffer article) (gnus-make-local-hook 'message-sent-hook) ! (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) *** pub/sgnus/lisp/gnus-nocem.el Mon May 27 01:00:36 1996 --- sgnus/lisp/gnus-nocem.el Wed May 29 02:45:38 1996 *************** *** 48,53 **** --- 48,58 ---- (defvar gnus-nocem-expiry-wait 15 "*Number of days to keep NoCeM headers in the cache.") + (defvar gnus-nocem-verifyer 'mc-verify + "*Function called to verify that the NoCeM message is valid. + If the function in this variable isn't bound, the message will + be used unconditionally.") + ;;; Internal variables (defvar gnus-nocem-active nil) *************** *** 146,152 **** (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." ! t) (defun gnus-nocem-enter-article () "Enter the current article into the NoCeM cache." --- 151,160 ---- (defun gnus-nocem-verify-issuer (person) "Verify using PGP that the canceler is who she says she is." ! (if (fboundp gnus-nocem-verifyer) ! (funcall gnus-nocem-verifyer) ! ;; If we don't have MailCrypt, then we use the message anyway. ! t)) (defun gnus-nocem-enter-article () "Enter the current article into the NoCeM cache." *** pub/sgnus/lisp/gnus-salt.el Mon May 27 01:00:36 1996 --- sgnus/lisp/gnus-salt.el Wed May 29 00:23:25 1996 *************** *** 167,174 **** (gnus-binary-make-menu-bar)) (unless (assq 'gnus-binary-mode minor-mode-alist) (push '(gnus-binary-mode " Binary") minor-mode-alist)) ! (unless (assq 'gnus-topic-mode minor-mode-map-alist) ! (push (cons 'gnus-topic-mode gnus-binary-mode-map) minor-mode-map-alist)) (run-hooks 'gnus-binary-mode-hook)))) --- 167,174 ---- (gnus-binary-make-menu-bar)) (unless (assq 'gnus-binary-mode minor-mode-alist) (push '(gnus-binary-mode " Binary") minor-mode-alist)) ! (unless (assq 'gnus-binary-mode minor-mode-map-alist) ! (push (cons 'gnus-binary-mode gnus-binary-mode-map) minor-mode-map-alist)) (run-hooks 'gnus-binary-mode-hook)))) *** pub/sgnus/lisp/gnus-score.el Mon May 27 01:00:37 1996 --- sgnus/lisp/gnus-score.el Wed May 29 00:23:27 1996 *************** *** 1528,1534 **** (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores thread))))) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) --- 1528,1535 ---- (setq art (car arts) arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores thread)))) ! (end-of-line)) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) *** pub/sgnus/lisp/gnus-xmas.el Mon May 27 01:00:40 1996 --- sgnus/lisp/gnus-xmas.el Wed May 29 02:17:37 1996 *************** *** 35,42 **** If this variable is nil, Gnus will try to locate the directory automatically.") ! (defvar gnus-xmas-logo-colors '("#bf9900" "#ffcc00") ! "Colors user for the Gnus logo.") ;;; Internal variables. --- 35,61 ---- If this variable is nil, Gnus will try to locate the directory automatically.") ! (defvar gnus-xmas-logo-color-alist ! '((flame "##cc3300" "##ff2200") ! (pine "##c0cc93" "##f8ffb8") ! (moss "##a1cc93" "##d2ffb8") ! (irish "##04cc90" "##05ff97") ! (sky "##049acc" "##05deff") ! (tin "##6886cc" "##82b6ff") ! (velvet "##7c68cc" "##8c82ff") ! (grape "##b264cc" "##cf7df") ! (labia "##cc64c2" "##fd7dff") ! (berry "##cc6485" "##ff7db5") ! (neutral "##b4b4b4" "##878787") ! (september "#bf9900" "#ffcc00")) ! "Color alist used for the Gnus logo.") ! ! (defvar gnus-xmas-logo-color-style 'september ! "Color styles used for the Gnus logo.") ! ! (defvar gnus-xmas-logo-colors (cdr (assq gnus-xmas-logo-color-style ! gnus-xmas-logo-color-alist)) ! "Colors used for the Gnus logo.") ;;; Internal variables. *************** *** 145,150 **** --- 164,172 ---- (gnus-horizontal-recenter) (select-window selected)))))) + (defun gnus-xmas-add-hook (hook function &optional append local) + (add-hook hook function)) + (defun gnus-xmas-add-text-properties (start end props &optional object) (add-text-properties start end props object) (put-text-property start end 'start-closed nil object)) *************** *** 453,458 **** --- 475,481 ---- 'gnus-xmas-appt-select-lowest-window) (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) (fset 'gnus-make-local-hook 'make-local-variable) + (fset 'gnus-add-hook 'gnus-xmas-add-hook) (fset 'gnus-character-to-event 'character-to-event) (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) *** pub/sgnus/lisp/gnus.el Mon May 27 01:00:42 1996 --- sgnus/lisp/gnus.el Wed May 29 05:05:18 1996 *************** *** 1723,1731 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "Gnus v5.2.1" "Version number for this version of Gnus.") (defvar gnus-info-nodes '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") --- 1723,1734 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version-number "5.2.2" "Version number for this version of Gnus.") + (defconst gnus-version (format "Gnus v%s" gnus-version-number) + "Version string for this version of Gnus.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)The Group Buffer") (gnus-summary-mode "(gnus)The Summary Buffer") *************** *** 4266,4272 **** (setq truncate-lines t) (setq buffer-read-only t) (gnus-make-local-hook 'post-command-hook) ! (add-hook 'post-command-hook 'gnus-clear-inboxes-moved) (run-hooks 'gnus-group-mode-hook)) (defun gnus-clear-inboxes-moved () --- 4269,4275 ---- (setq truncate-lines t) (setq buffer-read-only t) (gnus-make-local-hook 'post-command-hook) ! (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (run-hooks 'gnus-group-mode-hook)) (defun gnus-clear-inboxes-moved () *************** *** 16068,16073 **** --- 16071,16077 ---- (unless (equal method gnus-message-archive-method) (gnus-error 1 "Cannot read active file from %s server." (car method))) + (gnus-message 5 mesg) (gnus-active-to-gnus-format method gnus-active-hashtb) ;; We mark this active file as read. (push method gnus-have-read-active-file) *************** *** 16290,16296 **** ((string= alpha "September") "5.01") ((string= alpha "Red") "5.03")) minor least) ! (format "%d.%02d%20d" major minor least)))))) (defun gnus-convert-old-newsrc () "Convert old newsrc into the new format, if needed." --- 16294,16300 ---- ((string= alpha "September") "5.01") ((string= alpha "Red") "5.03")) minor least) ! (format "%d.%02d%02d" major minor least)))))) (defun gnus-convert-old-newsrc () "Convert old newsrc into the new format, if needed." *** pub/sgnus/lisp/message.el Mon May 27 01:00:44 1996 --- sgnus/lisp/message.el Wed May 29 02:45:38 1996 *************** *** 252,257 **** --- 252,260 ---- "Normal hook, run each time a new outgoing message is initialized. The function `message-setup' runs this hook.") + (defvar message-mode-hook nil + "Hook run in message mode buffers.") + (defvar message-header-setup-hook nil "Hook called narrowed to the headers when setting up a message buffer.") *************** *** 708,713 **** --- 711,718 ---- "----" ["To" message-goto-to t] ["Subject" message-goto-subject t] + ["Cc" message-goto-cc t] + ["Reply-to" message-goto-reply-to t] ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] *************** *** 2557,2562 **** --- 2562,2570 ---- (if message-signature-before-forwarded-message (goto-char (point-max)) (message-goto-body)) + ;; Make sure we're at the start of the line. + (unless (eolp) + (insert "\n")) ;; Narrow to the area we are to insert. (narrow-to-region (point) (point)) ;; Insert the separators and the forwarded buffer. *************** *** 2792,2802 **** (message "No matching groups") (pop-to-buffer "*Completions*") (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (let ((standard-output (current-buffer))) ! (display-completion-list (sort completions 'string<))) ! (goto-char (point-min)) ! (pop-to-buffer cur)))))) ;;; Help stuff. --- 2800,2811 ---- (message "No matching groups") (pop-to-buffer "*Completions*") (buffer-disable-undo (current-buffer)) ! (let ((buffer-read-only nil)) ! (erase-buffer) ! (let ((standard-output (current-buffer))) ! (display-completion-list (sort completions 'string<))) ! (goto-char (point-min)) ! (pop-to-buffer cur))))))) ;;; Help stuff. *** pub/sgnus/lisp/nnfolder.el Mon May 27 01:00:44 1996 --- sgnus/lisp/nnfolder.el Wed May 29 00:23:40 1996 *************** *** 66,71 **** --- 66,74 ---- (defvoo nnfolder-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") + (defvoo nnfolder-save-buffer-hook nil + "Hook run before saving the nnfolder mbox buffer.") + (defvoo nnfolder-inhibit-expiry nil "If non-nil, inhibit expiry.") *************** *** 222,228 **** (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) ! (and (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer))) (setq bufs (cdr bufs)))))) nnfolder-directory --- 225,231 ---- (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) ! (nnfolder-save-buffer) (kill-buffer (current-buffer))) (setq bufs (cdr bufs)))))) nnfolder-directory *************** *** 251,257 **** (save-excursion (set-buffer nnfolder-current-buffer) ;; If the buffer was modified, write the file out now. ! (and (buffer-modified-p) (save-buffer)) ;; If we're shutting the server down, we need to kill the ;; buffer and remove it from the open buffer list. Or, of ;; course, if we're trying to minimize our space impact. --- 254,260 ---- (save-excursion (set-buffer nnfolder-current-buffer) ;; If the buffer was modified, write the file out now. ! (nnfolder-save-buffer) ;; If we're shutting the server down, we need to kill the ;; buffer and remove it from the open buffer list. Or, of ;; course, if we're trying to minimize our space impact. *************** *** 310,316 **** (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (and (buffer-modified-p) (save-buffer)) ;; Find the lowest active article in this group. (let* ((active (cadr (assoc newsgroup nnfolder-group-alist))) (marker (concat "\n" nnfolder-article-marker)) --- 313,319 ---- (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (nnfolder-save-buffer) ;; Find the lowest active article in this group. (let* ((active (cadr (assoc newsgroup nnfolder-group-alist))) (marker (concat "\n" nnfolder-article-marker)) *************** *** 354,362 **** (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last ! (buffer-modified-p) ! (save-buffer)))) result)) (deffoo nnfolder-request-accept-article (group &optional server last) --- 357,363 ---- (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last (nnfolder-save-buffer)))) result)) (deffoo nnfolder-request-accept-article (group &optional server last) *************** *** 379,385 **** (setq result (car (nnfolder-save-mail (and (stringp group) group))))) (save-excursion (set-buffer nnfolder-current-buffer) ! (and last (buffer-modified-p) (save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) --- 380,386 ---- (setq result (car (nnfolder-save-mail (and (stringp group) group))))) (save-excursion (set-buffer nnfolder-current-buffer) ! (and last (nnfolder-save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) *************** *** 394,400 **** nil (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (and (buffer-modified-p) (save-buffer)) t))) (deffoo nnfolder-request-delete-group (group &optional force server) --- 395,401 ---- nil (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (nnfolder-save-buffer) t))) (deffoo nnfolder-request-delete-group (group &optional force server) *************** *** 719,724 **** --- 720,731 ---- (concat dir group) ;; If not, we translate dots into slashes. (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) + + (defun nnfolder-save-buffer () + "Save the buffer." + (when (buffer-modified-p) + (run-hooks 'nnfolder-save-buffer-hook) + (save-buffer))) (provide 'nnfolder) *** pub/sgnus/lisp/nnheader-ems.el Mon May 27 01:00:44 1996 --- sgnus/lisp/nnheader-ems.el Wed May 29 00:23:42 1996 *************** *** 29,36 **** (start-itimer "nnheader-run-at-time" `(lambda () ! ,function ! ,@args) time repeat)) (defun nnheader-xmas-cancel-timer (timer) --- 29,35 ---- (start-itimer "nnheader-run-at-time" `(lambda () ! (,function ,@args)) time repeat)) (defun nnheader-xmas-cancel-timer (timer) *************** *** 176,182 **** (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer) (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect) (fset 'nnheader-insert-file-contents-literally ! 'nnheader-xmas-insert-file-contents-literally)) ;; Do Emacs function bindings. (t (fset 'nnheader-run-at-time 'run-at-time) --- 175,183 ---- (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer) (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect) (fset 'nnheader-insert-file-contents-literally ! (if (fboundp 'insert-file-contents-literally) ! 'insert-file-contents-literally ! 'nnheader-xmas-insert-file-contents-literally))) ;; Do Emacs function bindings. (t (fset 'nnheader-run-at-time 'run-at-time) *** pub/sgnus/lisp/nnspool.el Mon May 27 01:00:45 1996 --- sgnus/lisp/nnspool.el Wed May 29 04:07:01 1996 *************** *** 162,167 **** --- 162,170 ---- (file-truename nnspool-spool-directory)))) (nnspool-close-server) (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) + ((not (file-exists-p nnspool-active-file)) + (nnheader-report 'nnspool "The active file doesn't exist: %s" + nnspool-active-file)) (t (nnheader-report 'nnspool "Opened server %s using directory %s" server nnspool-spool-directory) *** pub/sgnus/lisp/nntp.el Mon May 27 01:00:45 1996 --- sgnus/lisp/nntp.el Wed May 29 03:44:59 1996 *************** *** 257,264 **** (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) ! (message "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) --- 257,264 ---- (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) ! (nnheader-message 7 "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) *************** *** 270,276 **** (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (message "NNTP: Receiving headers...done")) ;; Now all of replies are received. Fold continuation lines. (nnheader-fold-continuation-lines) --- 270,276 ---- (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (nnheader-message 7 "NNTP: Receiving headers...done")) ;; Now all of replies are received. Fold continuation lines. (nnheader-fold-continuation-lines) *************** *** 370,376 **** (process-sentinel nntp-server-process)) (set-process-sentinel nntp-server-process nil)) ;; We cannot send QUIT command unless the process is running. ! (when (nntp-server-opened) (nntp-send-command nil "QUIT") ;; Give the QUIT time to arrive. (sleep-for 1))) --- 370,376 ---- (process-sentinel nntp-server-process)) (set-process-sentinel nntp-server-process nil)) ;; We cannot send QUIT command unless the process is running. ! (when (nntp-server-opened server) (nntp-send-command nil "QUIT") ;; Give the QUIT time to arrive. (sleep-for 1))) *************** *** 378,386 **** (deffoo nntp-request-close () "Close all server connections." ! (let (proc entry) (while nntp-opened-connections (when (setq proc (pop nntp-opened-connections)) (condition-case () (process-send-string proc (concat "QUIT" nntp-end-of-line)) (error nil)) --- 378,389 ---- (deffoo nntp-request-close () "Close all server connections." ! (let (proc) (while nntp-opened-connections (when (setq proc (pop nntp-opened-connections)) + ;; Un-set default sentinel function before closing connection. + (when (eq 'nntp-default-sentinel (process-sentinel proc)) + (set-process-sentinel proc nil)) (condition-case () (process-send-string proc (concat "QUIT" nntp-end-of-line)) (error nil)) *************** *** 391,397 **** (and nntp-async-buffer (buffer-name nntp-async-buffer) (kill-buffer nntp-async-buffer)) ! (let ((alist (cddr (assq 'nntp nnoo-state-alist)))) (while (setq entry (pop alist)) (and (setq proc (cdr (assq 'nntp-async-buffer entry))) (buffer-name proc) --- 394,401 ---- (and nntp-async-buffer (buffer-name nntp-async-buffer) (kill-buffer nntp-async-buffer)) ! (let ((alist (cddr (assq 'nntp nnoo-state-alist))) ! entry) (while (setq entry (pop alist)) (and (setq proc (cdr (assq 'nntp-async-buffer entry))) (buffer-name proc) *************** *** 462,468 **** (prog1 (and (nntp-send-command ;; A bit odd regexp to ensure working over rlogin. ! "^\\.\\(\r?\n\\|\r$\\)" "ARTICLE" art) (if (numberp id) (cons nntp-current-group id) ;; We find out what the article number was. --- 466,472 ---- (prog1 (and (nntp-send-command ;; A bit odd regexp to ensure working over rlogin. ! "^\\.\r?\n" "ARTICLE" art) (if (numberp id) (cons nntp-current-group id) ;; We find out what the article number was. *************** *** 664,670 **** (setq server (caar servers))) (when (and server nntp-warn-about-losing-connection) ! (message "nntp: Connection closed to server %s" server) (setq nntp-current-group "") (ding)))) --- 668,674 ---- (setq server (caar servers))) (when (and server nntp-warn-about-losing-connection) ! (nnheader-message 3 "nntp: Connection closed to server %s" server) (setq nntp-current-group "") (ding)))) *************** *** 845,852 **** (message-log-max nil)) (unless (= dotnum newnum) (setq dotnum newnum) ! (message "NNTP: Reading %s" ! (make-string dotnum ?.))))) (nntp-accept-response))) ;; Remove "...". (when (and nntp-debug-read (> dotnum 0)) --- 849,856 ---- (message-log-max nil)) (unless (= dotnum newnum) (setq dotnum newnum) ! (nnheader-message 7 "NNTP: Reading %s" ! (make-string dotnum ?.))))) (nntp-accept-response))) ;; Remove "...". (when (and nntp-debug-read (> dotnum 0)) *************** *** 1076,1082 **** (save-excursion (set-buffer nntp-server-buffer) (setq nntp-status-string "") ! (message "nntp: Connecting to server on %s..." nntp-address) (cond ((and server (nntp-open-server-internal server service)) (setq nntp-address server) (setq status --- 1080,1086 ---- (save-excursion (set-buffer nntp-server-buffer) (setq nntp-status-string "") ! (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address) (cond ((and server (nntp-open-server-internal server service)) (setq nntp-address server) (setq status *************** *** 1222,1230 **** ;; We cannot use `accept-process-output'. ;; Fujitsu UTS requires messages during sleep-for. ;; I don't know why. ! (message "NNTP: Reading...") (sleep-for 1) ! (message "")) (condition-case errorcode (accept-process-output nntp-server-process 1) (error --- 1226,1234 ---- ;; We cannot use `accept-process-output'. ;; Fujitsu UTS requires messages during sleep-for. ;; I don't know why. ! (nnheader-message 5 "NNTP: Reading...") (sleep-for 1) ! (nnheader-message 5 "")) (condition-case errorcode (accept-process-output nntp-server-process 1) (error *** pub/sgnus/lisp/nnvirtual.el Mon May 27 01:00:45 1996 --- sgnus/lisp/nnvirtual.el Wed May 29 03:45:01 1996 *************** *** 203,216 **** (deffoo nnvirtual-request-group (group &optional server dont-check) (nnvirtual-possibly-change-server server) (cond ((null nnvirtual-component-groups) (setq nnvirtual-current-group nil) (nnheader-report 'nnvirtual "No component groups in %s" group)) (t (unless dont-check - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) nnvirtual-component-groups)) (nnvirtual-create-mapping)) (setq nnvirtual-current-group group) (let ((len (length nnvirtual-mapping))) --- 203,216 ---- (deffoo nnvirtual-request-group (group &optional server dont-check) (nnvirtual-possibly-change-server server) + (setq nnvirtual-component-groups + (delete (nnvirtual-current-group) nnvirtual-component-groups)) (cond ((null nnvirtual-component-groups) (setq nnvirtual-current-group nil) (nnheader-report 'nnvirtual "No component groups in %s" group)) (t (unless dont-check (nnvirtual-create-mapping)) (setq nnvirtual-current-group group) (let ((len (length nnvirtual-mapping))) *** pub/sgnus/lisp/ChangeLog Mon May 27 01:00:54 1996 --- sgnus/lisp/ChangeLog Wed May 29 06:30:29 1996 *************** *** 1,3 **** --- 1,72 ---- + Wed May 29 05:08:04 1996 Lars Magne Ingebrigtsen + + * custom.el (custom-xmas-add-text-properties, + custom-xmas-put-text-property): New functions used throughout. + May now work under XEmacs. + + Wed May 29 00:07:13 1996 Lars Magne Ingebrigtsen + + * gnus-cite.el (gnus-cite-article): New variable. + (gnus-cite-parse-maybe): Use it. + + * nnspool.el (nnspool-open-server): Refuse opening if the active + file doesn't exist. + + * gnus.el (gnus-read-active-file): Message more. + + * nntp.el (nntp-request-article): Wouldn't wait until the entire + article had arrived. + + * nnvirtual.el (nnvirtual-request-group): Make sure that things + don't recurse endlessly. + + * message.el (message-expand-group): Make buffer not read-only. + + * gnus-nocem.el (gnus-nocem-verifyer): New variable. + (gnus-nocem-verify-issuer): Use it. + + * gnus-xmas.el (gnus-xmas-logo-color-alist): New variable. + (gnus-xmas-logo-color-style): New variable. + (gnus-xmas-logo-colors): Use them. + + Tue May 28 00:28:38 1996 Lars Magne Ingebrigtsen + + * gnus-score.el (gnus-score-followup): Would infloop on exact + matches. + + * message.el (message-forward): Insert separator at the start of + the line. + + * nnfolder.el (nnfolder-save-buffer): New function. + (nnfolder-save-buffer-hook): New variable. + + * message.el (message-mode-hook): Defined variable. + + * nntp.el (nntp-request-close): Remove the sentinel before closing + connection. + + * gnus.el (gnus-group-mode): Add to local hook. + (gnus-continuum-version): Would return wrong answer for non-alpha + releases. + (gnus-version-number): New variable. + (gnus-version): Use it. + + * gnus-msg.el (gnus-inews-add-send-actions): Add to local hook. + + * gnus-xmas.el (gnus-xmas-add-hook): New function. + + * gnus-ems.el (gnus-add-hook): New alias. + + Tue May 28 00:23:17 1996 Joao Cachopo + + * gnus-salt.el (gnus-binary-mode): Would put wrong minor mode + keymap into alist. + + Tue May 28 00:18:19 1996 Thor Kristoffersen + + * nntp.el (nntp-close-server): Supply parameter to + `nntp-server-opened'. + Sun May 26 20:29:02 1996 Lars Magne Ingebrigtsen * gnus.el (gnus-article-sort-by-date): Inline. *************** *** 17,22 **** --- 86,95 ---- articles into the original buffer as well. Sun May 26 03:51:38 1996 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.2.1 is released. + + * gnus.el: Gnus v5.2.0 is released. * gnus.el: September Gnus v0.96 is released. *** pub/sgnus/texi/gnus.texi Mon May 27 01:00:59 1996 --- sgnus/texi/gnus.texi Wed May 29 04:06:58 1996 *************** *** 5421,5427 **** @findex gnus-summary-refer-parent-article @kindex ^ (Summary) If you'd like to read the parent of the current article, and it is not ! displayed in the article buffer, you might still be able to. That is, if the current group is fetched by @sc{nntp}, the parent hasn't expired and the @code{References} in the current article are not mangled, you can just press @kbd{^} or @kbd{A r} --- 5421,5427 ---- @findex gnus-summary-refer-parent-article @kindex ^ (Summary) If you'd like to read the parent of the current article, and it is not ! displayed in the summary buffer, you might still be able to. That is, if the current group is fetched by @sc{nntp}, the parent hasn't expired and the @code{References} in the current article are not mangled, you can just press @kbd{^} or @kbd{A r} *************** *** 6414,6422 **** * Posting Server:: What server should you post via? * Mail and Post:: Mailing and posting at the same time. * Archived Messages:: Where Gnus stores the messages you've sent. ! * Posting Styles:: An easier way to configure some key elements. @c * Drafts:: Postponing messages and rejected messages. ! * Rejected Articles:: What happens if the server doesn't like your article? @end menu Also see @pxref{Canceling and Superseding} for information on how to --- 6414,6422 ---- * Posting Server:: What server should you post via? * Mail and Post:: Mailing and posting at the same time. * Archived Messages:: Where Gnus stores the messages you've sent. ! @c * Posting Styles:: An easier way to configure some key elements. @c * Drafts:: Postponing messages and rejected messages. ! @c * Rejected Articles:: What happens if the server doesn't like your article? @end menu Also see @pxref{Canceling and Superseding} for information on how to *************** *** 6671,6754 **** @end table ! @node Posting Styles ! @section Posting Styles ! @cindex posting styles ! @cindex styles ! ! All them variables, they make my head swim. ! ! So what if you want a different @code{Organization} and signature based ! on what groups you post to? And you post both from your home machine ! and your work machine, and you want different @code{From} lines, and so ! on? ! ! @vindex gnus-posting-styles ! One way to do stuff like that is to write clever hooks that change the ! variables you need to have changed. That's a bit boring, so somebody ! came up with the bright idea of letting the user specify these things in ! a handy alist. Here's an example of a @code{gnus-posting-styles} ! variable: ! ! @lisp ! ((".*" ! (signature . "Peace and happiness") ! (organization . "What me?")) ! ("^comp" ! (signature . "Death to everybody")) ! ("comp.emacs.i-love-it" ! (organization . "Emacs is it"))) ! @end lisp ! ! As you might surmise from this example, this alist consists of several ! @dfn{styles}. Each style will be applicable if the first element ! ``matches'', in some form or other. The entire alist will be iterated ! over, from the beginning towards the end, and each match will be ! applied, which means that attributes in later styles that match override ! the same attributes in earlier matching styles. So ! @samp{comp.programming.literate} will have the @samp{Death to everybody} ! signature and the @samp{What me?} @code{Organization} header. ! ! The first element in each style is called the @code{match}. If it's a ! string, then Gnus will try to regexp match it against the group name. ! If it's a function symbol, that function will be called with no ! arguments. If it's a variable symbol, then the variable will be ! referenced. If it's a list, then that list will be @code{eval}ed. In ! any case, if this returns a non-@code{nil} value, then the style is said ! to @dfn{match}. ! ! Each style may contain a arbitrary amount of @dfn{attributes}. Each ! attribute consists of a @var{(name . value)} pair. The attribute name ! can be one of @code{signature}, @code{organization} or @code{from}. The ! attribute name can also be a string. In that case, this will be used as ! a header name, and the value will be inserted in the headers of the ! article. ! ! The attribute value can be a string (used verbatim), a function (the ! return value will be used), a variable (its value will be used) or a ! list (it will be @code{eval}ed and the return value will be used). ! ! So here's a new example: ! ! @lisp ! (setq gnus-posting-styles ! '((".*" ! (signature . "~/.signature") ! (from . "user@@foo (user)") ! ("X-Home-Page" . (getenv "WWW_HOME")) ! (organization . "People's Front Against MWM")) ! ("^rec.humor" ! (signature . my-funny-signature-randomizer)) ! ((equal (system-name) "gnarly") ! (signature . my-quote-randomizer)) ! (posting-from-work-p ! (signature . "~/.work-signature") ! (from . "user@@bar.foo (user)") ! (organization . "Important Work, Inc")) ! ("^nn.+:" ! (signature . "~/.mail-signature")))) ! @end lisp ! @c @node Drafts @c @section Drafts --- 6671,6753 ---- @end table ! @c @node Posting Styles ! @c @section Posting Styles ! @c @cindex posting styles ! @c @cindex styles ! @c ! @c All them variables, they make my head swim. ! @c ! @c So what if you want a different @code{Organization} and signature based ! @c on what groups you post to? And you post both from your home machine ! @c and your work machine, and you want different @code{From} lines, and so ! @c on? ! @c ! @c @vindex gnus-posting-styles ! @c One way to do stuff like that is to write clever hooks that change the ! @c variables you need to have changed. That's a bit boring, so somebody ! @c came up with the bright idea of letting the user specify these things in ! @c a handy alist. Here's an example of a @code{gnus-posting-styles} ! @c variable: ! @c ! @c @lisp ! @c ((".*" ! @c (signature . "Peace and happiness") ! @c (organization . "What me?")) ! @c ("^comp" ! @c (signature . "Death to everybody")) ! @c ("comp.emacs.i-love-it" ! @c (organization . "Emacs is it"))) ! @c @end lisp ! @c ! @c As you might surmise from this example, this alist consists of several ! @c @dfn{styles}. Each style will be applicable if the first element ! @c ``matches'', in some form or other. The entire alist will be iterated ! @c over, from the beginning towards the end, and each match will be ! @c applied, which means that attributes in later styles that match override ! @c the same attributes in earlier matching styles. So ! @c @samp{comp.programming.literate} will have the @samp{Death to everybody} ! @c signature and the @samp{What me?} @code{Organization} header. ! @c ! @c The first element in each style is called the @code{match}. If it's a ! @c string, then Gnus will try to regexp match it against the group name. ! @c If it's a function symbol, that function will be called with no ! @c arguments. If it's a variable symbol, then the variable will be ! @c referenced. If it's a list, then that list will be @code{eval}ed. In ! @c any case, if this returns a non-@code{nil} value, then the style is said ! @c to @dfn{match}. ! @c ! @c Each style may contain a arbitrary amount of @dfn{attributes}. Each ! @c attribute consists of a @var{(name . value)} pair. The attribute name ! @c can be one of @code{signature}, @code{organization} or @code{from}. The ! @c attribute name can also be a string. In that case, this will be used as ! @c a header name, and the value will be inserted in the headers of the ! @c article. ! @c ! @c The attribute value can be a string (used verbatim), a function (the ! @c return value will be used), a variable (its value will be used) or a ! @c list (it will be @code{eval}ed and the return value will be used). ! @c ! @c So here's a new example: ! @c ! @c @lisp ! @c (setq gnus-posting-styles ! @c '((".*" ! @c (signature . "~/.signature") ! @c (from . "user@@foo (user)") ! @c ("X-Home-Page" . (getenv "WWW_HOME")) ! @c (organization . "People's Front Against MWM")) ! @c ("^rec.humor" ! @c (signature . my-funny-signature-randomizer)) ! @c ((equal (system-name) "gnarly") ! @c (signature . my-quote-randomizer)) ! @c (posting-from-work-p ! @c (signature . "~/.work-signature") ! @c (from . "user@@bar.foo (user)") ! @c (organization . "Important Work, Inc")) ! @c ("^nn.+:" ! @c (signature . "~/.mail-signature")))) ! @c @end lisp @c @node Drafts @c @section Drafts *************** *** 11965,11970 **** --- 11964,11970 ---- * Headers:: How Gnus stores headers internally. * Ranges:: A handy format for storing mucho numbers. * Group Info:: The group info format. + * Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen. * Various File Formats:: Formats of files that Gnus use. @end menu *************** *** 12849,12854 **** --- 12849,12896 ---- Actually that @samp{marks} rule is a fib. A @samp{marks} is a @samp{} consed on to a @samp{range}, but that's a bitch to say in pseudo-BNF. + + + @node Emacs/XEmacs Code + @subsection Emacs/XEmacs Code + @cindex XEmacs + @cindex Emacsen + + While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the + platforms must be the primary one. I chose Emacs. Not because I don't + like XEmacs or Mule, but because it comes first alphabetically. + + This means that Gnus will byte-compile under Emacs with nary a warning, + while XEmacs will pump out gigabytes of warnings while byte-compiling. + As I use byte-compilation warnings to help me root out trivial errors in + Gnus, that's very useful. + + I've also consistently used Emacs function interfaces, but have used + Gnusey aliases for the functions. To take an example: Emacs defines a + @code{run-at-time} function while XEmacs defines a @code{start-itimer} + function. I then define a function called @code{gnus-run-at-time} that + takes the same parameters as the Emacs @code{run-at-time}. When running + Gnus under Emacs, the former function is just an alias for the latter. + However, when running under XEmacs, the former is an alias for the + following function: + + @lisp + (defun gnus-xmas-run-at-time (time repeat function &rest args) + (start-itimer + "gnus-run-at-time" + `(lambda () + (,function ,@@args)) + time repeat)) + @end lisp + + This sort of thing has been done for bunches of functions. Gnus does + not redefine any native Emacs functions while running under XEmacs -- it + does this @code{defalias} thing with Gnus equivalents instead. Cleaner + all over. + + Of course, I could have chosen XEmacs as my native platform and done + mapping functions the other way around. But I didn't. The performance + hit these indirections impose on Gnus under XEmacs should be slight. @node Various File Formats *** pub/sgnus/texi/message.texi Mon May 27 01:00:57 1996 --- sgnus/texi/message.texi Wed May 29 00:23:51 1996 *************** *** 434,441 **** @item message-cite-function @vindex message-cite-function Function for citing an original message. The default is ! @code{message-cite-original}. @item message-indent-citation-function @vindex message-indent-citation-function --- 434,445 ---- @item message-cite-function @vindex message-cite-function + @findex message-cite-original + @findex sc-cite-original + @cindex SuperCite Function for citing an original message. The default is ! @code{message-cite-original}. You can also set it to ! @code{sc-cite-original} to use SuperCite. @item message-indent-citation-function @vindex message-indent-citation-function *** pub/sgnus/texi/ChangeLog Mon May 27 01:00:55 1996 --- sgnus/texi/ChangeLog Wed May 29 00:23:42 1996 *************** *** 1,3 **** --- 1,8 ---- + Tue May 28 21:19:29 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Composing Messages): Deletia. + (Emacs/XEmacs code): New. + Sun May 26 18:28:19 1996 Lars Magne Ingebrigtsen * gnus.texi (Paging the Article): Moved. *** pub/sgnus/GNUS-NEWS Wed May 29 06:41:00 1996 --- sgnus/GNUS-NEWS Wed May 29 02:16:32 1996 *************** *** 0 **** --- 1,162 ---- + ** Gnus changes. + + Gnus, the Emacs newsreader, has undergone further rewriting. Many new + commands and variables have been added. There should be no + significant imcompatabilities between this Gnus version and the + previosly released version, except in the message composition area. + + Below is a list of the more user-visible changes. Coding changes + between Gnus 5.1 and 5.2 are more extensive. + + *** A new message composition mode is used. All old customization + variables for mail-mode, rnews-reply-mode and gnus-msg are now + absolete. + + *** Gnus is now able to generate "sparse" threads -- threads where + missing articles are represented by empty nodes. + + (setq gnus-build-sparse-threads 'some) + + *** Outgoing articles are stored on a special archive server. + + To disable this: (setq gnus-message-archive-group nil) + + *** Partial thread regeneration now happens when articles are + referred. + + *** Gnus can make use of GroupLens predictions: + + (setq gnus-use-grouplens t) + + *** Picons (personal icons) can be displayed under XEmacs. + + (setq gnus-use-picons t) + + *** A trn-line tree buffer can be displayed. + + (setq gnus-use-trees t) + + *** An nn-like pick-and-read minor mode is available for the summary + buffers. + + (add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) + + *** In binary groups you can use a special binary minor mode: + + `M-x gnus-binary-mode' + + *** Groups can be grouped in a folding topic hierarchy. + + (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) + + *** Gnus can resend and bounce mail. + + Use the `S D r' and `S D b'. + + *** Groups can now have a score, and bubbling based on entry frequency + is possible. + + (add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group) + + *** Groups can be process-marked, and commands can be performed on + groups of groups. + + *** Caching is possible in virtual groups. + + *** nndoc now understands all kinds of digests, mail boxes, rnews news + batches, ClariNet briefs collections, and just about everything else. + + *** Gnus has a new backend (nnsoup) to create/read SOUP packets. + + *** The Gnus cache is much faster. + + *** Groups can be sorted according to many criteria. + + For instance: (setq gnus-group-sort-function 'gnus-group-sort-by-rank) + + *** New group parameters have been introduced to set list-address and + expiry times. + + *** All formatting specs allow specifying faces to be used. + + *** There are several more commands for setting/removing/acting on + process marked articles on the `M P' submap. + + *** The summary buffer can be limited to show parts of the available + articles based on a wide range of criteria. These commands have been + bound to keys on the `/' submap. + + *** Articles can be made persistent -- as an alternative to saving + articles with the `*' command. + + *** All functions for hiding article elements are now toggles. + + *** Article headers can be buttonized. + + (add-hook 'gnus-article-display-hook 'gnus-article-add-buttons-to-head) + + *** All mail backends support fetching articles by Message-ID. + + *** Duplicate mail can now be treated properly. See the + `nnmail-treat-duplicates' variable. + + *** All summary mode commands are available directly from the article + buffer. + + *** Frames can be part of `gnus-buffer-configuration'. + + *** Mail can be re-scanned by a daemonic process. + + *** Gnus can make use of NoCeM files to filter spam. + + (setq gnus-use-nocem t) + + *** Groups can be made permanently visible. + + (setq gnus-permanently-visible-groups "^nnml:") + + *** Many new hooks have been introduced to make customizing easier. + + *** Gnus respects the Mail-Copies-To header. + + *** Threads can be gathered by looking at the References header. + + (setq gnus-summary-thread-gathering-function + 'gnus-gather-threads-by-references) + + *** Read articles can be stored in a special backlog buffer to avoid + refetching. + + (setq gnus-keep-backlog 50) + + *** A clean copy of the current article is always stored in a separate + buffer to allow easier treatment. + + *** Gnus can suggest where to save articles. See `gnus-split-methods'. + + *** Gnus doesn't have to do as much prompting when saving. + + (setq gnus-prompt-before-saving t) + + *** gnus-uu can view decoded files asynchronously while fetching + articles. + + (setq gnus-uu-grabbed-file-functions '`gnus-uu-grab-view) + + *** Filling in the article buffer now works properly on cited text. + + *** Hiding cited text adds buttons to toggle hiding, and how much + cited text to hide is now customizable. + + (setq gnus-cited-lines-visible 2) + + *** Boring headers can be hidden. + + (add-hook 'gnus-article-display-hook 'gnus-article-hide-boring-headers) + + *** Default scoring values can now be set from the menu bar. + + *** Further syntax checking of outgoing articles have been added. + + The Gnus manual has been expanded. It explains all these new features + in greater detail.