*** pub/rgnus/lisp/cus-edit.el Thu Mar 6 08:47:24 1997 --- rgnus/lisp/cus-edit.el Fri Mar 7 23:51:13 1997 *************** *** 19,25 **** (define-widget-keywords :custom-prefixes :custom-menu :custom-show :custom-magic :custom-state :custom-level :custom-form ! :custom-set :custom-save :custom-reset-current :custom-reset-saved :custom-reset-factory) ;;; Customization Groups. --- 19,25 ---- (define-widget-keywords :custom-prefixes :custom-menu :custom-show :custom-magic :custom-state :custom-level :custom-form ! :custom-set :custom-save :custom-reset-current :custom-reset-saved :custom-reset-factory) ;;; Customization Groups. *************** *** 199,205 **** (defgroup customize '((widgets custom-group)) "Customization of the Customization support." :link '(custom-manual "(custom)Top") ! :link '(url-link :tag "Development Page" "http://www.dina.kvl.dk/~abraham/custom/") :prefix "custom-" :group 'help --- 199,205 ---- (defgroup customize '((widgets custom-group)) "Customization of the Customization support." :link '(custom-manual "(custom)Top") ! :link '(url-link :tag "Development Page" "http://www.dina.kvl.dk/~abraham/custom/") :prefix "custom-" :group 'help *************** *** 223,229 **** (defun custom-split-regexp-maybe (regexp) "If REGEXP is a string, split it to a list at `\\|'. ! You can get the original back with from the result with: (mapconcat 'identity result \"\\|\") IF REGEXP is not a string, return it unchanged." --- 223,229 ---- (defun custom-split-regexp-maybe (regexp) "If REGEXP is a string, split it to a list at `\\|'. ! You can get the original back with from the result with: (mapconcat 'identity result \"\\|\") IF REGEXP is not a string, return it unchanged." *************** *** 263,275 **** (while prefixes (setq prefix (car prefixes)) (if (search-forward prefix (+ (point) (length prefix)) t) ! (progn (setq prefixes nil) (delete-region (point-min) (point))) (setq prefixes (cdr prefixes))))) (subst-char-in-region (point-min) (point-max) ?- ?\ t) (capitalize-region (point-min) (point-max)) ! (unless no-suffix (goto-char (point-max)) (insert "...")) (buffer-string))))) --- 263,275 ---- (while prefixes (setq prefix (car prefixes)) (if (search-forward prefix (+ (point) (length prefix)) t) ! (progn (setq prefixes nil) (delete-region (point-min) (point))) (setq prefixes (cdr prefixes))))) (subst-char-in-region (point-min) (point-max) ?- ?\ t) (capitalize-region (point-min) (point-max)) ! (unless no-suffix (goto-char (point-max)) (insert "...")) (buffer-string))))) *************** *** 297,309 **** (defvar custom-mode-map nil "Keymap for `custom-mode'.") ! (unless custom-mode-map (setq custom-mode-map (make-sparse-keymap)) (set-keymap-parent custom-mode-map widget-keymap) (define-key custom-mode-map "q" 'bury-buffer)) ! (easy-menu-define custom-mode-menu custom-mode-map "Menu used in customization buffers." '("Custom" --- 297,309 ---- (defvar custom-mode-map nil "Keymap for `custom-mode'.") ! (unless custom-mode-map (setq custom-mode-map (make-sparse-keymap)) (set-keymap-parent custom-mode-map widget-keymap) (define-key custom-mode-map "q" 'bury-buffer)) ! (easy-menu-define custom-mode-menu custom-mode-map "Menu used in customization buffers." '("Custom" *************** *** 330,336 **** \\[widget-button-press] Activate button under point. \\[custom-set] Set all modifications. \\[custom-save] Make all modifications default. ! \\[custom-reset-current] Reset all modified options. \\[custom-reset-saved] Reset all modified or set options. \\[custom-reset-factory] Reset all options. --- 330,336 ---- \\[widget-button-press] Activate button under point. \\[custom-set] Set all modifications. \\[custom-save] Make all modifications default. ! \\[custom-reset-current] Reset all modified options. \\[custom-reset-saved] Reset all modified or set options. \\[custom-reset-factory] Reset all options. *************** *** 365,371 **** children)) (custom-save-all)) ! (defvar custom-reset-menu '(("Current" . custom-reset-current) ("Saved" . custom-reset-saved) ("Factory Settings" . custom-reset-factory)) --- 365,371 ---- children)) (custom-save-all)) ! (defvar custom-reset-menu '(("Current" . custom-reset-current) ("Saved" . custom-reset-saved) ("Factory Settings" . custom-reset-factory)) *************** *** 416,422 **** (defun customize (symbol) "Customize SYMBOL, which must be a customization group." (interactive (list (completing-read "Customize group: (default emacs) " ! obarray (lambda (symbol) (get symbol 'custom-group)) t))) --- 416,422 ---- (defun customize (symbol) "Customize SYMBOL, which must be a customization group." (interactive (list (completing-read "Customize group: (default emacs) " ! obarray (lambda (symbol) (get symbol 'custom-group)) t))) *************** *** 435,441 **** (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) ! (setq val (completing-read (if v (format "Customize variable (default %s): " v) "Customize variable: ") --- 435,441 ---- (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) ! (setq val (completing-read (if v (format "Customize variable (default %s): " v) "Customize variable: ") *************** *** 448,454 **** (defun customize-face (&optional symbol) "Customize SYMBOL, which should be a face name or nil. If SYMBOL is nil, customize all faces." ! (interactive (list (completing-read "Customize face: (default all) " obarray 'custom-facep))) (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) (let ((found nil)) --- 448,454 ---- (defun customize-face (&optional symbol) "Customize SYMBOL, which should be a face name or nil. If SYMBOL is nil, customize all faces." ! (interactive (list (completing-read "Customize face: (default all) " obarray 'custom-facep))) (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) (let ((found nil)) *************** *** 477,483 **** (boundp symbol) (setq found (cons (list symbol 'custom-variable) found))))) ! (if found (custom-buffer-create found) (error "No customized user options")))) --- 477,483 ---- (boundp symbol) (setq found (cons (list symbol 'custom-variable) found))))) ! (if found (custom-buffer-create found) (error "No customized user options")))) *************** *** 502,508 **** (user-variable-p symbol)))) (setq found (cons (list symbol 'custom-variable) found)))))) ! (if found (custom-buffer-create found) (error "No matches")))) --- 502,508 ---- (user-variable-p symbol)))) (setq found (cons (list symbol 'custom-variable) found)))))) ! (if found (custom-buffer-create found) (error "No matches")))) *************** *** 517,530 **** (custom-mode) (widget-insert "This is a customization buffer. Push RET or click mouse-2 on the word ") ! (widget-create 'info-link :tag "help" :help-echo "Push me for help." "(custom)The Customization Buffer") (widget-insert " for more information.\n\n") ! (setq custom-options (mapcar (lambda (entry) ! (prog1 (if (> (length options) 1) (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name --- 517,530 ---- (custom-mode) (widget-insert "This is a customization buffer. Push RET or click mouse-2 on the word ") ! (widget-create 'info-link :tag "help" :help-echo "Push me for help." "(custom)The Customization Buffer") (widget-insert " for more information.\n\n") ! (setq custom-options (mapcar (lambda (entry) ! (prog1 (if (> (length options) 1) (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name *************** *** 617,635 **** (:underline t))) "Face used when the customize item is not defined for customization.") ! (defface custom-modified-face '((((class color)) (:foreground "white" :background "blue")) (t (: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))) --- 617,635 ---- (:underline t))) "Face used when the customize item is not defined for customization.") ! (defface custom-modified-face '((((class color)) (:foreground "white" :background "blue")) (t (: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))) *************** *** 659,665 **** (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: --- 659,665 ---- (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: *************** *** 668,674 **** `unknown' For internal use, should never occur. `hidden' ! This item is not being displayed. `invalid' This item is modified, but has an invalid form. `modified' --- 668,674 ---- `unknown' For internal use, should never occur. `hidden' ! This item is not being displayed. `invalid' This item is modified, but has an invalid form. `modified' *************** *** 694,736 **** :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 --- 694,736 ---- :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 *************** *** 770,776 **** (lisp (eq (widget-get parent :custom-form) 'lisp)) children) (when custom-magic-show ! (push (widget-create-child-and-convert widget 'choice-item :help-echo "\ Push me to change the state of this item." :format "%[%t%]" --- 770,776 ---- (lisp (eq (widget-get parent :custom-form) 'lisp)) children) (when custom-magic-show ! (push (widget-create-child-and-convert widget 'choice-item :help-echo "\ Push me to change the state of this item." :format "%[%t%]" *************** *** 780,786 **** (if (eq custom-magic-show 'long) (insert text) (insert (symbol-name state))) ! (when lisp (insert " (lisp)")) (insert "\n")) (when custom-magic-show-button --- 780,786 ---- (if (eq custom-magic-show 'long) (insert text) (insert (symbol-name state))) ! (when lisp (insert " (lisp)")) (insert "\n")) (when custom-magic-show-button *************** *** 788,799 **** (let ((indent (widget-get parent :indent))) (when indent (insert-char ? indent)))) ! (push (widget-create-child-and-convert widget 'choice-item :button-face face :help-echo "\ Push me to change the state." :format "%[%t%]" ! :tag (if lisp (concat "(" magic ")") (concat "[" magic "]"))) children) --- 788,799 ---- (let ((indent (widget-get parent :indent))) (when indent (insert-char ? indent)))) ! (push (widget-create-child-and-convert widget 'choice-item :button-face face :help-echo "\ Push me to change the state." :format "%[%t%]" ! :tag (if lisp (concat "(" magic ")") (concat "[" magic "]"))) children) *************** *** 845,851 **** (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))) --- 845,851 ---- (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))) *************** *** 858,864 **** (state (widget-get widget :custom-state)) (level (widget-get widget :custom-level))) (cond ((eq escape ?l) ! (when level (push (widget-create-child-and-convert widget 'custom-level (make-string level ?*)) buttons) --- 858,864 ---- (state (widget-get widget :custom-state)) (level (widget-get widget :custom-level))) (cond ((eq escape ?l) ! (when level (push (widget-create-child-and-convert widget 'custom-level (make-string level ?*)) buttons) *************** *** 895,904 **** (if many (insert ", and ") (insert " and "))) ! (t (insert ", ")))) (widget-put widget :buttons buttons)))) ! (t (widget-default-format-handler widget escape))))) (defun custom-notify (widget &rest args) --- 895,904 ---- (if many (insert ", and ") (insert " and "))) ! (t (insert ", ")))) (widget-put widget :buttons buttons)))) ! (t (widget-default-format-handler widget escape))))) (defun custom-notify (widget &rest args) *************** *** 921,929 **** (defun custom-redraw-magic (widget) "Redraw WIDGET state with current settings." ! (while widget (let ((magic (widget-get widget :custom-magic))) ! (unless magic (debug)) (widget-value-set magic (widget-value magic)) (when (setq widget (widget-get widget :group)) --- 921,929 ---- (defun custom-redraw-magic (widget) "Redraw WIDGET state with current settings." ! (while widget (let ((magic (widget-get widget :custom-magic))) ! (unless magic (debug)) (widget-value-set magic (widget-value magic)) (when (setq widget (widget-get widget :group)) *************** *** 1022,1028 **** ;; Now we can create the child widget. (cond ((eq state 'hidden) ;; Indicate hidden value. ! (push (widget-create-child-and-convert widget 'item :format "%{%t%}: ..." :sample-face 'custom-variable-sample-face --- 1022,1028 ---- ;; Now we can create the child widget. (cond ((eq state 'hidden) ;; Indicate hidden value. ! (push (widget-create-child-and-convert widget 'item :format "%{%t%}: ..." :sample-face 'custom-variable-sample-face *************** *** 1039,1046 **** (custom-quote (default-value symbol))) (t (custom-quote (widget-get conv :value)))))) ! (push (widget-create-child-and-convert ! widget 'sexp :button-face 'custom-variable-button-face :tag (symbol-name symbol) :parent widget --- 1039,1046 ---- (custom-quote (default-value symbol))) (t (custom-quote (widget-get conv :value)))))) ! (push (widget-create-child-and-convert ! widget 'sexp :button-face 'custom-variable-button-face :tag (symbol-name symbol) :parent widget *************** *** 1049,1055 **** (t ;; Edit mode. (push (widget-create-child-and-convert ! widget type :tag tag :button-face 'custom-variable-button-face :sample-face 'custom-variable-sample-face --- 1049,1055 ---- (t ;; Edit mode. (push (widget-create-child-and-convert ! widget type :tag tag :button-face 'custom-variable-button-face :sample-face 'custom-variable-sample-face *************** *** 1061,1067 **** (if (eq state 'hidden) (widget-put widget :custom-state state) (custom-variable-state-set widget)) ! (widget-put widget :custom-form form) (widget-put widget :buttons buttons) (widget-put widget :children children))) --- 1061,1067 ---- (if (eq state 'hidden) (widget-put widget :custom-state state) (custom-variable-state-set widget)) ! (widget-put widget :custom-form form) (widget-put widget :buttons buttons) (widget-put widget :children children))) *************** *** 1093,1099 **** (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) --- 1093,1099 ---- (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) *************** *** 1110,1116 **** "Show the menu for `custom-variable' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) --- 1110,1116 ---- "Show the menu for `custom-variable' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) *************** *** 1208,1216 **** (defvar custom-face-edit-args (mapcar (lambda (att) ! (list 'group :inline t ! (list 'const :format "" :value (nth 0 att)) (nth 1 att))) custom-face-attributes)) --- 1208,1216 ---- (defvar custom-face-edit-args (mapcar (lambda (att) ! (list 'group :inline t ! (list 'const :format "" :value (nth 0 att)) (nth 1 att))) custom-face-attributes)) *************** *** 1220,1228 **** :tag "Attributes" :extra-offset 12 :args (mapcar (lambda (att) ! (list 'group :inline t ! (list 'const :format "" :value (nth 0 att)) (nth 1 att))) custom-face-attributes)) --- 1220,1228 ---- :tag "Attributes" :extra-offset 12 :args (mapcar (lambda (att) ! (list 'group :inline t ! (list 'const :format "" :value (nth 0 att)) (nth 1 att))) custom-face-attributes)) *************** *** 1298,1309 **** ;; XEmacs cannot display initialized faces. (not (custom-facep symbol)) (copy-face 'custom-face-empty symbol)) ! (setq child (widget-create-child-and-convert widget 'item :format "(%{%t%})\n" :sample-face symbol :tag "sample"))) ! (t (custom-format-handler widget escape))) (when child (widget-put widget --- 1298,1309 ---- ;; XEmacs cannot display initialized faces. (not (custom-facep symbol)) (copy-face 'custom-face-empty symbol)) ! (setq child (widget-create-child-and-convert widget 'item :format "(%{%t%})\n" :sample-face symbol :tag "sample"))) ! (t (custom-format-handler widget escape))) (when child (widget-put widget *************** *** 1326,1332 **** (custom-face-state-set widget) (widget-put widget :children (list edit))))) ! (defvar custom-face-menu '(("Set" . custom-face-set) ("Save" . custom-face-save) ("Reset to Saved" . custom-face-reset-saved) --- 1326,1332 ---- (custom-face-state-set widget) (widget-put widget :children (list edit))))) ! (defvar custom-face-menu '(("Set" . custom-face-set) ("Save" . custom-face-save) ("Reset to Saved" . custom-face-reset-saved) *************** *** 1345,1358 **** 'saved) ((get symbol 'factory-face) 'factory) ! (t 'rogue))))) (defun custom-face-action (widget &optional event) "Show the menu for `custom-face' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) --- 1345,1358 ---- 'saved) ((get symbol 'factory-face) 'factory) ! (t 'rogue))))) (defun custom-face-action (widget &optional event) "Show the menu for `custom-face' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) *************** *** 1462,1468 **** (mapcar (lambda (face) (list (symbol-name face))) (face-list)) ! nil nil nil 'face-history))) (unless (zerop (length answer)) (widget-value-set widget (intern answer)) --- 1462,1468 ---- (mapcar (lambda (face) (list (symbol-name face))) (face-list)) ! nil nil nil 'face-history))) (unless (zerop (length answer)) (widget-value-set widget (intern answer)) *************** *** 1479,1485 **** (defun custom-hook-convert-widget (widget) ;; Handle `:custom-options'. (let* ((options (widget-get widget :options)) ! (other `(editable-list :inline t :entry-format "%i %d%v" (function :format " %v"))) (args (if options --- 1479,1485 ---- (defun custom-hook-convert-widget (widget) ;; Handle `:custom-options'. (let* ((options (widget-get widget :options)) ! (other `(editable-list :inline t :entry-format "%i %d%v" (function :format " %v"))) (args (if options *************** *** 1569,1575 **** (widget-put widget :children children) (custom-group-state-update widget))))) ! (defvar custom-group-menu '(("Set" . custom-group-set) ("Save" . custom-group-save) ("Reset to Current" . custom-group-reset-current) --- 1569,1575 ---- (widget-put widget :children children) (custom-group-state-update widget))))) ! (defvar custom-group-menu '(("Set" . custom-group-set) ("Save" . custom-group-save) ("Reset to Current" . custom-group-reset-current) *************** *** 1584,1590 **** "Show the menu for `custom-group' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) --- 1584,1590 ---- "Show the menu for `custom-group' WIDGET. Optional EVENT is the location for the menu." (if (eq (widget-get widget :custom-state) 'hidden) ! (progn (widget-put widget :custom-state 'unknown) (custom-redraw widget)) (let* ((completion-ignore-case t) *************** *** 1776,1782 **** (defun custom-menu-create (symbol &optional name) "Create menu for customization group SYMBOL. ! If optional NAME is given, use that as the name of the menu. Otherwise make up a name from SYMBOL. The menu is in a format applicable to `easy-menu-define'." (unless name --- 1776,1782 ---- (defun custom-menu-create (symbol &optional name) "Create menu for customization group SYMBOL. ! If optional NAME is given, use that as the name of the menu. Otherwise make up a name from SYMBOL. The menu is in a format applicable to `easy-menu-define'." (unless name *** pub/rgnus/lisp/cus-face.el Fri Mar 7 07:36:59 1997 --- rgnus/lisp/cus-face.el Fri Mar 7 23:51:13 1997 *************** *** 46,55 **** If FRAME is omitted or nil, use the selected frame." (color-instance-rgb-components (make-color-instance color)))) ! ;; XEmacs and Emacs have different definitions of `facep'. ! ;; The Emacs definition is the useful one, so emulate that. (cond ((not (fboundp 'facep)) ! (defun custom-facep (face) "No faces" nil)) ((string-match "XEmacs" emacs-version) --- 46,55 ---- If FRAME is omitted or nil, use the selected frame." (color-instance-rgb-components (make-color-instance color)))) ! ;; XEmacs and Emacs have different definitions of `facep'. ! ;; The Emacs definition is the useful one, so emulate that. (cond ((not (fboundp 'facep)) ! (defun custom-facep (face) "No faces" nil)) ((string-match "XEmacs" emacs-version) *************** *** 104,110 **** Does nothing when the variable initialize-face-resources is nil." (when initialize-face-resources (make-face-x-resource-internal face frame t)))) ! (t ;; Too hard to do right on XEmacs. (defalias 'initialize-face-resources 'ignore))) --- 104,110 ---- Does nothing when the variable initialize-face-resources is nil." (when initialize-face-resources (make-face-x-resource-internal face frame t)))) ! (t ;; Too hard to do right on XEmacs. (defalias 'initialize-face-resources 'ignore))) *************** *** 144,150 **** your background is light, or nil (default) if you want Emacs to examine the brightness for you." :group 'customize ! :type '(choice (choice-item dark) (choice-item light) (choice-item :tag "default" nil))) --- 144,150 ---- your background is light, or nil (default) if you want Emacs to examine the brightness for you." :group 'customize ! :type '(choice (choice-item dark) (choice-item light) (choice-item :tag "default" nil))) *************** *** 166,172 **** 'class (frame-property frame 'display-type) 'background (or custom-background-mode (frame-property frame 'background-mode) ! (custom-background-mode frame)))))) (defconst custom-face-attributes '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold) --- 166,172 ---- 'class (frame-property frame 'display-type) 'background (or custom-background-mode (frame-property frame 'background-mode) ! (custom-background-mode frame)))))) (defconst custom-face-attributes '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold) *************** *** 175,186 **** (toggle :format "Underline: %[%v%]\n") set-face-underline-p) (:foreground (color :tag "Foreground") set-face-foreground) (:background (color :tag "Background") set-face-background) ! (:reverse (const :format "Reverse Video\n" t) (lambda (face value &optional frame) ;; We don't use VALUE. (reverse-face face frame))) (:stipple (editable-field :format "Stipple: %v") set-face-stipple)) ! "Alist of face attributes. The elements are of the form (KEY TYPE SET) where KEY is a symbol identifying the attribute, TYPE is a widget type for editing the --- 175,186 ---- (toggle :format "Underline: %[%v%]\n") set-face-underline-p) (:foreground (color :tag "Foreground") set-face-foreground) (:background (color :tag "Background") set-face-background) ! (:reverse (const :format "Reverse Video\n" t) (lambda (face value &optional frame) ;; We don't use VALUE. (reverse-face face frame))) (:stipple (editable-field :format "Stipple: %v") set-face-stipple)) ! "Alist of face attributes. The elements are of the form (KEY TYPE SET) where KEY is a symbol identifying the attribute, TYPE is a widget type for editing the *************** *** 229,235 **** Each keyword should be listed in `custom-face-attributes'. If FRAME is nil, set the default face." ! (while atts (let* ((name (nth 0 atts)) (value (nth 1 atts)) (fun (nth 2 (assq name custom-face-attributes)))) --- 229,235 ---- Each keyword should be listed in `custom-face-attributes'. If FRAME is nil, set the default face." ! (while atts (let* ((name (nth 0 atts)) (value (nth 1 atts)) (fun (nth 2 (assq name custom-face-attributes)))) *************** *** 273,279 **** (apply 'set-face-font face fontobj args))) (nconc custom-face-attributes ! '((:family (editable-field :format "Family: %v") custom-set-face-font-family) (:size (editable-field :format "Size: %v") custom-set-face-font-size)))) --- 273,279 ---- (apply 'set-face-font face fontobj args))) (nconc custom-face-attributes ! '((:family (editable-field :format "Family: %v") custom-set-face-font-family) (:size (editable-field :format "Size: %v") custom-set-face-font-size)))) *************** *** 285,291 **** Iff optional FRAME is non-nil, set it for that frame only. See `defface' for information about SPEC." (when (fboundp 'make-face) ! (while spec (let* ((entry (car spec)) (display (nth 0 entry)) (atts (nth 1 entry))) --- 285,291 ---- Iff optional FRAME is non-nil, set it for that frame only. See `defface' for information about SPEC." (when (fboundp 'make-face) ! (while spec (let* ((entry (car spec)) (display (nth 0 entry)) (atts (nth 1 entry))) *************** *** 300,306 **** (defun custom-background-mode (frame) "Kludge to detect background mode for FRAME." ! (let* ((bg-resource (condition-case () (x-get-resource ".backgroundMode" "BackgroundMode" 'string) (error nil))) --- 300,306 ---- (defun custom-background-mode (frame) "Kludge to detect background mode for FRAME." ! (let* ((bg-resource (condition-case () (x-get-resource ".backgroundMode" "BackgroundMode" 'string) (error nil))) *************** *** 328,334 **** (defvar custom-default-frame-properties nil "The frame properties used for the global faces. Frames who doesn't match these propertiess should have frame local faces. ! The value should be nil, if uninitialized, or a plist otherwise. See `defface' for a list of valid keys and values for the plist.") (defun custom-get-frame-properties (&optional frame) --- 328,334 ---- (defvar custom-default-frame-properties nil "The frame properties used for the global faces. Frames who doesn't match these propertiess should have frame local faces. ! The value should be nil, if uninitialized, or a plist otherwise. See `defface' for a list of valid keys and values for the plist.") (defun custom-get-frame-properties (&optional frame) *************** *** 341,347 **** ;; Oh well, get it then. (setq cache (custom-extract-frame-properties frame)) ;; and cache it... ! (modify-frame-parameters frame (list (cons 'custom-properties cache)))) cache)) (custom-default-frame-properties) --- 341,347 ---- ;; Oh well, get it then. (setq cache (custom-extract-frame-properties frame)) ;; and cache it... ! (modify-frame-parameters frame (list (cons 'custom-properties cache)))) cache)) (custom-default-frame-properties) *************** *** 374,380 **** ((eq req 'background) (memq background options)) (t ! (error "Unknown req `%S' with options `%S'" req options))))) match))) --- 374,380 ---- ((eq req 'background) (memq background options)) (t ! (error "Unknown req `%S' with options `%S'" req options))))) match))) *************** *** 397,403 **** (mapcar (lambda (symbol) (let ((spec (or (get symbol 'saved-face) (get symbol 'factory-face)))) ! (when spec (custom-face-display-set symbol spec frame) (initialize-face-resources symbol frame)))) (face-list))) --- 397,403 ---- (mapcar (lambda (symbol) (let ((spec (or (get symbol 'saved-face) (get symbol 'factory-face)))) ! (when spec (custom-face-display-set symbol spec frame) (initialize-face-resources symbol frame)))) (face-list))) *************** *** 407,413 **** If FRAME is missing or nil, the first member (frame-list) is used." (unless frame (setq frame (car (frame-list)))) ! (unless (equal (custom-get-frame-properties) (custom-get-frame-properties frame)) (custom-initialize-faces frame))) --- 407,413 ---- If FRAME is missing or nil, the first member (frame-list) is used." (unless frame (setq frame (car (frame-list)))) ! (unless (equal (custom-get-frame-properties) (custom-get-frame-properties frame)) (custom-initialize-faces frame))) *** pub/rgnus/lisp/custom.el Thu Mar 6 08:47:24 1997 --- rgnus/lisp/custom.el Fri Mar 7 23:51:14 1997 *************** *** 13,19 **** ;; ;; This file only contain the code needed to declare and initialize ;; user options. The code to customize options is autoloaded from ! ;; `cus-edit.el'. ;; The code implementing face declarations is in `cus-face.el' --- 13,19 ---- ;; ;; This file only contain the code needed to declare and initialize ;; user options. The code to customize options is autoloaded from ! ;; `cus-edit.el'. ;; The code implementing face declarations is in `cus-face.el' *************** *** 51,57 **** (put symbol 'factory-value (list value)) (when doc (put symbol 'variable-documentation doc)) ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) --- 51,57 ---- (put symbol 'factory-value (list value)) (when doc (put symbol 'variable-documentation doc)) ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) *************** *** 85,97 **** If SYMBOL is not already bound, initialize it to VALUE. The remaining arguments should have the form ! [KEYWORD VALUE]... The following KEYWORD's are defined: :type VALUE should be a widget type. :options VALUE should be a list of valid members of the widget type. ! :group VALUE should be a customization group. Add SYMBOL to that group. Read the section about customization in the emacs lisp manual for more --- 85,97 ---- If SYMBOL is not already bound, initialize it to VALUE. The remaining arguments should have the form ! [KEYWORD VALUE]... The following KEYWORD's are defined: :type VALUE should be a widget type. :options VALUE should be a list of valid members of the widget type. ! :group VALUE should be a customization group. Add SYMBOL to that group. Read the section about customization in the emacs lisp manual for more *************** *** 155,161 **** (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) --- 155,161 ---- (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) *************** *** 186,192 **** The remaining arguments should have the form ! [KEYWORD VALUE]... The following KEYWORD's are defined: --- 186,192 ---- The remaining arguments should have the form ! [KEYWORD VALUE]... The following KEYWORD's are defined: *************** *** 211,217 **** (defun custom-handle-all-keywords (symbol args type) "For customization option SYMBOL, handle keyword arguments ARGS. Third argument TYPE is the custom option type." ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) --- 211,217 ---- (defun custom-handle-all-keywords (symbol args type) "For customization option SYMBOL, handle keyword arguments ARGS. Third argument TYPE is the custom option type." ! (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) *************** *** 221,227 **** (unless args (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) ! (custom-handle-keyword symbol keyword value type))))) (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. --- 221,227 ---- (unless args (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) ! (custom-handle-keyword symbol keyword value type))))) (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. *************** *** 235,241 **** ((eq keyword :tag) (put symbol 'custom-tag value)) (t ! (error "Unknown keyword %s" symbol)))) (defun custom-add-option (symbol option) "To the variable SYMBOL add OPTION. --- 235,241 ---- ((eq keyword :tag) (put symbol 'custom-tag value)) (t ! (error "Unknown keyword %s" symbol)))) (defun custom-add-option (symbol option) "To the variable SYMBOL add OPTION. *************** *** 262,268 **** ;;; Initializing. (defun custom-set-variables (&rest args) ! "Initialize variables according to user preferences. The arguments should be a list where each entry has the form: --- 262,268 ---- ;;; Initializing. (defun custom-set-variables (&rest args) ! "Initialize variables according to user preferences. The arguments should be a list where each entry has the form: *************** *** 271,284 **** The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as the default value for the SYMBOL." ! (while args (let ((entry (car args))) (if (listp entry) (let ((symbol (nth 0 entry)) (value (nth 1 entry)) (now (nth 2 entry))) (put symbol 'saved-value (list value)) ! (when now (put symbol 'force-value t) (set-default symbol (eval value))) (setq args (cdr args))) --- 271,284 ---- The unevaluated VALUE is stored as the saved value for SYMBOL. If NOW is present and non-nil, VALUE is also evaluated and bound as the default value for the SYMBOL." ! (while args (let ((entry (car args))) (if (listp entry) (let ((symbol (nth 0 entry)) (value (nth 1 entry)) (now (nth 2 entry))) (put symbol 'saved-value (list value)) ! (when now (put symbol 'force-value t) (set-default symbol (eval value))) (setq args (cdr args))) *** pub/rgnus/lisp/dgnushack.el Fri Mar 7 07:36:59 1997 --- rgnus/lisp/dgnushack.el Fri Mar 7 23:51:14 1997 *************** *** 47,53 **** (fset 'x-defined-colors 'ignore) (fset 'read-color 'ignore))) ! (setq byte-compile-warnings '(free-vars unresolved callargs redefine)) (defun dgnushack-compile () --- 47,53 ---- (fset 'x-defined-colors 'ignore) (fset 'read-color 'ignore))) ! (setq byte-compile-warnings '(free-vars unresolved callargs redefine)) (defun dgnushack-compile () *************** *** 60,66 **** (require 'w3-forms) (error (setq files (delete "nnweb.el" files)))) (while (setq file (pop files)) ! (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el" "nnheaderxm.el" "smiley.el"))) xemacs) --- 60,66 ---- (require 'w3-forms) (error (setq files (delete "nnweb.el" files)))) (while (setq file (pop files)) ! (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el" "nnheaderxm.el" "smiley.el"))) xemacs) *************** *** 73,77 **** (require 'gnus) (byte-recompile-directory "." 0)) ! ;;; dgnushack.el ends here --- 73,77 ---- (require 'gnus) (byte-recompile-directory "." 0)) ! ;;; dgnushack.el ends here *** pub/rgnus/lisp/earcon.el Thu Dec 5 18:45:43 1996 --- rgnus/lisp/earcon.el Fri Mar 7 23:51:14 1997 *************** *** 142,148 **** gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) --- 142,148 ---- gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) *** pub/rgnus/lisp/gnus-art.el Fri Mar 7 07:37:00 1997 --- rgnus/lisp/gnus-art.el Fri Mar 7 23:51:15 1997 *************** *** 92,98 **** '("^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." --- 92,98 ---- '("^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." *************** *** 101,107 **** (repeat regexp)) :group 'gnus-article-hiding) ! (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-From" "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. --- 101,107 ---- (repeat regexp)) :group 'gnus-article-hiding) ! (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-From" "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. *************** *** 156,162 **** (defcustom gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text." ! :type 'sexp :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command --- 156,162 ---- (defcustom gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text." ! :type 'sexp :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command *************** *** 232,238 **** "Face used for displaying bold italic emphasized text (/*word*/)." :group 'gnus-article-emphasis) ! (defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. Esample: (_/*word*/_)." --- 232,238 ---- "Face used for displaying bold italic emphasized text (/*word*/)." :group 'gnus-article-emphasis) ! (defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. Esample: (_/*word*/_)." *************** *** 416,468 **** :group 'gnus-article-highlight :group 'gnus-article-signature) ! (defface gnus-header-from-face '((((class color) (background dark)) ! (:foreground "light blue" :bold t :italic t)) (((class color) (background light)) (:foreground "MidnightBlue" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-subject-face '((((class color) (background dark)) ! (:foreground "pink" :bold t :italic t)) (((class color) (background light)) (:foreground "firebrick" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-newsgroups-face '((((class color) (background dark)) (:foreground "yellow" :bold t :italic t)) (((class color) (background light)) (:foreground "indianred" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying newsgroups headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-name-face '((((class color) (background dark)) ! (:foreground "cyan" :bold t)) (((class color) (background light)) (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for displaying header names." :group 'gnus-article-headers --- 416,468 ---- :group 'gnus-article-highlight :group 'gnus-article-signature) ! (defface gnus-header-from-face '((((class color) (background dark)) ! (:foreground "green1" :bold t :italic t)) (((class color) (background light)) (:foreground "MidnightBlue" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-subject-face '((((class color) (background dark)) ! (:foreground "green3" :bold t :italic t)) (((class color) (background light)) (:foreground "firebrick" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-newsgroups-face '((((class color) (background dark)) (:foreground "yellow" :bold t :italic t)) (((class color) (background light)) (:foreground "indianred" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying newsgroups headers." :group 'gnus-article-headers :group 'gnus-article-highlight) ! (defface gnus-header-name-face '((((class color) (background dark)) ! (:foreground "green4" :bold t)) (((class color) (background light)) (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for displaying header names." :group 'gnus-article-headers *************** *** 475,481 **** (((class color) (background light)) (:foreground "DarkGreen" :italic t)) ! (t (:italic t))) "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) --- 475,481 ---- (((class color) (background light)) (:foreground "DarkGreen" :italic t)) ! (t (:italic t))) "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) *************** *** 487,493 **** ("" gnus-header-name-face gnus-header-content-face)) "Controls highlighting of article header. ! An alist of the form (HEADER NAME CONTENT). HEADER is a regular expression which should match the name of an header header and NAME and CONTENT are either face names or nil. --- 487,493 ---- ("" gnus-header-name-face gnus-header-content-face)) "Controls highlighting of article header. ! An alist of the form (HEADER NAME CONTENT). HEADER is a regular expression which should match the name of an header header and NAME and CONTENT are either face names or nil. *************** *** 530,536 **** "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))))) --- 530,536 ---- "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))))) *************** *** 645,660 **** (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 --- 645,660 ---- (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 *************** *** 688,694 **** (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) --- 688,694 ---- (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) *************** *** 712,718 **** (when (and from reply-to (ignore-errors ! (equal (nth 1 (mail-extract-address-components from)) (nth 1 (mail-extract-address-components reply-to))))) (gnus-article-hide-header "reply-to")))) --- 712,718 ---- (when (and from reply-to (ignore-errors ! (equal (nth 1 (mail-extract-address-components from)) (nth 1 (mail-extract-address-components reply-to))))) (gnus-article-hide-header "reply-to")))) *************** *** 729,735 **** (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) --- 729,735 ---- (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) *************** *** 748,754 **** ;; 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)) --- 748,754 ---- ;; 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)) *************** *** 858,871 **** (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))) --- 858,871 ---- (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))) *************** *** 893,899 **** (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") --- 893,899 ---- (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") *************** *** 944,950 **** (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)))))) --- 944,950 ---- (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)))))) *************** *** 986,992 **** (save-restriction (let ((buffer-read-only nil)) (when (gnus-article-narrow-to-signature) ! (gnus-article-hide-text-type (point-min) (point-max) 'signature))))))) (defun article-strip-leading-blank-lines () --- 986,992 ---- (save-restriction (let ((buffer-read-only nil)) (when (gnus-article-narrow-to-signature) ! (gnus-article-hide-text-type (point-min) (point-max) 'signature))))))) (defun article-strip-leading-blank-lines () *************** *** 1038,1044 **** (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 --- 1038,1044 ---- (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 *************** *** 1172,1178 **** 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") "")) --- 1172,1178 ---- 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") "")) *************** *** 1279,1285 **** (prog1 (concat (if prev ", " "") (int-to-string (floor num)) ! " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) article-time-units "") --- 1279,1285 ---- (prog1 (concat (if prev ", " "") (int-to-string (floor num)) ! " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) article-time-units "") *************** *** 1380,1386 **** (when (eq gnus-prompt-before-saving t) num))) ; Magic (set-buffer gnus-summary-buffer) ! (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt default-name &optional filename) (cond --- 1380,1386 ---- (when (eq gnus-prompt-before-saving t) num))) ; Magic (set-buffer gnus-summary-buffer) ! (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt default-name &optional filename) (cond *************** *** 1552,1558 **** (cond ((eq command 'default) gnus-last-shell-command) (command command) ! (t (read-string (format "Shell command on %s: " (if (and gnus-number-of-articles-to-be-saved --- 1552,1558 ---- (cond ((eq command 'default) gnus-last-shell-command) (command command) ! (t (read-string (format "Shell command on %s: " (if (and gnus-number-of-articles-to-be-saved *************** *** 1644,1650 **** gfunc (cdr func)) (setq afunc func gfunc (intern (format "gnus-%s" func)))) ! (fset gfunc (if (not (fboundp afunc)) nil `(lambda (&optional interactive &rest args) --- 1644,1650 ---- gfunc (cdr func)) (setq afunc func gfunc (intern (format "gnus-%s" func)))) ! (fset gfunc (if (not (fboundp afunc)) nil `(lambda (&optional interactive &rest args) *************** *** 2243,2249 **** (set-buffer gnus-summary-buffer) (let ((header (gnus-summary-article-header article))) (when (< article 0) ! (cond ((memq article gnus-newsgroup-sparse) ;; This is a sparse gap article. (setq do-update-line article) --- 2243,2249 ---- (set-buffer gnus-summary-buffer) (let ((header (gnus-summary-article-header article))) (when (< article 0) ! (cond ((memq article gnus-newsgroup-sparse) ;; This is a sparse gap article. (setq do-update-line article) *************** *** 2259,2266 **** ;; It is an extracted pseudo-article. (setq article 'pseudo) (gnus-request-pseudo-article header)))) ! ! (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (not (eq (car method) 'nneething)) () --- 2259,2266 ---- ;; It is an extracted pseudo-article. (setq article 'pseudo) (gnus-request-pseudo-article header)))) ! ! (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (not (eq (car method) 'nneething)) () *************** *** 2314,2320 **** (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) (when gnus-keep-backlog ! (gnus-backlog-enter-article group article (current-buffer)))) 'article))) ;; It was a pseudo. --- 2314,2320 ---- (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) (when gnus-keep-backlog ! (gnus-backlog-enter-article group article (current-buffer)))) 'article))) ;; It was a pseudo. *************** *** 2338,2344 **** (erase-buffer) (insert-buffer-substring gnus-article-buffer)) (setq gnus-original-article (cons group article)))) ! ;; Update sparse articles. (when (and do-update-line (or (numberp article) --- 2338,2344 ---- (erase-buffer) (insert-buffer-substring gnus-article-buffer)) (setq gnus-original-article (cons group article)))) ! ;; Update sparse articles. (when (and do-update-line (or (numberp article) *************** *** 2364,2370 **** (defvar gnus-article-edit-mode-map nil) ! (unless gnus-article-edit-mode-map (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) (gnus-define-keys gnus-article-edit-mode-map --- 2364,2370 ---- (defvar gnus-article-edit-mode-map nil) ! (unless gnus-article-edit-mode-map (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) (gnus-define-keys gnus-article-edit-mode-map *************** *** 2447,2456 **** (gnus-article-mode) ;; The cache and backlog have to be flushed somewhat. (when gnus-use-cache ! (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))) (when gnus-keep-backlog ! (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) ;; Flush original article as well. (save-excursion --- 2447,2456 ---- (gnus-article-mode) ;; The cache and backlog have to be flushed somewhat. (when gnus-use-cache ! (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))) (when gnus-keep-backlog ! (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) ;; Flush original article as well. (save-excursion *************** *** 2464,2470 **** (set-window-start (get-buffer-window (current-buffer)) window-start) (goto-char p) (set-buffer buf))))) ! (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." (interactive) --- 2464,2470 ---- (set-window-start (get-buffer-window (current-buffer)) window-start) (goto-char p) (set-buffer buf))))) ! (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." (interactive) *************** *** 2474,2480 **** (let ((case-fold-search nil)) (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) ! ;;; ;;; Article highlights ;;; --- 2474,2480 ---- (let ((case-fold-search nil)) (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) ! ;;; ;;; Article highlights ;;; *************** *** 2487,2500 **** :group 'gnus-article-buttons :type 'regexp) ! (defcustom gnus-button-alist `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) ! ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2) --- 2487,2500 ---- :group 'gnus-article-buttons :type 'regexp) ! (defcustom gnus-button-alist `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) ! ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2) *************** *** 2508,2521 **** REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to ! be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons ! :type '(repeat (list regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") --- 2508,2521 ---- REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to ! be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons ! :type '(repeat (list regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") *************** *** 2523,2533 **** :inline t (integer :tag "Regexp group"))))) ! (defcustom gnus-header-button-alist `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" 0 t gnus-button-message-id 0) ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) ! ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) --- 2523,2533 ---- :inline t (integer :tag "Regexp group"))))) ! (defcustom gnus-header-button-alist `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" 0 t gnus-button-message-id 0) ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) ! ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) *************** *** 2545,2551 **** :group 'gnus-article-buttons :group 'gnus-article-headers :type '(repeat (list (regexp :tag "Header") ! regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") --- 2545,2551 ---- :group 'gnus-article-buttons :group 'gnus-article-headers :type '(repeat (list (regexp :tag "Header") ! regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") *************** *** 2621,2627 **** (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', ! `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." (interactive (list 'force)) --- 2621,2627 ---- (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', ! `gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." (interactive (list 'force)) *************** *** 2685,2691 **** (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after ! `gnus-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) --- 2685,2691 ---- (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after ! `gnus-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) *************** *** 2714,2735 **** (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) - ;; Remove all old markers. - (let (marker entry) - (while (setq marker (pop gnus-button-marker-list)) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) ! (goto-char (point-min)) ;; We skip the headers. (unless (search-forward "\n\n" nil t) (goto-char (point-max))) (setq beg (point)) --- 2714,2735 ---- (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) ! ;; Remove all old markers. ! (let (marker entry) ! (while (setq marker (pop gnus-button-marker-list)) ! (goto-char marker) ! (when (setq entry (gnus-button-entry)) ! (put-text-property (match-beginning (nth 1 entry)) ! (match-end (nth 1 entry)) ! 'gnus-callback nil)) ! (set-marker marker nil))) ;; We skip the headers. + (goto-char (point-min)) (unless (search-forward "\n\n" nil t) (goto-char (point-max))) (setq beg (point)) *************** *** 2746,2753 **** start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the ;; button. ! (gnus-article-add-button ! start end 'gnus-button-push (car (push (set-marker (make-marker) from) gnus-button-marker-list)))))))))) --- 2746,2753 ---- start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the ;; button. ! (gnus-article-add-button ! start end 'gnus-button-push (car (push (set-marker (make-marker) from) gnus-button-marker-list)))))))))) *************** *** 2783,2789 **** (form (nth 2 entry))) (goto-char (match-end 0)) (when (eval form) ! (gnus-article-add-button start end (nth 3 entry) (buffer-substring (match-beginning (nth 4 entry)) (match-end (nth 4 entry))))))) --- 2783,2789 ---- (form (nth 2 entry))) (goto-char (match-end 0)) (when (eval form) ! (gnus-article-add-button start end (nth 3 entry) (buffer-substring (match-beginning (nth 4 entry)) (match-end (nth 4 entry))))))) *************** *** 2797,2803 **** (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) --- 2797,2803 ---- (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) *************** *** 2879,2885 **** (setq parts (cons (substring string start (match-beginning 0)) parts) start (match-end 0))) (nreverse (cons (substring string start) parts)))) ! (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (gnus-split-string query "&")) --- 2879,2885 ---- (setq parts (cons (substring string start (match-beginning 0)) parts) start (match-end 0))) (nreverse (cons (substring string start) parts)))) ! (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (gnus-split-string query "&")) *************** *** 2897,2910 **** (setcdr cur (cons val (cdr cur))) (setq retval (cons (list key val) retval))))) retval)) ! (defun gnus-url-unhex (x) (if (> x ?9) (if (>= x ?a) (+ 10 (- x ?a)) (+ 10 (- x ?A))) (- x ?0))) ! (defun gnus-url-unhex-string (str &optional allow-newlines) "Remove %XXX embedded spaces, etc in a url. If optional second argument ALLOW-NEWLINES is non-nil, then allow the --- 2897,2910 ---- (setcdr cur (cons val (cdr cur))) (setq retval (cons (list key val) retval))))) retval)) ! (defun gnus-url-unhex (x) (if (> x ?9) (if (>= x ?a) (+ 10 (- x ?a)) (+ 10 (- x ?A))) (- x ?0))) ! (defun gnus-url-unhex-string (str &optional allow-newlines) "Remove %XXX embedded spaces, etc in a url. If optional second argument ALLOW-NEWLINES is non-nil, then allow the *************** *** 2918,2924 **** (ch1 (gnus-url-unhex (elt str (+ start 1)))) (code (+ (* 16 ch1) (gnus-url-unhex (elt str (+ start 2)))))) ! (setq tmp (concat tmp (substring str 0 start) (cond (allow-newlines --- 2918,2924 ---- (ch1 (gnus-url-unhex (elt str (+ start 1)))) (code (+ (* 16 ch1) (gnus-url-unhex (elt str (+ start 2)))))) ! (setq tmp (concat tmp (substring str 0 start) (cond (allow-newlines *************** *** 2929,2935 **** str (substring str (match-end 0))))) (setq tmp (concat tmp str)) tmp)) ! (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) --- 2929,2935 ---- str (substring str (match-end 0))))) (setq tmp (concat tmp str)) tmp)) ! (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) *************** *** 2984,2990 **** (defun gnus-insert-prev-page-button () (let ((buffer-read-only nil)) ! (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map gnus-callback gnus-article-button-prev-page)))) --- 2984,2990 ---- (defun gnus-insert-prev-page-button () (let ((buffer-read-only nil)) ! (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map gnus-callback gnus-article-button-prev-page)))) *************** *** 3016,3022 **** (let ((buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil `(gnus-next t local-map ,gnus-next-page-map ! gnus-callback gnus-article-button-next-page)))) (defun gnus-article-button-next-page (arg) --- 3016,3022 ---- (let ((buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil `(gnus-next t local-map ,gnus-next-page-map ! gnus-callback gnus-article-button-next-page)))) (defun gnus-article-button-next-page (arg) *************** *** 3033,3039 **** (let ((win (selected-window))) (select-window (get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) ! (select-window win))) (gnus-ems-redefine) --- 3033,3039 ---- (let ((win (selected-window))) (select-window (get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) ! (select-window win))) (gnus-ems-redefine) *** pub/rgnus/lisp/gnus-async.el Thu Jan 9 11:59:43 1997 --- rgnus/lisp/gnus-async.el Fri Mar 7 23:51:15 1997 *************** *** 50,56 **** (defcustom gnus-prefetched-article-deletion-strategy '(read exit) "List of symbols that say when to remove articles from the prefetch buffer. ! Possible values in this list are `read', which means that articles are removed as they are read, and `exit', which means that all articles belonging to a group are removed on exit from that group." --- 50,56 ---- (defcustom gnus-prefetched-article-deletion-strategy '(read exit) "List of symbols that say when to remove articles from the prefetch buffer. ! Possible values in this list are `read', which means that articles are removed as they are read, and `exit', which means that all articles belonging to a group are removed on exit from that group." *************** *** 105,111 **** (put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) (put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) ! ;;; ;;; Article prefetch ;;; --- 105,111 ---- (put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) (put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) ! ;;; ;;; Article prefetch ;;; *************** *** 138,144 **** ;; do this, which leads to slightly slower article ;; buffer display. (gnus-async-prefetch-article group next summary) ! (run-with-idle-timer 0.1 nil 'gnus-async-prefetch-article group next summary))))))) (defun gnus-async-prefetch-article (group article summary &optional next) --- 138,144 ---- ;; do this, which leads to slightly slower article ;; buffer display. (gnus-async-prefetch-article group next summary) ! (run-with-idle-timer 0.1 nil 'gnus-async-prefetch-article group next summary))))))) (defun gnus-async-prefetch-article (group article summary &optional next) *************** *** 181,187 **** (when do-fetch (setq article (car gnus-async-fetch-list)))) ! (when (and do-fetch article) ;; We want to fetch some more articles. (save-excursion --- 181,187 ---- (when do-fetch (setq article (car gnus-async-fetch-list)))) ! (when (and do-fetch article) ;; We want to fetch some more articles. (save-excursion *************** *** 191,199 **** (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function ! (gnus-make-async-article-function group article mark summary next)) ! (nntp-server-buffer (get-buffer gnus-async-prefetch-article-buffer))) (when do-message (gnus-message 7 "Prefetching article %d in group %s" --- 191,199 ---- (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function ! (gnus-make-async-article-function group article mark summary next)) ! (nntp-server-buffer (get-buffer gnus-async-prefetch-article-buffer))) (when do-message (gnus-message 7 "Prefetching article %d in group %s" *************** *** 240,246 **** (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) (gnus-async-with-semaphore ! (setq gnus-async-article-alist (delq entry gnus-async-article-alist)))) (defun gnus-async-prefetch-remove-group (group) --- 240,246 ---- (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) (gnus-async-with-semaphore ! (setq gnus-async-article-alist (delq entry gnus-async-article-alist)))) (defun gnus-async-prefetch-remove-group (group) *************** *** 254,260 **** (when (equal group (nth 3 (car alist))) (gnus-async-delete-prefected-entry (car alist))) (pop alist)))))) ! (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)) --- 254,260 ---- (when (equal group (nth 3 (car alist))) (gnus-async-delete-prefected-entry (car alist))) (pop alist)))))) ! (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)) *************** *** 266,272 **** (ignore-errors (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) ! (setq gnus-async-article-alist (delq entry gnus-async-article-alist)) nil) entry))) --- 266,272 ---- (ignore-errors (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) ! (setq gnus-async-article-alist (delq entry gnus-async-article-alist)) nil) entry))) *************** *** 309,315 **** (erase-buffer) (setq gnus-async-header-prefetched nil) t))) ! (provide 'gnus-async) ;;; gnus-async.el ends here --- 309,315 ---- (erase-buffer) (setq gnus-async-header-prefetched nil) t))) ! (provide 'gnus-async) ;;; gnus-async.el ends here *** pub/rgnus/lisp/gnus-cache.el Thu Jan 9 11:59:43 1997 --- rgnus/lisp/gnus-cache.el Fri Mar 7 23:51:15 1997 *************** *** 42,48 **** :group 'gnus-cache :type 'directory) ! (defcustom gnus-cache-active-file (concat (file-name-as-directory gnus-cache-directory) "active") "*The cache active file." :group 'gnus-cache --- 42,48 ---- :group 'gnus-cache :type 'directory) ! (defcustom gnus-cache-active-file (concat (file-name-as-directory gnus-cache-directory) "active") "*The cache active file." :group 'gnus-cache *************** *** 129,135 **** (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) ! (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) --- 129,135 ---- (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) ! (defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) *************** *** 138,144 **** ; This might be a dummy article. ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) headers (copy-sequence headers)) --- 138,144 ---- ; This might be a dummy article. ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) headers (copy-sequence headers)) *************** *** 258,264 **** (when (equal group "no.norsk") (error "hie")) (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) ! (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active --- 258,264 ---- (when (equal group "no.norsk") (error "hie")) (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) ! (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active *************** *** 267,273 **** (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." ! (let ((cached (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) (if (not cached) ;; No cached articles here, so we just retrieve them --- 267,273 ---- (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." ! (let ((cached (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) (if (not cached) ;; No cached articles here, so we just retrieve them *************** *** 279,290 **** articles)) (cache-file (gnus-cache-file-name group ".overview")) type) ! ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) (when uncached-articles ! (setq type (and articles ! (gnus-retrieve-headers uncached-articles group fetch-old))))) (gnus-cache-save-buffers) ;; Then we insert the cached headers. --- 279,290 ---- articles)) (cache-file (gnus-cache-file-name group ".overview")) type) ! ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) (when uncached-articles ! (setq type (and articles ! (gnus-retrieve-headers uncached-articles group fetch-old))))) (gnus-cache-save-buffers) ;; Then we insert the cached headers. *************** *** 294,300 **** ;; There are no cached headers. type) ((null type) ! ;; There were no uncached headers (or retrieval was ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) --- 294,300 ---- ;; There are no cached headers. type) ((null type) ! ;; There were no uncached headers (or retrieval was ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) *************** *** 321,328 **** article out) (while (setq article (pop articles)) (if (natnump article) ! (when (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t) (push article out)) --- 321,328 ---- article out) (while (setq article (pop articles)) (if (natnump article) ! (when (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t) (push article out)) *************** *** 387,393 **** (let ((file (gnus-cache-file-name group ".overview"))) (when (file-exists-p file) (nnheader-insert-file-contents file))) ! ;; We have a fresh (empty/just loaded) buffer, ;; mark it as unmodified to save a redundant write later. (set-buffer-modified-p nil)))) --- 387,393 ---- (let ((file (gnus-cache-file-name group ".overview"))) (when (file-exists-p file) (nnheader-insert-file-contents file))) ! ;; We have a fresh (empty/just loaded) buffer, ;; mark it as unmodified to save a redundant write later. (set-buffer-modified-p nil)))) *************** *** 415,425 **** "If ARTICLE is in the cache, remove it and re-enter it." (when (gnus-cache-possibly-remove-article article nil nil nil t) (let ((gnus-use-cache nil)) ! (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t)))) ! (defun gnus-cache-possibly-remove-article (article ticked dormant unread &optional force) "Possibly remove ARTICLE from the cache." (let ((group gnus-newsgroup-name) --- 415,425 ---- "If ARTICLE is in the cache, remove it and re-enter it." (when (gnus-cache-possibly-remove-article article nil nil nil t) (let ((gnus-use-cache nil)) ! (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t)))) ! (defun gnus-cache-possibly-remove-article (article ticked dormant unread &optional force) "Possibly remove ARTICLE from the cache." (let ((group gnus-newsgroup-name) *************** *** 427,433 **** file) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) number (cdr result)))) --- 427,433 ---- file) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) number (cdr result)))) *************** *** 539,546 **** (gnus) ;; Go through all groups... (gnus-group-mark-buffer) ! (gnus-group-universal-argument ! nil nil (lambda () (interactive) (gnus-summary-read-group (gnus-group-group-name) nil t) --- 539,546 ---- (gnus) ;; Go through all groups... (gnus-group-mark-buffer) ! (gnus-group-universal-argument ! nil nil (lambda () (interactive) (gnus-summary-read-group (gnus-group-group-name) nil t) *************** *** 562,572 **** (gnus-set-work-buffer) (insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format ! nil (setq gnus-cache-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))) (setq gnus-cache-active-altered nil)))) ! (defun gnus-cache-write-active (&optional force) "Write the active hashtb to the active file." (when (or force --- 562,572 ---- (gnus-set-work-buffer) (insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format ! nil (setq gnus-cache-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))) (setq gnus-cache-active-altered nil)))) ! (defun gnus-cache-write-active (&optional force) "Write the active hashtb to the active file." (when (or force *************** *** 604,617 **** (let* ((top (null directory)) (directory (expand-file-name (or directory gnus-cache-directory))) (files (directory-files directory 'full)) ! (group (if top "" ! (string-match (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) (directory-file-name directory)) ! (nnheader-replace-chars-in-string (substring (directory-file-name directory) (match-end 0)) ?/ ?.))) nums alphs) --- 604,617 ---- (let* ((top (null directory)) (directory (expand-file-name (or directory gnus-cache-directory))) (files (directory-files directory 'full)) ! (group (if top "" ! (string-match (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) (directory-file-name directory)) ! (nnheader-replace-chars-in-string (substring (directory-file-name directory) (match-end 0)) ?/ ?.))) nums alphs) *************** *** 654,658 **** (rename-file gnus-cache-directory dir)) (provide 'gnus-cache) ! ;;; gnus-cache.el ends here --- 654,658 ---- (rename-file gnus-cache-directory dir)) (provide 'gnus-cache) ! ;;; gnus-cache.el ends here *** pub/rgnus/lisp/gnus-cite.el Sun Mar 2 04:47:13 1997 --- rgnus/lisp/gnus-cite.el Fri Mar 7 23:51:16 1997 *************** *** 68,74 **** :type '(choice (const :tag "all" nil) integer)) ! (defcustom gnus-cite-prefix-regexp "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" "Regexp matching the longest possible citation prefix on a line." :group 'gnus-cite --- 68,74 ---- :type '(choice (const :tag "all" nil) integer)) ! (defcustom gnus-cite-prefix-regexp "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" "Regexp matching the longest possible citation prefix on a line." :group 'gnus-cite *************** *** 79,85 **** :group 'gnus-cite :type 'integer) ! (defcustom gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "Regexp matching normal Supercite attribution lines. --- 79,85 ---- :group 'gnus-cite :type 'integer) ! (defcustom gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "Regexp matching normal Supercite attribution lines. *************** *** 110,116 **** :group 'gnus-cite :type 'regexp) ! (defface gnus-cite-attribution-face '((t (:underline t))) "Face used for attribution lines.") --- 110,116 ---- :group 'gnus-cite :type 'regexp) ! (defface gnus-cite-attribution-face '((t (:underline t))) "Face used for attribution lines.") *************** *** 126,132 **** (((class color) (background light)) (:foreground "MidnightBlue")) ! (t (:italic t))) "Citation face.") --- 126,132 ---- (((class color) (background light)) (:foreground "MidnightBlue")) ! (t (:italic t))) "Citation face.") *************** *** 136,142 **** (((class color) (background light)) (:foreground "firebrick")) ! (t (:italic t))) "Citation face.") --- 136,142 ---- (((class color) (background light)) (:foreground "firebrick")) ! (t (:italic t))) "Citation face.") *************** *** 146,152 **** (((class color) (background light)) (:foreground "dark green")) ! (t (:italic t))) "Citation face.") --- 146,152 ---- (((class color) (background light)) (:foreground "dark green")) ! (t (:italic t))) "Citation face.") *************** *** 156,162 **** (((class color) (background light)) (:foreground "OrangeRed")) ! (t (:italic t))) "Citation face.") --- 156,162 ---- (((class color) (background light)) (:foreground "OrangeRed")) ! (t (:italic t))) "Citation face.") *************** *** 166,172 **** (((class color) (background light)) (:foreground "dark khaki")) ! (t (:italic t))) "Citation face.") --- 166,172 ---- (((class color) (background light)) (:foreground "dark khaki")) ! (t (:italic t))) "Citation face.") *************** *** 176,182 **** (((class color) (background light)) (:foreground "dark violet")) ! (t (:italic t))) "Citation face.") --- 176,182 ---- (((class color) (background light)) (:foreground "dark violet")) ! (t (:italic t))) "Citation face.") *************** *** 186,192 **** (((class color) (background light)) (:foreground "SteelBlue4")) ! (t (:italic t))) "Citation face.") --- 186,192 ---- (((class color) (background light)) (:foreground "SteelBlue4")) ! (t (:italic t))) "Citation face.") *************** *** 196,202 **** (((class color) (background light)) (:foreground "magenta")) ! (t (:italic t))) "Citation face.") --- 196,202 ---- (((class color) (background light)) (:foreground "magenta")) ! (t (:italic t))) "Citation face.") *************** *** 206,212 **** (((class color) (background light)) (:foreground "violet")) ! (t (:italic t))) "Citation face.") --- 206,212 ---- (((class color) (background light)) (:foreground "violet")) ! (t (:italic t))) "Citation face.") *************** *** 216,222 **** (((class color) (background light)) (:foreground "medium purple")) ! (t (:italic t))) "Citation face.") --- 216,222 ---- (((class color) (background light)) (:foreground "medium purple")) ! (t (:italic t))) "Citation face.") *************** *** 226,240 **** (((class color) (background light)) (:foreground "turquoise")) ! (t (:italic t))) "Citation face.") ! (defcustom gnus-cite-face-list ! '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 ! gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) ! "List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. --- 226,240 ---- (((class color) (background light)) (:foreground "turquoise")) ! (t (:italic t))) "Citation face.") ! (defcustom gnus-cite-face-list ! '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 ! gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) ! "List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. *************** *** 257,263 **** (defvar gnus-cite-article nil) (defvar gnus-cite-prefix-alist nil) ! ;; Alist of citation prefixes. ;; The cdr is a list of lines with that prefix. (defvar gnus-cite-attribution-alist nil) --- 257,263 ---- (defvar gnus-cite-article nil) (defvar gnus-cite-prefix-alist nil) ! ;; Alist of citation prefixes. ;; The cdr is a list of lines with that prefix. (defvar gnus-cite-attribution-alist nil) *************** *** 277,283 **** ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a Supercite tag, if any. ! (defvar gnus-cited-text-button-line-format-alist `((?b (marker-position beg) ?d) (?e (marker-position end) ?d) (?l (- end beg) ?d))) --- 277,283 ---- ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a Supercite tag, if any. ! (defvar gnus-cited-text-button-line-format-alist `((?b (marker-position beg) ?d) (?e (marker-position end) ?d) (?l (- end beg) ?d))) *************** *** 293,299 **** corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' ! lines matches `gnus-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." --- 293,299 ---- corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' ! lines matches `gnus-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." *************** *** 332,338 **** face (cdr (assoc prefix face-alist))) ;; Add attribution button. (goto-line number) ! (when (re-search-forward gnus-cite-attribution-suffix (save-excursion (end-of-line 1) (point)) t) (gnus-article-add-button (match-beginning 1) (match-end 1) --- 332,338 ---- face (cdr (assoc prefix face-alist))) ;; Add attribution button. (goto-line number) ! (when (re-search-forward gnus-cite-attribution-suffix (save-excursion (end-of-line 1) (point)) t) (gnus-article-add-button (match-beginning 1) (match-end 1) *************** *** 445,452 **** 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) --- 445,452 ---- 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) *************** *** 468,474 **** end nil) (while (and marks (string= (cdar marks) "")) (setq marks (cdr marks))) ! (when marks (setq beg (caar marks))) (while (and marks (not (string= (cdar marks) ""))) (setq marks (cdr marks))) --- 468,474 ---- end nil) (while (and marks (string= (cdar marks) "")) (setq marks (cdr marks))) ! (when marks (setq beg (caar marks))) (while (and marks (not (string= (cdar marks) ""))) (setq marks (cdr marks))) *************** *** 548,554 **** total (cdr total)) (goto-line hiden) (unless (assq hiden gnus-cite-attribution-alist) ! (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))))))))) --- 548,554 ---- total (cdr total)) (goto-line hiden) (unless (assq hiden gnus-cite-attribution-alist) ! (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))))))))) *************** *** 589,595 **** (goto-char (point-min)) (unless (search-forward "\n\n" nil t) (goto-char (point-max))) ! (save-excursion (gnus-cite-parse-attributions)) ;; Try to avoid check citation if there is no reason to believe ;; that article has citations --- 589,595 ---- (goto-char (point-min)) (unless (search-forward "\n\n" nil t) (goto-char (point-max))) ! (save-excursion (gnus-cite-parse-attributions)) ;; Try to avoid check citation if there is no reason to believe ;; that article has citations *************** *** 604,610 **** (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. ! ;; Parse current buffer searching for citation prefixes. (let ((line (1+ (count-lines (point-min) (point)))) (case-fold-search t) --- 604,610 ---- (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. ! ;; Parse current buffer searching for citation prefixes. (let ((line (1+ (count-lines (point-min) (point)))) (case-fold-search t) *************** *** 634,640 **** prefix (buffer-substring begin end)) (gnus-set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) ! (if entry (setcdr entry (cons line (cdr entry))) (push (list prefix line) alist)) (goto-char begin)) --- 634,640 ---- prefix (buffer-substring begin end)) (gnus-set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) ! (if entry (setcdr entry (cons line (cdr entry))) (push (list prefix line) alist)) (goto-char begin)) *************** *** 659,665 **** ;; Too few lines with this prefix. We keep it a bit ;; longer in case it is an exact match for an attribution ;; line, but we don't remove the line from other ! ;; prefixes. (push entry gnus-cite-prefix-alist)) (t (push entry --- 659,665 ---- ;; Too few lines with this prefix. We keep it a bit ;; longer in case it is an exact match for an attribution ;; line, but we don't remove the line from other ! ;; prefixes. (push entry gnus-cite-prefix-alist)) (t (push entry *************** *** 670,676 **** (while loop (setq current (car loop) loop (cdr loop)) ! (setcdr current (gnus-set-difference (cdr current) numbers))))))))) (defun gnus-cite-parse-attributions () --- 670,676 ---- (while loop (setq current (car loop) loop (cdr loop)) ! (setcdr current (gnus-set-difference (cdr current) numbers))))))))) (defun gnus-cite-parse-attributions () *************** *** 706,712 **** end))) (if (not (assoc al al-alist)) (progn ! (push (list wrote in prefix tag) gnus-cite-loose-attribution-alist) (push (cons al t) al-alist)))))))) --- 706,712 ---- end))) (if (not (assoc al al-alist)) (progn ! (push (list wrote in prefix tag) gnus-cite-loose-attribution-alist) (push (cons al t) al-alist)))))))) *************** *** 721,728 **** (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (when tag ! (concat "\\`" ! (regexp-quote prefix) "[ \t]*" (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t --- 721,728 ---- (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (when tag ! (concat "\\`" ! (regexp-quote prefix) "[ \t]*" (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t *************** *** 777,784 **** ;; If FUN is non-nil, it will be called with the arguments (WROTE ;; PREFIX TAG) and expected to return a regular expression. Only ;; citations whose prefix matches the regular expression will be ! ;; considered. ! ;; ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ;; TAG is the Supercite tag on the attribution line. --- 777,784 ---- ;; If FUN is non-nil, it will be called with the arguments (WROTE ;; PREFIX TAG) and expected to return a regular expression. Only ;; citations whose prefix matches the regular expression will be ! ;; considered. ! ;; ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ;; TAG is the Supercite tag on the attribution line. *************** *** 797,803 **** ((eq sort 'first) nil) (t (< (length (gnus-cite-find-loose prefix)) 2))) limit (if after wrote -1) ! smallest 1000000 best nil) (let ((cites gnus-cite-loose-prefix-alist) cite candidate numbers first compare) --- 797,803 ---- ((eq sort 'first) nil) (t (< (length (gnus-cite-find-loose prefix)) 2))) limit (if after wrote -1) ! smallest 1000000 best nil) (let ((cites gnus-cite-loose-prefix-alist) cite candidate numbers first compare) *************** *** 882,888 **** gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t ! (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))))))) --- 882,888 ---- gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t ! (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))))))) *** pub/rgnus/lisp/gnus-cus.el Sun Mar 2 04:47:13 1997 --- rgnus/lisp/gnus-cus.el Fri Mar 7 23:51:16 1997 *************** *** 31,37 **** ;;; Widgets: ! ;; There should be special validation for this. (define-widget 'gnus-email-address 'string "An email address") --- 31,37 ---- ;;; Widgets: ! ;; There should be special validation for this. (define-widget 'gnus-email-address 'string "An email address") *************** *** 59,65 **** '((to-address (gnus-email-address :tag "To Address") "\ This will be used when doing followups and posts. ! This is primarily useful in mail groups that represent closed mailing lists--mailing lists where it's expected that everybody that writes to the mailing list is subscribed to it. Since using this parameter ensures that the mail only goes to the mailing list itself, --- 59,65 ---- '((to-address (gnus-email-address :tag "To Address") "\ This will be used when doing followups and posts. ! This is primarily useful in mail groups that represent closed mailing lists--mailing lists where it's expected that everybody that writes to the mailing list is subscribed to it. Since using this parameter ensures that the mail only goes to the mailing list itself, *************** *** 73,79 **** address instead.") (to-list (gnus-email-address :tag "To List") "\ ! This address will be used when doing a `a' in the group. It is totally ignored when doing a followup--except that if it is present in a news group, you'll get mail group semantics when doing --- 73,79 ---- address instead.") (to-list (gnus-email-address :tag "To List") "\ ! This address will be used when doing a `a' in the group. It is totally ignored when doing a followup--except that if it is present in a news group, you'll get mail group semantics when doing *************** *** 88,94 **** (to-group (string :tag "To Group") "\ All posts will be send to the specified group.") ! (gcc-self (choice :tag "GCC" :value t (const t) --- 88,94 ---- (to-group (string :tag "To Group") "\ All posts will be send to the specified group.") ! (gcc-self (choice :tag "GCC" :value t (const t) *************** *** 105,115 **** (auto-expire (const :tag "Automatic Expire" t) "\ All articles that are read will be marked as expirable.") ! (total-expire (const :tag "Total Expire" t) "\ All read articles will be put through the expiry process ! This happens even if they are not marked as expirable. Use with caution.") (expiry-wait (choice :tag "Expire Wait" --- 105,115 ---- (auto-expire (const :tag "Automatic Expire" t) "\ All articles that are read will be marked as expirable.") ! (total-expire (const :tag "Total Expire" t) "\ All read articles will be put through the expiry process ! This happens even if they are not marked as expirable. Use with caution.") (expiry-wait (choice :tag "Expire Wait" *************** *** 118,124 **** (const immediate) (number :hide-front-space t :format "%v")) "\ ! When to expire. Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' when expiring expirable messages. The value can either be a number of --- 118,124 ---- (const immediate) (number :hide-front-space t :format "%v")) "\ ! When to expire. Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' when expiring expirable messages. The value can either be a number of *************** *** 128,136 **** (score-file (file :tag "Score File") "\ Make the specified file into the current score file. This means that all score commands you issue will end up in this file.") ! (adapt-file (file :tag "Adapt File") "\ ! Make the specified file into the current adaptive file. All adaptive score entries will be put into this file.") (admin-address (gnus-email-address :tag "Admin Address") "\ --- 128,136 ---- (score-file (file :tag "Score File") "\ Make the specified file into the current score file. This means that all score commands you issue will end up in this file.") ! (adapt-file (file :tag "Adapt File") "\ ! Make the specified file into the current adaptive file. All adaptive score entries will be put into this file.") (admin-address (gnus-email-address :tag "Admin Address") "\ *************** *** 145,151 **** :value default (const all) (const default)) "\ ! Which articles to display on entering the group. `all' Display all articles, both read and unread. --- 145,151 ---- :value default (const all) (const default)) "\ ! Which articles to display on entering the group. `all' Display all articles, both read and unread. *************** *** 156,162 **** (comment (string :tag "Comment") "\ An arbitrary comment on the group.")) ! "Alist of valid group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and --- 156,162 ---- (comment (string :tag "Comment") "\ An arbitrary comment on the group.")) ! "Alist of valid group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and *************** *** 217,223 **** :tag "Variables" :format "%t:\n%h%v%i\n\n" :doc "\ ! Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put `(gnus-show-threads nil)' in the group parameters of that group. --- 217,223 ---- :tag "Variables" :format "%t:\n%h%v%i\n\n" :doc "\ ! Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put `(gnus-show-threads nil)' in the group parameters of that group. *************** *** 233,250 **** (symbol :tag "Variable") (sexp :tag "Value"))) ! '(repeat :inline t :tag "Unknown entries" sexp))) (widget-insert "\n\nYou can also edit the ") ! (widget-create 'info-link :tag "select method" :help-echo "Push me to learn more about select methods." "(gnus)Select Methods") (widget-insert " for the group.\n") ! (setq gnus-custom-method ! (widget-create 'sexp :tag "Method" :value (gnus-info-method info))) (use-local-map widget-keymap) --- 233,250 ---- (symbol :tag "Variable") (sexp :tag "Value"))) ! '(repeat :inline t :tag "Unknown entries" sexp))) (widget-insert "\n\nYou can also edit the ") ! (widget-create 'info-link :tag "select method" :help-echo "Push me to learn more about select methods." "(gnus)Select Methods") (widget-insert " for the group.\n") ! (setq gnus-custom-method ! (widget-create 'sexp :tag "Method" :value (gnus-info-method info))) (use-local-map widget-keymap) *************** *** 253,261 **** (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) ! (gnus-group-edit-group-done 'params gnus-custom-group (widget-value gnus-custom-params)) ! (gnus-group-edit-group-done 'method gnus-custom-group (widget-value gnus-custom-method)) (bury-buffer)) --- 253,261 ---- (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) ! (gnus-group-edit-group-done 'params gnus-custom-group (widget-value gnus-custom-params)) ! (gnus-group-edit-group-done 'method gnus-custom-group (widget-value gnus-custom-method)) (bury-buffer)) *************** *** 263,308 **** (defconst gnus-score-parameters '((mark (number :tag "Mark") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be marked as read.") (expunge (number :tag "Expunge") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be removed from the summary buffer.") (mark-and-expunge (number :tag "Mark-and-expunge") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be marked as read and removed from the summary buffer.") (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ ! The value of this entry should be a number. All articles that belong to a thread that has a total score below this number will be marked as read and removed from the summary buffer. `gnus-thread-score-function' says how to compute the total score for a thread.") (files (repeat :tag "Files" file) "\ ! The value of this entry should be any number of file names. These files are assumed to be score files as well, and will be loaded the same way this one was.") (exclude-files (repeat :tag "Exclude-files" file) "\ ! The clue of this entry should be any number of files. These files will not be loaded, even though they would normally be so, for some reason or other.") (eval (sexp :tag "Eval" :value nil) "\ ! The value of this entry will be `eval'el. This element will be ignored when handling global score files.") (read-only (boolean :tag "Read-only" :value t) "\ ! Read-only score files will not be updated or saved. Global score files should feature this atom.") (orphan (number :tag "Orphan") "\ ! The value of this entry should be a number. Articles that do not have parents will get this number added to their scores. Imagine you follow some high-volume newsgroup, like `comp.lang.c'. Most likely you will only follow a few of the threads, --- 263,308 ---- (defconst gnus-score-parameters '((mark (number :tag "Mark") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be marked as read.") (expunge (number :tag "Expunge") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be removed from the summary buffer.") (mark-and-expunge (number :tag "Mark-and-expunge") "\ ! The value of this entry should be a number. Any articles with a score lower than this number will be marked as read and removed from the summary buffer.") (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ ! The value of this entry should be a number. All articles that belong to a thread that has a total score below this number will be marked as read and removed from the summary buffer. `gnus-thread-score-function' says how to compute the total score for a thread.") (files (repeat :tag "Files" file) "\ ! The value of this entry should be any number of file names. These files are assumed to be score files as well, and will be loaded the same way this one was.") (exclude-files (repeat :tag "Exclude-files" file) "\ ! The clue of this entry should be any number of files. These files will not be loaded, even though they would normally be so, for some reason or other.") (eval (sexp :tag "Eval" :value nil) "\ ! The value of this entry will be `eval'el. This element will be ignored when handling global score files.") (read-only (boolean :tag "Read-only" :value t) "\ ! Read-only score files will not be updated or saved. Global score files should feature this atom.") (orphan (number :tag "Orphan") "\ ! The value of this entry should be a number. Articles that do not have parents will get this number added to their scores. Imagine you follow some high-volume newsgroup, like `comp.lang.c'. Most likely you will only follow a few of the threads, *************** *** 323,334 **** exist a few interesting threads which can't be found automatically by ordinary scoring rules.") ! (adapt (choice :tag "Adapt" (const t) (const ignore) (sexp :format "%v" :hide-front-space t)) "\ ! This entry controls the adaptive scoring. If it is `t', the default adaptive scoring rules will be used. If it is `ignore', no adaptive scoring will be performed on this group. If it is a list, this list will be used as the adaptive scoring rules. --- 323,334 ---- exist a few interesting threads which can't be found automatically by ordinary scoring rules.") ! (adapt (choice :tag "Adapt" (const t) (const ignore) (sexp :format "%v" :hide-front-space t)) "\ ! This entry controls the adaptive scoring. If it is `t', the default adaptive scoring rules will be used. If it is `ignore', no adaptive scoring will be performed on this group. If it is a list, this list will be used as the adaptive scoring rules. *************** *** 356,362 **** strange, way of setting variables in some groups if you don't like hooks much.") (touched (sexp :format "Touched\n") "Internal variable.")) ! "Alist of valid symbolic score parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a --- 356,362 ---- strange, way of setting variables in some groups if you don't like hooks much.") (touched (sexp :format "Touched\n") "Internal variable.")) ! "Alist of valid symbolic score parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a *************** *** 395,408 **** (const :tag "default" nil))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header.\n")) " ! You can have an arbitrary number of score entries for this header, each score entry has four elements: 1. The \"match element\". This should be the string to look for in the ! header. 2. The \"score element\". This number should be an integer in the neginf to posinf interval. This number is added to the score --- 395,408 ---- (const :tag "default" nil))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header.\n")) " ! You can have an arbitrary number of score entries for this header, each score entry has four elements: 1. The \"match element\". This should be the string to look for in the ! header. 2. The \"score element\". This number should be an integer in the neginf to posinf interval. This number is added to the score *************** *** 461,467 **** (const <=))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header."))))) (widget-put widget :args `(,item (repeat :inline t --- 461,467 ---- (const <=))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header."))))) (widget-put widget :args `(,item (repeat :inline t *************** *** 497,503 **** (const after))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header.")) " For the Date header we have three kinda silly match types: `before', --- 497,503 ---- (const after))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) ! (concat "Change score based on the " tag " header.")) " For the Date header we have three kinda silly match types: `before', *************** *** 643,649 **** (bury-buffer)) ;;; The End: ! (provide 'gnus-cus) ;;; gnus-cus.el ends here --- 643,649 ---- (bury-buffer)) ;;; The End: ! (provide 'gnus-cus) ;;; gnus-cus.el ends here *** pub/rgnus/lisp/gnus-demon.el Sat Jan 25 10:05:38 1997 --- rgnus/lisp/gnus-demon.el Fri Mar 7 23:51:16 1997 *************** *** 43,50 **** \(FUNCTION TIME IDLE) ! FUNCTION is the function to be called. ! TIME is the number of `gnus-demon-timestep's between each call. If nil, never call. If t, call each `gnus-demon-timestep'. If IDLE is t, only call if Emacs has been idle for a while. If IDLE is a number, only call when Emacs has been idle more than this number --- 43,50 ---- \(FUNCTION TIME IDLE) ! FUNCTION is the function to be called. ! TIME is the number of `gnus-demon-timestep's between each call. If nil, never call. If t, call each `gnus-demon-timestep'. If IDLE is t, only call if Emacs has been idle for a while. If IDLE is a number, only call when Emacs has been idle more than this number *************** *** 52,59 **** idleness. If IDLE is a number and TIME is nil, then call once each time Emacs has been idle for IDLE `gnus-demon-timestep's." :group 'gnus-demon ! :type '(repeat (list function ! (choice :tag "Time" (const :tag "never" nil) (const :tag "one" t) (integer :tag "steps" 1)) --- 52,59 ---- idleness. If IDLE is a number and TIME is nil, then call once each time Emacs has been idle for IDLE `gnus-demon-timestep's." :group 'gnus-demon ! :type '(repeat (list function ! (choice :tag "Time" (const :tag "never" nil) (const :tag "one" t) (integer :tag "steps" 1)) *************** *** 91,97 **** (defun gnus-demon-remove-handler (function &optional no-init) "Remove the handler FUNCTION from the list of handlers." ! (setq gnus-demon-handlers (delq (assq function gnus-demon-handlers) gnus-demon-handlers)) (unless no-init --- 91,97 ---- (defun gnus-demon-remove-handler (function &optional no-init) "Remove the handler FUNCTION from the list of handlers." ! (setq gnus-demon-handlers (delq (assq function gnus-demon-handlers) gnus-demon-handlers)) (unless no-init *************** *** 104,115 **** (if (null gnus-demon-handlers) () ; Nothing to do. ;; Set up timer. ! (setq gnus-demon-timer ! (nnheader-run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) ;; Reset control variables. (setq gnus-demon-handler-state ! (mapcar (lambda (handler) (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) (nth 2 handler))) --- 104,115 ---- (if (null gnus-demon-handlers) () ; Nothing to do. ;; Set up timer. ! (setq gnus-demon-timer ! (nnheader-run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) ;; Reset control variables. (setq gnus-demon-handler-state ! (mapcar (lambda (handler) (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) (nth 2 handler))) *************** *** 150,156 **** time (let* ((date (current-time-string)) (dv (timezone-parse-date date)) ! (tdate (timezone-make-arpa-date (string-to-number (aref dv 0)) (string-to-number (aref dv 1)) (string-to-number (aref dv 2)) time --- 150,156 ---- time (let* ((date (current-time-string)) (dv (timezone-parse-date date)) ! (tdate (timezone-make-arpa-date (string-to-number (aref dv 0)) (string-to-number (aref dv 1)) (string-to-number (aref dv 2)) time *************** *** 179,185 **** handler time idle) (while handlers (setq handler (pop handlers)) ! (cond ((numberp (setq time (nth 1 handler))) ;; These handlers use a regular timeout mechanism. We decrease ;; the timer if it hasn't reached zero yet. --- 179,185 ---- handler time idle) (while handlers (setq handler (pop handlers)) ! (cond ((numberp (setq time (nth 1 handler))) ;; These handlers use a regular timeout mechanism. We decrease ;; the timer if it hasn't reached zero yet. *************** *** 201,213 **** (setcar (nthcdr 1 handler) (gnus-demon-time-to-step (nth 1 (assq (car handler) gnus-demon-handlers))))))) ! ;; These are only supposed to be called when Emacs is idle. ((null (setq idle (nth 2 handler))) ;; We do nothing. ) ((not (numberp idle)) ;; We want to call this handler each and every time that ! ;; Emacs is idle. (funcall (car handler))) (t ;; We want to call this handler only if Emacs has been idle --- 201,213 ---- (setcar (nthcdr 1 handler) (gnus-demon-time-to-step (nth 1 (assq (car handler) gnus-demon-handlers))))))) ! ;; These are only supposed to be called when Emacs is idle. ((null (setq idle (nth 2 handler))) ;; We do nothing. ) ((not (numberp idle)) ;; We want to call this handler each and every time that ! ;; Emacs is idle. (funcall (car handler))) (t ;; We want to call this handler only if Emacs has been idle *** pub/rgnus/lisp/gnus-dup.el Tue Feb 4 03:53:16 1997 --- rgnus/lisp/gnus-dup.el Fri Mar 7 23:51:16 1997 *************** *** 83,89 **** ;; Enter all Message-IDs into the hash table. (let ((list gnus-dup-list) (obarray gnus-dup-hashtb)) ! (while list (intern (pop list))))) (defun gnus-dup-read () --- 83,89 ---- ;; Enter all Message-IDs into the hash table. (let ((list gnus-dup-list) (obarray gnus-dup-hashtb)) ! (while list (intern (pop list))))) (defun gnus-dup-read () *************** *** 125,131 **** (intern msgid gnus-dup-hashtb)))) ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) ! (when end (setcdr end nil)))) (defun gnus-dup-suppress-articles () --- 125,131 ---- (intern msgid gnus-dup-hashtb)))) ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) ! (when end (setcdr end nil)))) (defun gnus-dup-suppress-articles () *************** *** 138,144 **** (while (setq header (pop headers)) (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) (gnus-summary-article-unread-p (mail-header-number header))) ! (setq gnus-newsgroup-unreads (delq (setq number (mail-header-number header)) gnus-newsgroup-unreads)) (push (cons number gnus-duplicate-mark) --- 138,144 ---- (while (setq header (pop headers)) (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) (gnus-summary-article-unread-p (mail-header-number header))) ! (setq gnus-newsgroup-unreads (delq (setq number (mail-header-number header)) gnus-newsgroup-unreads)) (push (cons number gnus-duplicate-mark) *** pub/rgnus/lisp/gnus-eform.el Thu Jan 9 11:59:42 1997 --- rgnus/lisp/gnus-eform.el Fri Mar 7 23:51:17 1997 *************** *** 117,123 **** (func gnus-edit-form-done-function)) (gnus-edit-form-exit) (funcall func form))) ! (defun gnus-edit-form-exit () "Kill the current buffer." (interactive) --- 117,123 ---- (func gnus-edit-form-done-function)) (gnus-edit-form-exit) (funcall func form))) ! (defun gnus-edit-form-exit () "Kill the current buffer." (interactive) *** pub/rgnus/lisp/gnus-ems.el Fri Mar 7 07:37:00 1997 --- rgnus/lisp/gnus-ems.el Fri Mar 7 23:51:17 1997 *************** *** 35,41 **** (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-2 [down-mouse-2]) ! (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt.el")) --- 35,41 ---- (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-2 [down-mouse-2]) ! (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt.el")) *************** *** 83,89 **** If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command.")) ! (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) --- 83,89 ---- If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command.")) ! (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) *************** *** 99,105 **** (unless (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) ! ((boundp 'MULE) (provide 'gnusutil)))) --- 99,105 ---- (unless (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) ! ((boundp 'MULE) (provide 'gnusutil)))) *************** *** 141,153 **** (defvar gnus-tmp-subject-or-nil) (defun gnus-ems-redefine () ! (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ! ;; [Note] Now there are three kinds of mule implementations, ;; original MULE, XEmacs/mule and beta version of Emacs including ;; some mule features. Unfortunately these API are different. In --- 141,153 ---- (defvar gnus-tmp-subject-or-nil) (defun gnus-ems-redefine () ! (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions ! ;; [Note] Now there are three kinds of mule implementations, ;; original MULE, XEmacs/mule and beta version of Emacs including ;; some mule features. Unfortunately these API are different. In *************** *** 157,191 **** ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. ! ;; These implementations may be able to share between original ;; MULE and beta version of new Emacs. In addition, it is able to ;; detect XEmacs/mule by (featurep 'mule) and to check variable ;; `emacs-version'. In this case, implementation for XEmacs/mule ;; may be able to share between XEmacs and XEmacs/mule. ! (defalias 'gnus-truncate-string 'truncate-string) (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) ! (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines (delq 'control-chars gnus-check-before-posting)))) (defun gnus-summary-line-format-spec () ! (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) (put-text-property (point) (progn ! (insert ! gnus-tmp-opening-bracket ! (format "%4d: %-20s" ! gnus-tmp-lines (if (> (length gnus-tmp-name) 20) (truncate-string gnus-tmp-name 20) gnus-tmp-name)) --- 157,191 ---- ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. ! ;; These implementations may be able to share between original ;; MULE and beta version of new Emacs. In addition, it is able to ;; detect XEmacs/mule by (featurep 'mule) and to check variable ;; `emacs-version'. In this case, implementation for XEmacs/mule ;; may be able to share between XEmacs and XEmacs/mule. ! (defalias 'gnus-truncate-string 'truncate-string) (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) ! (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines (delq 'control-chars gnus-check-before-posting)))) (defun gnus-summary-line-format-spec () ! (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) (put-text-property (point) (progn ! (insert ! gnus-tmp-opening-bracket ! (format "%4d: %-20s" ! gnus-tmp-lines (if (> (length gnus-tmp-name) 20) (truncate-string gnus-tmp-name 20) gnus-tmp-name)) *** pub/rgnus/lisp/gnus-gl.el Mon Feb 10 14:27:13 1997 --- rgnus/lisp/gnus-gl.el Fri Mar 7 23:51:17 1997 *************** *** 43,49 **** ;; The copyright holders request that they be notified of ;; modifications of this code. Please send electronic mail to ;; grouplens@cs.umn.edu for more information or to announce derived ! ;; works. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author: Brad Miller ;; --- 43,49 ---- ;; The copyright holders request that they be notified of ;; modifications of this code. Please send electronic mail to ;; grouplens@cs.umn.edu for more information or to announce derived ! ;; works. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author: Brad Miller ;; *************** *** 56,62 **** ;; ;; ---------------- For your .emacs or .gnus file ---------------- ;; ! ;; As of version 2.5, grouplens now works as a minor mode of ;; gnus-summary-mode. To get make that work you just need a couple of ;; hooks. ;; (setq gnus-use-grouplens t) --- 56,62 ---- ;; ;; ---------------- For your .emacs or .gnus file ---------------- ;; ! ;; As of version 2.5, grouplens now works as a minor mode of ;; gnus-summary-mode. To get make that work you just need a couple of ;; hooks. ;; (setq gnus-use-grouplens t) *************** *** 76,89 **** ;; Please type M-x gnus-gl-submit-bug-report. This will set up a ;; mail buffer with the state of variables and buffers that will help ;; me debug the problem. A short description up front would help too! ! ;; ;; How do I display the prediction for an article: ;; If you set the gnus-summary-line-format as shown above, the score ;; (prediction) will be shown automatically. ;; ! ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;; Programmer Notes ;; 10/9/95 ;; gnus-scores-articles contains the articles ;; When scoring is done, the call tree looks something like: --- 76,89 ---- ;; Please type M-x gnus-gl-submit-bug-report. This will set up a ;; mail buffer with the state of variables and buffers that will help ;; me debug the problem. A short description up front would help too! ! ;; ;; How do I display the prediction for an article: ;; If you set the gnus-summary-line-format as shown above, the score ;; (prediction) will be shown automatically. ;; ! ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;; Programmer Notes ;; 10/9/95 ;; gnus-scores-articles contains the articles ;; When scoring is done, the call tree looks something like: *************** *** 115,121 **** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bugs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;; ;;; Code: --- 115,121 ---- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bugs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ! ;; ;;; Code: *************** *** 132,138 **** "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" ! "User's pseudonym. This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" --- 132,138 ---- "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" ! "User's pseudonym. This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" *************** *** 141,147 **** (defvar grouplens-bbb-port 9000 "Port where the bbbd is listening" ) ! (defvar grouplens-newsgroups '("comp.groupware" "comp.human-factors" "comp.lang.c++" "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" "comp.os.linux.announce" "comp.os.linux.answers" --- 141,147 ---- (defvar grouplens-bbb-port 9000 "Port where the bbbd is listening" ) ! (defvar grouplens-newsgroups '("comp.groupware" "comp.human-factors" "comp.lang.c++" "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" "comp.os.linux.announce" "comp.os.linux.answers" *************** *** 154,161 **** "*Groups that are part of the GroupLens experiment.") (defvar grouplens-prediction-display 'prediction-spot ! "valid values are: ! prediction-spot -- an * corresponding to the prediction between 1 and 5, confidence-interval -- a numeric confidence interval prediction-bar -- |##### | the longer the bar, the better the article, confidence-bar -- | ----- } the prediction is in the middle of the bar, --- 154,161 ---- "*Groups that are part of the GroupLens experiment.") (defvar grouplens-prediction-display 'prediction-spot ! "valid values are: ! prediction-spot -- an * corresponding to the prediction between 1 and 5, confidence-interval -- a numeric confidence interval prediction-bar -- |##### | the longer the bar, the better the article, confidence-bar -- | ----- } the prediction is in the middle of the bar, *************** *** 164,170 **** confidence-plus-minus -- prediction +/i confidence") (defvar grouplens-score-offset 0 ! "Offset the prediction by this value. Setting this variable to -2 would have the following effect on GroupLens scores: --- 164,170 ---- confidence-plus-minus -- prediction +/i confidence") (defvar grouplens-score-offset 0 ! "Offset the prediction by this value. Setting this variable to -2 would have the following effect on GroupLens scores: *************** *** 173,188 **** 3 --> 0 4 --> 1 5 --> 2 ! The reason is that a user might want to do this is to combine GroupLens predictions with scores calculated by other score methods.") (defvar grouplens-score-scale-factor 1 ! "This variable allows the user to magnify the effect of GroupLens scores. The scale factor is applied after the offset.") (defvar gnus-grouplens-override-scoring 'override ! "Tell GroupLens to override the normal Gnus scoring mechanism. GroupLens scores can be combined with gnus scores in one of three ways. 'override -- just use grouplens predictions for grouplens groups 'combine -- combine grouplens scores with gnus scores --- 173,188 ---- 3 --> 0 4 --> 1 5 --> 2 ! The reason is that a user might want to do this is to combine GroupLens predictions with scores calculated by other score methods.") (defvar grouplens-score-scale-factor 1 ! "This variable allows the user to magnify the effect of GroupLens scores. The scale factor is applied after the offset.") (defvar gnus-grouplens-override-scoring 'override ! "Tell GroupLens to override the normal Gnus scoring mechanism. GroupLens scores can be combined with gnus scores in one of three ways. 'override -- just use grouplens predictions for grouplens groups 'combine -- combine grouplens scores with gnus scores *************** *** 255,265 **** ;; open the connection to the server (catch 'done (condition-case error ! (setq grouplens-bbb-process (open-network-stream "BBBD" grouplens-bbb-buffer host port)) (error (gnus-message 3 "Error: Failed to connect to BBB") nil)) ! (and (null grouplens-bbb-process) (throw 'done nil)) (save-excursion (set-buffer grouplens-bbb-buffer) --- 255,265 ---- ;; open the connection to the server (catch 'done (condition-case error ! (setq grouplens-bbb-process (open-network-stream "BBBD" grouplens-bbb-buffer host port)) (error (gnus-message 3 "Error: Failed to connect to BBB") nil)) ! (and (null grouplens-bbb-process) (throw 'done nil)) (save-excursion (set-buffer grouplens-bbb-buffer) *************** *** 338,349 **** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun bbb-build-mid-scores-alist (groupname) ! "this function can be called as part of the function to return the list of score files to use. See the gnus variable ! gnus-score-find-score-files-function. *Note:* If you want to use grouplens scores along with calculated scores, ! you should see the offset and scale variables. At this point, I don't recommend using both scores and grouplens predictions together." (setq grouplens-current-group groupname) (when (member groupname grouplens-newsgroups) --- 338,349 ---- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun bbb-build-mid-scores-alist (groupname) ! "this function can be called as part of the function to return the list of score files to use. See the gnus variable ! gnus-score-find-score-files-function. *Note:* If you want to use grouplens scores along with calculated scores, ! you should see the offset and scale variables. At this point, I don't recommend using both scores and grouplens predictions together." (setq grouplens-current-group groupname) (when (member groupname grouplens-newsgroups) *************** *** 423,436 **** ;; around. Where the first parenthesized expression is the ;; message-id, and the second is the prediction, the third and fourth ;; are the confidence interval ! ;; ;; Since gnus assumes that scores are integer values?? we round the ;; prediction. (defun bbb-get-mid () (buffer-substring (match-beginning 1) (match-end 1))) (defun bbb-get-pred () ! (let ((tpred (string-to-number (buffer-substring (match-beginning 2) (match-end 2))))) (if (> tpred 0) (round (* grouplens-score-scale-factor --- 423,436 ---- ;; around. Where the first parenthesized expression is the ;; message-id, and the second is the prediction, the third and fourth ;; are the confidence interval ! ;; ;; Since gnus assumes that scores are integer values?? we round the ;; prediction. (defun bbb-get-mid () (buffer-substring (match-beginning 1) (match-end 1))) (defun bbb-get-pred () ! (let ((tpred (string-to-number (buffer-substring (match-beginning 2) (match-end 2))))) (if (> tpred 0) (round (* grouplens-score-scale-factor *************** *** 473,479 **** (setq high 0)) (if (and (bbb-valid-score iscore) (not (null mid))) ! (cond ;; prediction-spot ((equal grouplens-prediction-display 'prediction-spot) (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) --- 473,479 ---- (setq high 0)) (if (and (bbb-valid-score iscore) (not (null mid))) ! (cond ;; prediction-spot ((equal grouplens-prediction-display 'prediction-spot) (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) *************** *** 522,528 **** ((> pred 5) (setq pred 5)))) ;; If no entry in BBB hash mark rate string as NA and return ! (cond ((null hashent) (aset rate-string 5 ?N) (aset rate-string 6 ?A) --- 522,528 ---- ((> pred 5) (setq pred 5)))) ;; If no entry in BBB hash mark rate string as NA and return ! (cond ((null hashent) (aset rate-string 5 ?N) (aset rate-string 6 ?A) *************** *** 530,539 **** ((equal grouplens-prediction-display 'prediction-spot) (bbb-fmt-prediction-spot rate-string pred)) ! ((equal grouplens-prediction-display 'confidence-interval) (bbb-fmt-confidence-interval pred low high)) ! ((equal grouplens-prediction-display 'prediction-bar) (bbb-fmt-prediction-bar rate-string pred)) --- 530,539 ---- ((equal grouplens-prediction-display 'prediction-spot) (bbb-fmt-prediction-spot rate-string pred)) ! ((equal grouplens-prediction-display 'confidence-interval) (bbb-fmt-confidence-interval pred low high)) ! ((equal grouplens-prediction-display 'prediction-bar) (bbb-fmt-prediction-bar rate-string pred)) *************** *** 542,555 **** ((equal grouplens-prediction-display 'confidence-spot) (format "| %4.2f |" pred)) ! ((equal grouplens-prediction-display 'prediction-num) (bbb-fmt-prediction-num pred)) ! ((equal grouplens-prediction-display 'confidence-plus-minus) (bbb-fmt-confidence-plus-minus pred low high)) ! ! (t (gnus-message 3 "Invalid prediction display type") (aset rate-string 0 ?|) (aset rate-string 11 ?|) --- 542,555 ---- ((equal grouplens-prediction-display 'confidence-spot) (format "| %4.2f |" pred)) ! ((equal grouplens-prediction-display 'prediction-num) (bbb-fmt-prediction-num pred)) ! ((equal grouplens-prediction-display 'confidence-plus-minus) (bbb-fmt-confidence-plus-minus pred low high)) ! ! (t (gnus-message 3 "Invalid prediction display type") (aset rate-string 0 ?|) (aset rate-string 11 ?|) *************** *** 609,627 **** (defun bbb-put-ratings () (if (and grouplens-bbb-token ! grouplens-rating-alist (member gnus-newsgroup-name grouplens-newsgroups)) ! (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)) (rate-command (bbb-build-rate-command grouplens-rating-alist))) (if bbb-process ! (save-excursion (set-buffer (process-buffer bbb-process)) (gnus-message 5 "Sending Ratings...") (bbb-send-command bbb-process rate-command) (if (bbb-read-response bbb-process) (setq grouplens-rating-alist nil) ! (gnus-message 1 "Token timed out: call bbb-login and quit again") (ding)) (gnus-message 5 "Sending Ratings...Done")) --- 609,627 ---- (defun bbb-put-ratings () (if (and grouplens-bbb-token ! grouplens-rating-alist (member gnus-newsgroup-name grouplens-newsgroups)) ! (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)) (rate-command (bbb-build-rate-command grouplens-rating-alist))) (if bbb-process ! (save-excursion (set-buffer (process-buffer bbb-process)) (gnus-message 5 "Sending Ratings...") (bbb-send-command bbb-process rate-command) (if (bbb-read-response bbb-process) (setq grouplens-rating-alist nil) ! (gnus-message 1 "Token timed out: call bbb-login and quit again") (ding)) (gnus-message 5 "Sending Ratings...Done")) *************** *** 642,648 **** (interactive "nRating: ") (when (member gnus-newsgroup-name grouplens-newsgroups) (let ((mid (or midin (bbb-get-current-id)))) ! (if (and rating (>= rating grplens-minrating) (<= rating grplens-maxrating) mid) --- 642,648 ---- (interactive "nRating: ") (when (member gnus-newsgroup-name grouplens-newsgroups) (let ((mid (or midin (bbb-get-current-id)))) ! (if (and rating (>= rating grplens-minrating) (<= rating grplens-maxrating) mid) *************** *** 668,675 **** (gnus-summary-best-unread-article)) (defun grouplens-summary-catchup-and-exit (rating) ! "Mark all articles not marked as unread in this newsgroup as read, ! then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when rating --- 668,675 ---- (gnus-summary-best-unread-article)) (defun grouplens-summary-catchup-and-exit (rating) ! "Mark all articles not marked as unread in this newsgroup as read, ! then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when rating *************** *** 689,695 **** (gnus-summary-goto-subject article) (gnus-set-global-variables) (bbb-summary-rate-article score ! (mail-header-id (gnus-summary-article-header article))))) (setq e (point))) (let ((gnus-summary-check-current t)) --- 689,695 ---- (gnus-summary-goto-subject article) (gnus-set-global-variables) (bbb-summary-rate-article score ! (mail-header-id (gnus-summary-article-header article))))) (setq e (point))) (let ((gnus-summary-check-current t)) *************** *** 705,711 **** (defun bbb-get-current-id () (if gnus-current-headers ! (mail-header-id gnus-current-headers) (gnus-message 3 "You must select an article before you rate it"))) (defun bbb-grouplens-group-p (group) --- 705,711 ---- (defun bbb-get-current-id () (if gnus-current-headers ! (mail-header-id gnus-current-headers) (gnus-message 3 "You must select an article before you rate it"))) (defun bbb-grouplens-group-p (group) *************** *** 732,738 **** (when (member gnus-newsgroup-name grouplens-newsgroups) (when grouplens-previous-article (let ((elapsed-time (grouplens-elapsed-time)) ! (oldrating (assoc grouplens-previous-article grouplens-rating-alist))) (if (not oldrating) (push `(,grouplens-previous-article . (0 . ,elapsed-time)) --- 732,738 ---- (when (member gnus-newsgroup-name grouplens-newsgroups) (when grouplens-previous-article (let ((elapsed-time (grouplens-elapsed-time)) ! (oldrating (assoc grouplens-previous-article grouplens-rating-alist))) (if (not oldrating) (push `(,grouplens-previous-article . (0 . ,elapsed-time)) *************** *** 806,812 **** (when (and (eq major-mode 'gnus-summary-mode) (member gnus-newsgroup-name grouplens-newsgroups)) (make-local-variable 'gnus-grouplens-mode) ! (setq gnus-grouplens-mode (if (null arg) (not gnus-grouplens-mode) (> (prefix-numeric-value arg) 0))) (when gnus-grouplens-mode --- 806,812 ---- (when (and (eq major-mode 'gnus-summary-mode) (member gnus-newsgroup-name grouplens-newsgroups)) (make-local-variable 'gnus-grouplens-mode) ! (setq gnus-grouplens-mode (if (null arg) (not gnus-grouplens-mode) (> (prefix-numeric-value arg) 0))) (when gnus-grouplens-mode *************** *** 816,843 **** (gnus-add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) (make-local-variable 'gnus-score-find-score-files-function) ! (cond ((eq gnus-grouplens-override-scoring 'combine) ;; either add bbb-buld-mid-scores-alist to a list ;; or make a list (if (listp gnus-score-find-score-files-function) ! (setq gnus-score-find-score-files-function ! (append 'bbb-build-mid-scores-alist gnus-score-find-score-files-function)) ! (setq gnus-score-find-score-files-function ! (list gnus-score-find-score-files-function 'bbb-build-mid-scores-alist)))) ;; leave the gnus-score-find-score-files variable alone ((eq gnus-grouplens-override-scoring 'separate) ! (add-hook 'gnus-select-group-hook (lambda () (bbb-get-predictions (bbb-get-all-mids) gnus-newsgroup-name)))) ;; default is to override ! (t ! (setq gnus-score-find-score-files-function 'bbb-build-mid-scores-alist))) ! ;; Change how summary lines look (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) --- 816,843 ---- (gnus-add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) (make-local-variable 'gnus-score-find-score-files-function) ! (cond ((eq gnus-grouplens-override-scoring 'combine) ;; either add bbb-buld-mid-scores-alist to a list ;; or make a list (if (listp gnus-score-find-score-files-function) ! (setq gnus-score-find-score-files-function ! (append 'bbb-build-mid-scores-alist gnus-score-find-score-files-function)) ! (setq gnus-score-find-score-files-function ! (list gnus-score-find-score-files-function 'bbb-build-mid-scores-alist)))) ;; leave the gnus-score-find-score-files variable alone ((eq gnus-grouplens-override-scoring 'separate) ! (add-hook 'gnus-select-group-hook (lambda () (bbb-get-predictions (bbb-get-all-mids) gnus-newsgroup-name)))) ;; default is to override ! (t ! (setq gnus-score-find-score-files-function 'bbb-build-mid-scores-alist))) ! ;; Change how summary lines look (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) *** pub/rgnus/lisp/gnus-group.el Thu Mar 6 08:47:24 1997 --- rgnus/lisp/gnus-group.el Fri Mar 7 23:51:18 1997 *************** *** 265,271 **** "gnus-help" (nndoc "gnus-help" (nndoc-article-type mbox) ! (eval `(nndoc-address ,(let ((file (nnheader-find-etc-directory "gnus-tut.txt" t))) (unless file --- 265,271 ---- "gnus-help" (nndoc "gnus-help" (nndoc-article-type mbox) ! (eval `(nndoc-address ,(let ((file (nnheader-find-etc-directory "gnus-tut.txt" t))) (unless file *************** *** 312,324 **** gnus-group-mail-low-empty-face) (t . gnus-group-mail-low-face)) ! "Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a particular group line should be displayed, each form is evaluated. The content of the face field after the first true form is used. You can change how those group lines are displayed by ! editing the face field. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will --- 312,324 ---- gnus-group-mail-low-empty-face) (t . gnus-group-mail-low-face)) ! "Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a particular group line should be displayed, each form is evaluated. The content of the face field after the first true form is used. You can change how those group lines are displayed by ! editing the face field. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will *************** *** 603,609 **** ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] ["Global kill file" gnus-group-edit-global-kill t]) )) ! (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" '("Groups" --- 603,609 ---- ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] ["Global kill file" gnus-group-edit-global-kill t]) )) ! (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" '("Groups" *************** *** 708,714 **** ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] ! ["Check for new news" gnus-group-get-new-news t] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] --- 708,714 ---- ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] ! ["Check for new news" gnus-group-get-new-news t] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] *************** *** 850,856 **** ;; We have some groups displayed. (goto-char (point-max)) (when (or (not gnus-group-goto-next-group-function) ! (not (funcall gnus-group-goto-next-group-function group props))) (cond (empty --- 850,856 ---- ;; We have some groups displayed. (goto-char (point-max)) (when (or (not gnus-group-goto-next-group-function) ! (not (funcall gnus-group-goto-next-group-function group props))) (cond (empty *************** *** 914,920 **** (>= clevel lowest) (or all ; We list all groups? (if (eq unread t) ; Unactivated? ! gnus-group-list-inactive-groups ; We list unactivated (> unread 0)) ; We list groups with unread articles (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) --- 914,920 ---- (>= clevel lowest) (or all ; We list all groups? (if (eq unread t) ; Unactivated? ! gnus-group-list-inactive-groups ; We list unactivated (> unread 0)) ; We list groups with unread articles (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) *************** *** 1015,1021 **** nil) nil)))) ! (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." --- 1015,1021 ---- nil) nil)))) ! (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." *************** *** 1118,1125 **** (setq list (cdr list))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg))) (goto-char p))) --- 1118,1125 ---- (setq list (cdr list))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg))) (goto-char p))) *************** *** 1143,1149 **** (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (when (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (gnus-prin1-to-string (nth 2 entry)) ")")))) ;; Find all group instances. If topics are in use, each group --- 1143,1149 ---- (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (when (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (gnus-prin1-to-string (nth 2 entry)) ")")))) ;; Find all group instances. If topics are in use, each group *************** *** 1204,1210 **** (max-len 60) gnus-tmp-header ;Dummy binding for user-defined formats ;; Get the resulting string. ! (modified (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) --- 1204,1210 ---- (max-len 60) gnus-tmp-header ;Dummy binding for user-defined formats ;; Get the resulting string. ! (modified (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) *************** *** 1219,1225 **** (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 ! (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p modified)))))) --- 1219,1225 ---- (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 ! (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p modified)))))) *************** *** 1481,1487 **** (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) ! (zerop (+ number (gnus-range-length (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) --- 1481,1487 ---- (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) ! (zerop (+ number (gnus-range-length (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) *************** *** 1518,1524 **** (defun gnus-group-select-group-ephemerally () "Select the current group without doing any processing whatsoever. You will actually be entered into a group that's a copy of ! the current group; no changes you make while in this group will be permanent." (interactive) (require 'gnus-score) --- 1518,1524 ---- (defun gnus-group-select-group-ephemerally () "Select the current group without doing any processing whatsoever. You will actually be entered into a group that's a copy of ! the current group; no changes you make while in this group will be permanent." (interactive) (require 'gnus-score) *************** *** 1532,1538 **** `(,(car method) ,(concat (cadr method) "-ephemeral") (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method))) ! (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) ;;;###autoload --- 1532,1538 ---- `(,(car method) ,(concat (cadr method) "-ephemeral") (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method))) ! (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) ;;;###autoload *************** *** 1548,1554 **** ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. ! (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. --- 1548,1554 ---- ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. ! (defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. *************** *** 1568,1574 **** (gnus-group-prefixed-name group method)))) (gnus-sethash group ! `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method ((quit-config . ,(if quit-config quit-config --- 1568,1574 ---- (gnus-group-prefixed-name group method)))) (gnus-sethash group ! `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method ((quit-config . ,(if quit-config quit-config *************** *** 1581,1587 **** (when activate (gnus-activate-group group 'scan) (unless (gnus-request-group group) ! (error "Couldn't request group: %s" (nnheader-get-report (car method))))) (if request-only group --- 1581,1587 ---- (when activate (gnus-activate-group group 'scan) (unless (gnus-request-group group) ! (error "Couldn't request group: %s" (nnheader-get-report (car method))))) (if request-only group *************** *** 1618,1624 **** (when group (if far (gnus-goto-char ! (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) (beginning-of-line) --- 1618,1624 ---- (when group (if far (gnus-goto-char ! (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) (beginning-of-line) *************** *** 1644,1650 **** (t ;; Search through the entire buffer. (gnus-goto-char ! (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) --- 1644,1650 ---- (t ;; Search through the entire buffer. (gnus-goto-char ! (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) *************** *** 1781,1787 **** (gnus-set-active nname (cons 1 0)) (unless (gnus-ephemeral-group-p name) (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (gnus-prin1-to-string (cdr info)) ")"))) ;; Insert the line. (gnus-group-insert-group-line-info nname) --- 1781,1787 ---- (gnus-set-active nname (cons 1 0)) (unless (gnus-ephemeral-group-p name) (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (gnus-prin1-to-string (cdr info)) ")"))) ;; Insert the line. (gnus-group-insert-group-line-info nname) *************** *** 1844,1850 **** (unless (gnus-check-backend-function 'request-rename-group group) (error "This backend does not support renaming groups")) ! (unless group (error "No group to rename")) (when (equal (gnus-group-real-name group) new-name) (error "Can't rename to the same name")) --- 1844,1850 ---- (unless (gnus-check-backend-function 'request-rename-group group) (error "This backend does not support renaming groups")) ! (unless group (error "No group to rename")) (when (equal (gnus-group-real-name group) new-name) (error "Can't rename to the same name")) *************** *** 2030,2037 **** 0) 'gnus-group-web-type-history)) (search ! (read-string ! "Search string: " (cons (or (car gnus-group-web-search-history) "") 0) 'gnus-group-web-search-history)) (method --- 2030,2037 ---- 0) 'gnus-group-web-type-history)) (search ! (read-string ! "Search string: " (cons (or (car gnus-group-web-search-history) "") 0) 'gnus-group-web-search-history)) (method *************** *** 2359,2365 **** (gnus-info-clear-data info))) (gnus-get-unread-articles) (gnus-dribble-enter "") ! (when (gnus-y-or-n-p "Move the cache away to avoid problems in the future? ") (call-interactively 'gnus-cache-move-cache))))) --- 2359,2365 ---- (gnus-info-clear-data info))) (gnus-get-unread-articles) (gnus-dribble-enter "") ! (when (gnus-y-or-n-p "Move the cache away to avoid problems in the future? ") (call-interactively 'gnus-cache-move-cache))))) *************** *** 2478,2484 **** (gnus-compress-sequence (if expiry-wait ;; We set the expiry variables to the group ! ;; parameter. (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) (gnus-request-expire-articles --- 2478,2484 ---- (gnus-compress-sequence (if expiry-wait ;; We set the expiry variables to the group ! ;; parameter. (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) (gnus-request-expire-articles *************** *** 2550,2556 **** groups (cdr groups)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group ! group (cond ((eq do-sub 'unsubscribe) gnus-level-default-unsubscribed) --- 2550,2556 ---- groups (cdr groups)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group ! group (cond ((eq do-sub 'unsubscribe) gnus-level-default-unsubscribed) *************** *** 2572,2578 **** (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) ! nil 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond --- 2572,2578 ---- (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) ! nil 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond *************** *** 2844,2850 **** (gnus-master-read-slave-newsrc)) ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem (null arg)) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. --- 2844,2850 ---- (gnus-master-read-slave-newsrc)) ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem (null arg)) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. *************** *** 2856,2862 **** ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) (gnus-find-new-newsgroups))) ! (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn --- 2856,2862 ---- ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) (gnus-find-new-newsgroups))) ! (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn *************** *** 3038,3044 **** (when (and level (> (prefix-numeric-value level) gnus-level-killed)) (gnus-get-killed-groups)) ! (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-point)) --- 3038,3044 ---- (when (and level (> (prefix-numeric-value level) gnus-level-killed)) (gnus-get-killed-groups)) ! (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-point)) *************** *** 3134,3140 **** "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation gnus-expert-user --- 3134,3140 ---- "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation gnus-expert-user *** pub/rgnus/lisp/gnus-int.el Thu Jan 9 11:59:40 1997 --- rgnus/lisp/gnus-int.el Fri Mar 7 23:51:18 1997 *************** *** 427,433 **** (let* ((elem (assoc method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. ! (when (eq status 'denied) ;; Set the status of this server. (setcar (cdr elem) 'closed)))) --- 427,433 ---- (let* ((elem (assoc method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. ! (when (eq status 'denied) ;; Set the status of this server. (setcar (cdr elem) 'closed)))) *** pub/rgnus/lisp/gnus-kill.el Sun Feb 16 18:16:36 1997 --- rgnus/lisp/gnus-kill.el Fri Mar 7 23:51:18 1997 *************** *** 205,240 **** (goto-char (point-max))) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) ! (defun gnus-kill-file-kill-by-subject () "Kill by subject." (interactive) (gnus-kill-file-enter-kill ! "Subject" (if (vectorp gnus-current-headers) ! (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) "") t)) ! (defun gnus-kill-file-kill-by-author () "Kill by author." (interactive) (gnus-kill-file-enter-kill ! "From" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) "") t)) ! (defun gnus-kill-file-kill-by-thread () "Kill by author." (interactive) (gnus-kill-file-enter-kill ! "References" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-id gnus-current-headers)) ""))) ! (defun gnus-kill-file-kill-by-xref () "Kill by Xref." (interactive) --- 205,240 ---- (goto-char (point-max))) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) ! (defun gnus-kill-file-kill-by-subject () "Kill by subject." (interactive) (gnus-kill-file-enter-kill ! "Subject" (if (vectorp gnus-current-headers) ! (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) "") t)) ! (defun gnus-kill-file-kill-by-author () "Kill by author." (interactive) (gnus-kill-file-enter-kill ! "From" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) "") t)) ! (defun gnus-kill-file-kill-by-thread () "Kill by author." (interactive) (gnus-kill-file-enter-kill ! "References" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-id gnus-current-headers)) ""))) ! (defun gnus-kill-file-kill-by-xref () "Kill by Xref." (interactive) *************** *** 245,255 **** (if xref (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) ! (when (not (string= ! (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) ! (gnus-kill-file-enter-kill "Xref" (concat " " (regexp-quote group) ":") t))) (gnus-kill-file-enter-kill "Xref" "" t)))) --- 245,255 ---- (if xref (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) ! (when (not (string= ! (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) ! (gnus-kill-file-enter-kill "Xref" (concat " " (regexp-quote group) ":") t))) (gnus-kill-file-enter-kill "Xref" "" t)))) *************** *** 264,277 **** (setq name (read-string (concat "Add " level " to followup articles to: ") (regexp-quote name))) ! (setq string (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" "From" name level)) (insert string) (gnus-kill-file-apply-string string)) ! (gnus-message 6 "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () --- 264,277 ---- (setq name (read-string (concat "Add " level " to followup articles to: ") (regexp-quote name))) ! (setq string (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" "From" name level)) (insert string) (gnus-kill-file-apply-string string)) ! (gnus-message 6 "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () *************** *** 387,393 **** (mapcar (lambda (header) (mail-header-number header)) headers)) (while headers ! (unless (gnus-member-of-range (mail-header-number (car headers)) gnus-newsgroup-killed) (push (mail-header-number (car headers)) --- 387,393 ---- (mapcar (lambda (header) (mail-header-number header)) headers)) (while headers ! (unless (gnus-member-of-range (mail-header-number (car headers)) gnus-newsgroup-killed) (push (mail-header-number (car headers)) *************** *** 410,417 **** (if (consp (ignore-errors (read (current-buffer)))) (gnus-kill-parse-gnus-kill-file) (gnus-kill-parse-rn-kill-file)) ! ! (gnus-message 6 "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) --- 410,417 ---- (if (consp (ignore-errors (read (current-buffer)))) (gnus-kill-parse-gnus-kill-file) (gnus-kill-parse-rn-kill-file)) ! ! (gnus-message 6 "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) *************** *** 439,445 **** (goto-char (point-min)) (gnus-kill-file-mode) (let (beg form) ! (while (progn (setq beg (point)) (setq form (ignore-errors (read (current-buffer))))) (unless (listp form) --- 439,445 ---- (goto-char (point-min)) (gnus-kill-file-mode) (let (beg form) ! (while (progn (setq beg (point)) (setq form (ignore-errors (read (current-buffer))))) (unless (listp form) *************** *** 481,494 **** ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark ! ;; PATTERN later. (when (string-match "\\+" commands) (gnus-kill "from" ".") (setq commands "m")) ! (gnus-kill (or (cdr (assq modifier mod-to-header)) "subject") ! pattern (if (string-match "m" commands) '(gnus-summary-mark-as-unread nil " ") '(gnus-summary-mark-as-read nil "X")) --- 481,494 ---- ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark ! ;; PATTERN later. (when (string-match "\\+" commands) (gnus-kill "from" ".") (setq commands "m")) ! (gnus-kill (or (cdr (assq modifier mod-to-header)) "subject") ! pattern (if (string-match "m" commands) '(gnus-summary-mark-as-unread nil " ") '(gnus-summary-mark-as-read nil "X")) *************** *** 496,502 **** (forward-line 1)))) ;; Kill changes and new format by suggested by JWZ and Sudish Joseph ! ;; . (defun gnus-kill (field regexp &optional exe-command all silent) "If FIELD of an article matches REGEXP, execute COMMAND. Optional 1st argument COMMAND is default to --- 496,502 ---- (forward-line 1)))) ;; Kill changes and new format by suggested by JWZ and Sudish Joseph ! ;; . (defun gnus-kill (field regexp &optional exe-command all silent) "If FIELD of an article matches REGEXP, execute COMMAND. Optional 1st argument COMMAND is default to *************** *** 514,520 **** (goto-char (point-min)) ;From the beginning. (let ((kill-list regexp) (date (current-time-string)) ! (command (or exe-command '(gnus-summary-mark-as-read nil gnus-kill-file-mark))) kill kdate prev) (if (listp kill-list) --- 514,520 ---- (goto-char (point-min)) ;From the beginning. (let ((kill-list regexp) (date (current-time-string)) ! (command (or exe-command '(gnus-summary-mark-as-read nil gnus-kill-file-mark))) kill kdate prev) (if (listp kill-list) *************** *** 532,538 **** ;; It's a temporary kill. (progn (setq kdate (cdr kill)) ! (if (zerop (gnus-execute field (car kill) command nil (not all))) (when (> (gnus-days-between date kdate) gnus-kill-expiry-days) --- 532,538 ---- ;; It's a temporary kill. (progn (setq kdate (cdr kill)) ! (if (zerop (gnus-execute field (car kill) command nil (not all))) (when (> (gnus-days-between date kdate) gnus-kill-expiry-days) *************** *** 551,557 **** (switch-to-buffer old-buffer) (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) (gnus-pp-gnus-kill ! (nconc (list 'gnus-kill field (if (consp regexp) (list 'quote regexp) regexp)) (when (or exe-command all) (list (list 'quote exe-command))) --- 551,557 ---- (switch-to-buffer old-buffer) (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) (gnus-pp-gnus-kill ! (nconc (list 'gnus-kill field (if (consp regexp) (list 'quote regexp) regexp)) (when (or exe-command all) (list (list 'quote exe-command))) *************** *** 576,582 **** (setq klist (cdr klist)))) (insert ")") (and (nth 3 object) ! (insert "\n " (if (and (consp (nth 3 object)) (not (eq 'quote (car (nth 3 object))))) "'" "") --- 576,582 ---- (setq klist (cdr klist)))) (insert ")") (and (nth 3 object) ! (insert "\n " (if (and (consp (nth 3 object)) (not (eq 'quote (car (nth 3 object))))) "'" "") *************** *** 614,620 **** (gnus-last-article nil) (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. ! (gnus-message 6 "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) --- 614,620 ---- (gnus-last-article nil) (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. ! (gnus-message 6 "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) *************** *** 639,653 **** (save-excursion (let ((killed-no 0) function article header) ! (cond ;; Search body. ((or (null field) (string-equal field "")) (setq function nil)) ;; Get access function of header field. ((fboundp ! (setq function ! (intern-soft (concat "mail-header-" (downcase field))))) (setq function `(lambda (h) (,function h)))) ;; Signal error. --- 639,653 ---- (save-excursion (let ((killed-no 0) function article header) ! (cond ;; Search body. ((or (null field) (string-equal field "")) (setq function nil)) ;; Get access function of header field. ((fboundp ! (setq function ! (intern-soft (concat "mail-header-" (downcase field))))) (setq function `(lambda (h) (,function h)))) ;; Signal error. *************** *** 659,665 **** (and (not article) (setq article (gnus-summary-article-number))) ;; Find later articles. ! (setq article (gnus-summary-search-forward unread nil backward))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) --- 659,665 ---- (and (not article) (setq article (gnus-summary-article-number))) ;; Find later articles. ! (setq article (gnus-summary-search-forward unread nil backward))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) *************** *** 679,685 **** the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) ! (let* ((gnus-newsrc-options-n (gnus-newsrc-parse-options (concat "options -n " (mapconcat 'identity command-line-args-left " ")))) --- 679,685 ---- the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) ! (let* ((gnus-newsrc-options-n (gnus-newsrc-parse-options (concat "options -n " (mapconcat 'identity command-line-args-left " ")))) *** pub/rgnus/lisp/gnus-load.el Thu Mar 6 08:44:58 1997 --- rgnus/lisp/gnus-load.el Fri Mar 7 23:51:19 1997 *************** *** 2,59 **** ;; ;;; Code: ! (put 'gnus-visual 'custom-loads '("smiley" "gnus-sum" "gnus-picon" "earcon")) (put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) ! (put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int")) ! (put 'gnus-extract-view 'custom-loads '("gnus-sum")) ! (put 'article-hiding-headers 'custom-loads '("gnus-sum")) (put 'gnus-various 'custom-loads '("gnus-sum")) ! (put 'gnus-meta 'custom-loads '("gnus")) (put 'message-news 'custom-loads '("message")) (put 'gnus-thread 'custom-loads '("gnus-sum")) (put 'gnus-treading 'custom-loads '("gnus-sum")) (put 'message-various 'custom-loads '("message")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) ! (put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-sum" "gnus-group" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) (put 'gnus-summary-visual 'custom-loads '("gnus-sum")) ! (put 'gnus-score 'custom-loads '("gnus-sum" "gnus-score" "gnus-nocem" "gnus-kill")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'message-buffers 'custom-loads '("message")) (put 'gnus-threading 'custom-loads '("gnus-sum")) ! (put 'article 'custom-loads '("gnus-sum" "gnus-cite" "gnus-art")) (put 'gnus-nocem 'custom-loads '("gnus-nocem")) (put 'gnus-cite 'custom-loads '("gnus-cite")) (put 'gnus-demon 'custom-loads '("gnus-demon")) ! (put 'gnus-mail 'custom-loads '("nnmail")) (put 'message-interface 'custom-loads '("message")) (put 'gnus-edit-form 'custom-loads '("gnus-eform")) ! (put 'emacs 'custom-loads '("custom" "widget-edit" "message" "gnus" "custom-opt")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) (put 'gnus-topic 'custom-loads '("gnus-topic")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) (put 'message-headers 'custom-loads '("message")) (put 'message-forwarding 'custom-loads '("message")) (put 'gnus-duplicate 'custom-loads '("gnus-dup")) ! (put 'widgets 'custom-loads '("widget-edit")) (put 'earcon 'custom-loads '("earcon")) (put 'gnus-summary-format 'custom-loads '("gnus-sum")) (put 'gnus-windows 'custom-loads '("gnus-win")) ! (put 'gnus-summary 'custom-loads '("gnus-sum")) ! (put 'gnus-group 'custom-loads '("gnus-topic" "gnus-sum" "gnus-group")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) (put 'message-mail 'custom-loads '("message")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) (put 'message 'custom-loads '("message")) (put 'message-sending 'custom-loads '("message")) (put 'message-insertion 'custom-loads '("message")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) ! (put 'customize 'custom-loads '("custom" "cus-edit")) (put 'gnus-asynchronous 'custom-loads '("gnus-async")) ! (put 'article-mime 'custom-loads '("gnus-sum")) ! (put 'gnus-extract 'custom-loads '("gnus-uu" "gnus-sum")) ! (put 'article-various 'custom-loads '("gnus-sum")) (put 'mesage-sending 'custom-loads '("message")) (put 'picons 'custom-loads '("gnus-picon")) (provide 'gnus-load) --- 2,109 ---- ;; ;;; Code: ! (put 'nnmail 'custom-loads '("nnmail")) ! (put 'gnus-article-emphasis 'custom-loads '("gnus-art")) ! (put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art")) ! (put 'gnus-newsrc 'custom-loads '("gnus-start")) ! (put 'nnmail-procmail 'custom-loads '("nnmail")) ! (put 'gnus-score-kill 'custom-loads '("gnus-kill")) ! (put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon")) ! (put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill")) ! (put 'gnus-exit 'custom-loads '("gnus-group")) (put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) ! (put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group")) ! (put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum")) (put 'gnus-various 'custom-loads '("gnus-sum")) ! (put 'gnus-article-washing 'custom-loads '("gnus-art")) ! (put 'gnus-score-files 'custom-loads '("gnus-score")) (put 'message-news 'custom-loads '("message")) (put 'gnus-thread 'custom-loads '("gnus-sum")) + (put 'languages 'custom-loads '("cus-edit")) + (put 'development 'custom-loads '("cus-edit")) (put 'gnus-treading 'custom-loads '("gnus-sum")) + (put 'nnmail-various 'custom-loads '("nnmail")) + (put 'extensions 'custom-loads '("wid-edit")) (put 'message-various 'custom-loads '("message")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) ! (put 'news 'custom-loads '("message" "gnus")) ! (put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) ! (put 'gnus-server 'custom-loads '("gnus")) (put 'gnus-summary-visual 'custom-loads '("gnus-sum")) ! (put 'gnus-group-listing 'custom-loads '("gnus-group")) ! (put 'gnus-score 'custom-loads '("gnus" "gnus-nocem")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'message-buffers 'custom-loads '("message")) (put 'gnus-threading 'custom-loads '("gnus-sum")) ! (put 'gnus-score-decay 'custom-loads '("gnus-score")) ! (put 'help 'custom-loads '("cus-edit")) (put 'gnus-nocem 'custom-loads '("gnus-nocem")) + (put 'gnus-group-visual 'custom-loads '("gnus-group")) (put 'gnus-cite 'custom-loads '("gnus-cite")) (put 'gnus-demon 'custom-loads '("gnus-demon")) ! (put 'gnus-message 'custom-loads '("message")) ! (put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score")) ! (put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'message-interface 'custom-loads '("message")) + (put 'nnmail-files 'custom-loads '("nnmail")) (put 'gnus-edit-form 'custom-loads '("gnus-eform")) ! (put 'emacs 'custom-loads '("cus-edit")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) (put 'gnus-topic 'custom-loads '("gnus-topic")) + (put 'wp 'custom-loads '("cus-edit")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) + (put 'widget-browse 'custom-loads '("wid-browse")) + (put 'external 'custom-loads '("cus-edit")) (put 'message-headers 'custom-loads '("message")) (put 'message-forwarding 'custom-loads '("message")) + (put 'environment 'custom-loads '("cus-edit")) + (put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art")) (put 'gnus-duplicate 'custom-loads '("gnus-dup")) ! (put 'nnmail-retrieve 'custom-loads '("nnmail")) ! (put 'widgets 'custom-loads '("wid-edit" "wid-browse")) (put 'earcon 'custom-loads '("earcon")) + (put 'hypermedia 'custom-loads '("wid-edit")) + (put 'gnus-group-levels 'custom-loads '("gnus-start" "gnus-group")) (put 'gnus-summary-format 'custom-loads '("gnus-sum")) + (put 'gnus-files 'custom-loads '("nnmail" "gnus")) (put 'gnus-windows 'custom-loads '("gnus-win")) ! (put 'gnus-article-buttons 'custom-loads '("gnus-art")) ! (put 'gnus-summary 'custom-loads '("gnus" "gnus-sum")) ! (put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art")) ! (put 'gnus-group 'custom-loads '("gnus" "gnus-topic")) ! (put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) + (put 'gnus-article-saving 'custom-loads '("gnus-art")) + (put 'nnmail-expire 'custom-loads '("nnmail")) (put 'message-mail 'custom-loads '("message")) + (put 'faces 'custom-loads '("wid-edit" "cus-edit" "gnus")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) + (put 'applications 'custom-loads '("cus-edit")) + (put 'gnus-start-server 'custom-loads '("gnus-start")) + (put 'gnus-extract-archive 'custom-loads '("gnus-uu")) (put 'message 'custom-loads '("message")) (put 'message-sending 'custom-loads '("message")) + (put 'editing 'custom-loads '("cus-edit")) + (put 'gnus-score-adapt 'custom-loads '("gnus-score")) (put 'message-insertion 'custom-loads '("message")) + (put 'gnus-extract-post 'custom-loads '("gnus-uu")) + (put 'mail 'custom-loads '("message" "gnus")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) ! (put 'gnus-group-new 'custom-loads '("gnus-start")) ! (put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit")) ! (put 'nnmail-split 'custom-loads '("nnmail")) (put 'gnus-asynchronous 'custom-loads '("gnus-async")) ! (put 'gnus-dribble-file 'custom-loads '("gnus-start")) ! (put 'gnus-article-highlight 'custom-loads '("gnus-art")) ! (put 'gnus-extract 'custom-loads '("gnus-uu")) ! (put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art")) ! (put 'gnus-group-foreign 'custom-loads '("gnus-group")) ! (put 'programming 'custom-loads '("cus-edit")) (put 'mesage-sending 'custom-loads '("message")) + (put 'nnmail-prepare 'custom-loads '("nnmail")) (put 'picons 'custom-loads '("gnus-picon")) + (put 'gnus-article-signature 'custom-loads '("gnus-art")) + (put 'gnus-group-various 'custom-loads '("gnus-group")) (provide 'gnus-load) *** pub/rgnus/lisp/gnus-logic.el Thu Jan 9 11:59:40 1997 --- rgnus/lisp/gnus-logic.el Fri Mar 7 23:51:19 1997 *************** *** 29,35 **** (require 'gnus-score) (require 'gnus-util) ! ;;; Internal variables. (defvar gnus-advanced-headers nil) --- 29,35 ---- (require 'gnus-score) (require 'gnus-util) ! ;;; Internal variables. (defvar gnus-advanced-headers nil) *************** *** 53,59 **** (eval-and-compile (autoload 'parse-time-string "parse-time")) ! (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." (let ((headers gnus-newsgroup-headers) --- 53,59 ---- (eval-and-compile (autoload 'parse-time-string "parse-time")) ! (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." (let ((headers gnus-newsgroup-headers) *************** *** 79,85 **** (defun gnus-advanced-score-rule (rule) "Apply RULE to `gnus-advanced-headers'." (let ((type (car rule))) ! (cond ;; "And" rule. ((or (eq type '&) (eq type 'and)) (pop rule) --- 79,85 ---- (defun gnus-advanced-score-rule (rule) "Apply RULE to `gnus-advanced-headers'." (let ((type (car rule))) ! (cond ;; "And" rule. ((or (eq type '&) (eq type 'and)) (pop rule) *************** *** 106,112 **** ;; This is a `1-'-type redirection rule. ((and (symbolp type) (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) ! (let ((gnus-advanced-headers (gnus-parent-headers gnus-advanced-headers (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) --- 106,112 ---- ;; This is a `1-'-type redirection rule. ((and (symbolp type) (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) ! (let ((gnus-advanced-headers (gnus-parent-headers gnus-advanced-headers (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) *************** *** 165,171 **** (let ((date (encode-time (parse-time-string (aref gnus-advanced-headers index)))) (match (encode-time (parse-time-string match)))) ! (cond ((eq type 'at) (equal date match)) ((eq type 'before) --- 165,171 ---- (let ((date (encode-time (parse-time-string (aref gnus-advanced-headers index)))) (match (encode-time (parse-time-string match)))) ! (cond ((eq type 'at) (equal date match)) ((eq type 'before) *************** *** 188,194 **** ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. ! (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) (setq ofunc request-func) --- 188,194 ---- ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. ! (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) (setq ofunc request-func) *************** *** 210,216 **** (point-max)))) (let* ((case-fold-search (not (eq (downcase (symbol-name type)) (symbol-name type)))) ! (search-func (cond ((memq type '(r R regexp Regexp)) 're-search-forward) ((memq type '(s S string String)) --- 210,216 ---- (point-max)))) (let* ((case-fold-search (not (eq (downcase (symbol-name type)) (symbol-name type)))) ! (search-func (cond ((memq type '(r R regexp Regexp)) 're-search-forward) ((memq type '(s S string String)) *** pub/rgnus/lisp/gnus-mh.el Thu Jan 9 11:59:40 1997 --- rgnus/lisp/gnus-mh.el Fri Mar 7 23:51:19 1997 *************** *** 59,65 **** gnus-newsgroup-last-folder) gnus-newsgroup-last-folder) (folder folder) ! (t (mh-prompt-for-folder "Save article in" (funcall gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder) --- 59,65 ---- gnus-newsgroup-last-folder) gnus-newsgroup-last-folder) (folder folder) ! (t (mh-prompt-for-folder "Save article in" (funcall gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder) *************** *** 71,77 **** (save-restriction (widen) (unwind-protect ! (call-process-region (point-min) (point-max) "rcvstore" nil errbuf nil folder) (set-buffer errbuf) (if (zerop (buffer-size)) --- 71,77 ---- (save-restriction (widen) (unwind-protect ! (call-process-region (point-min) (point-max) "rcvstore" nil errbuf nil folder) (set-buffer errbuf) (if (zerop (buffer-size)) *** pub/rgnus/lisp/gnus-move.el Thu Jan 9 11:59:40 1997 --- rgnus/lisp/gnus-move.el Fri Mar 7 23:51:19 1997 *************** *** 40,46 **** Update the .newsrc.eld file to reflect the change of nntp server." (interactive (list gnus-select-method (gnus-read-method "Move to method: "))) ! ;; First start Gnus. (let ((gnus-activate-level 0) (nnmail-spool-file nil)) --- 40,46 ---- Update the .newsrc.eld file to reflect the change of nntp server." (interactive (list gnus-select-method (gnus-read-method "Move to method: "))) ! ;; First start Gnus. (let ((gnus-activate-level 0) (nnmail-spool-file nil)) *************** *** 77,83 **** (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") ! (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (read (current-buffer)) hashtb) --- 77,83 ---- (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") ! (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (read (current-buffer)) hashtb) *************** *** 86,92 **** (when (and (gnus-request-group group nil from-server) (gnus-active group) (setq type (gnus-retrieve-headers ! (gnus-uncompress-range (gnus-active group)) group from-server))) ;; Make it easier to map marks. --- 86,92 ---- (when (and (gnus-request-group group nil from-server) (gnus-active group) (setq type (gnus-retrieve-headers ! (gnus-uncompress-range (gnus-active group)) group from-server))) ;; Make it easier to map marks. *************** *** 108,115 **** (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") ! (setq to-article ! (gnus-gethash (buffer-substring (match-beginning 1) (match-end 1)) hashtb)) ;; Add this article to the list of read articles. --- 108,115 ---- (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") ! (setq to-article ! (gnus-gethash (buffer-substring (match-beginning 1) (match-end 1)) hashtb)) ;; Add this article to the list of read articles. *************** *** 123,130 **** ;; Now we know what the read articles are and what the ;; article marks are. We transform the information ;; into the Gnus info format. ! (setq to-reads ! (gnus-range-add (gnus-compress-sequence (sort to-reads '<) t) (cons 1 (1- (car to-active))))) (gnus-info-set-read info to-reads) --- 123,130 ---- ;; Now we know what the read articles are and what the ;; article marks are. We transform the information ;; into the Gnus info format. ! (setq to-reads ! (gnus-range-add (gnus-compress-sequence (sort to-reads '<) t) (cons 1 (1- (car to-active))))) (gnus-info-set-read info to-reads) *************** *** 152,158 **** (interactive (let ((info (gnus-get-info (gnus-group-group-name)))) (list info (gnus-find-method-for-group (gnus-info-group info)) ! (gnus-read-method (format "Move group %s to method: " (gnus-info-group info)))))) (save-excursion (gnus-move-group-to-server info from-server to-server) --- 152,158 ---- (interactive (let ((info (gnus-get-info (gnus-group-group-name)))) (list info (gnus-find-method-for-group (gnus-info-group info)) ! (gnus-read-method (format "Move group %s to method: " (gnus-info-group info)))))) (save-excursion (gnus-move-group-to-server info from-server to-server) *************** *** 160,166 **** (gnus-info-set-method info to-server t) ;; We also have to change the name of the group and stuff. (let* ((group (gnus-info-group info)) ! (new-name (gnus-group-prefixed-name (gnus-group-real-name group) to-server))) (gnus-info-set-group info new-name) (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) --- 160,166 ---- (gnus-info-set-method info to-server t) ;; We also have to change the name of the group and stuff. (let* ((group (gnus-info-group info)) ! (new-name (gnus-group-prefixed-name (gnus-group-real-name group) to-server))) (gnus-info-set-group info new-name) (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) *** pub/rgnus/lisp/gnus-msg.el Mon Feb 10 14:27:15 1997 --- rgnus/lisp/gnus-msg.el Fri Mar 7 23:51:20 1997 *************** *** 48,54 **** "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable ! can also be a list of group names. If you want to have greater control over what group to put each message in, you can set this variable to a function that checks the --- 48,54 ---- "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable ! can also be a list of group names. If you want to have greater control over what group to put each message in, you can set this variable to a function that checks the *************** *** 61,67 **** gatewayed to a newsgroup, and you want to followup to an article in the group.") ! (defvar gnus-sent-message-ids-file (nnheader-concat gnus-directory "Sent-Message-IDs") "File where Gnus saves a cache of sent message ids.") --- 61,67 ---- gatewayed to a newsgroup, and you want to followup to an article in the group.") ! (defvar gnus-sent-message-ids-file (nnheader-concat gnus-directory "Sent-Message-IDs") "File where Gnus saves a cache of sent message ids.") *************** *** 173,179 **** (make-local-variable 'gnus-newsgroup-name) (run-hooks 'gnus-message-setup-hook)) (gnus-configure-windows ,config t)))) ! (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) --- 173,179 ---- (make-local-variable 'gnus-newsgroup-name) (run-hooks 'gnus-message-setup-hook)) (gnus-configure-windows ,config t)))) ! (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) *************** *** 227,234 **** (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-set-global-variables) (when yank --- 227,234 ---- (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-set-global-variables) (when yank *************** *** 239,245 **** (gnus-newsgroup-name gnus-newsgroup-name)) ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) --- 239,245 ---- (gnus-newsgroup-name gnus-newsgroup-name)) ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) *************** *** 249,256 **** (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-followup arg t)) --- 249,256 ---- (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-followup arg t)) *************** *** 375,381 **** (t 'message)) (let* ((group (or group gnus-newsgroup-name)) (pgroup group) ! to-address to-group mailing-list to-list newsgroup-p) (when group (setq to-address (gnus-group-find-parameter group 'to-address) --- 375,381 ---- (t 'message)) (let* ((group (or group gnus-newsgroup-name)) (pgroup group) ! to-address to-group mailing-list to-list newsgroup-p) (when group (setq to-address (gnus-group-find-parameter group 'to-address) *************** *** 389,395 **** (gnus-news-group-p to-group)) newsgroup-p force-news ! (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) (if header (mail-header-number header) gnus-current-article)) --- 389,395 ---- (gnus-news-group-p to-group)) newsgroup-p force-news ! (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) (if header (mail-header-number header) gnus-current-article)) *************** *** 418,425 **** "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." (let ((group-method (gnus-find-method-for-group group))) ! (cond ! ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) (or gnus-post-method gnus-select-method message-post-method)) --- 418,425 ---- "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." (let ((group-method (gnus-find-method-for-group group))) ! (cond ! ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) (or gnus-post-method gnus-select-method message-post-method)) *************** *** 449,455 **** (push method post-methods))) ;; Create a name-method alist. (setq method-alist ! (mapcar (lambda (m) (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) post-methods)) --- 449,455 ---- (push method post-methods))) ;; Create a name-method alist. (setq method-alist ! (mapcar (lambda (m) (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) post-methods)) *************** *** 475,481 **** (widen) (narrow-to-region (goto-char (point-min)) ! (or (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (match-beginning 0)) (point-max))) --- 475,481 ---- (widen) (narrow-to-region (goto-char (point-min)) ! (or (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (match-beginning 0)) (point-max))) *************** *** 499,510 **** (load t t t))) (if (member message-id gnus-inews-sent-ids) ;; Reject this message. ! (not (gnus-yes-or-no-p (format "Message %s already sent. Send anyway? " message-id))) (push message-id gnus-inews-sent-ids) ;; Chop off the last Message-IDs. ! (when (setq end (nthcdr gnus-sent-message-ids-length gnus-inews-sent-ids)) (setcdr end nil)) (nnheader-temp-write gnus-sent-message-ids-file --- 499,510 ---- (load t t t))) (if (member message-id gnus-inews-sent-ids) ;; Reject this message. ! (not (gnus-yes-or-no-p (format "Message %s already sent. Send anyway? " message-id))) (push message-id gnus-inews-sent-ids) ;; Chop off the last Message-IDs. ! (when (setq end (nthcdr gnus-sent-message-ids-length gnus-inews-sent-ids)) (setcdr end nil)) (nnheader-temp-write gnus-sent-message-ids-file *************** *** 540,547 **** ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) ! (let ((mail-header-separator ! (progn (goto-char (point-min)) (if (and (search-forward (concat "\n" mail-header-separator "\n") nil t) --- 540,547 ---- ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) ! (let ((mail-header-separator ! (progn (goto-char (point-min)) (if (and (search-forward (concat "\n" mail-header-separator "\n") nil t) *************** *** 565,585 **** ;;; ! ;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode (defun gnus-summary-reply (&optional yank wide) "Start composing a reply mail to the current message. ! If prefix argument YANK is non-nil, the original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (when yank (gnus-summary-goto-subject (car yank))) (let ((gnus-article-reply t)) (gnus-setup-message (if yank 'reply-yank 'reply) --- 565,585 ---- ;;; ! ;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode (defun gnus-summary-reply (&optional yank wide) "Start composing a reply mail to the current message. ! If prefix argument YANK is non-nil, the original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (when yank (gnus-summary-goto-subject (car yank))) (let ((gnus-article-reply t)) (gnus-setup-message (if yank 'reply-yank 'reply) *************** *** 598,607 **** (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. ! If prefix argument YANK is non-nil, the original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-reply yank t)) --- 598,607 ---- (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. ! If prefix argument YANK is non-nil, the original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-reply yank t)) *************** *** 640,646 **** (interactive "P") (gnus-summary-mail-forward full-headers t)) ! (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") --- 640,646 ---- (interactive "P") (gnus-summary-mail-forward full-headers t)) ! (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") *************** *** 649,655 **** "Send a nastygram to the author of the current article." (interactive "P") (when (or gnus-expert-user ! (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) --- 649,655 ---- "Send a nastygram to the author of the current article." (interactive "P") (when (or gnus-expert-user ! (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) *************** *** 705,711 **** (setq beg (point)) (skip-chars-forward "^,") (while (zerop ! (save-excursion (save-restriction (let ((i 0)) (narrow-to-region beg (point)) --- 705,711 ---- (setq beg (point)) (skip-chars-forward "^,") (while (zerop ! (save-excursion (save-restriction (let ((i 0)) (narrow-to-region beg (point)) *************** *** 729,735 **** (when (and to-address (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one ! ;; here. Magic! (gnus-group-add-parameter group (cons 'to-list to-address))))) (defun gnus-put-message () --- 729,735 ---- (when (and to-address (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one ! ;; here. Magic! (gnus-group-add-parameter group (cons 'to-list to-address))))) (defun gnus-put-message () *************** *** 738,744 **** (let ((reply gnus-article-reply) (winconf gnus-prev-winconf) (group gnus-newsgroup-name)) ! (or (and group (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) --- 738,744 ---- (let ((reply gnus-article-reply) (winconf gnus-prev-winconf) (group gnus-newsgroup-name)) ! (or (and group (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) *************** *** 763,769 **** (when (gnus-buffer-exists-p (car-safe reply)) (set-buffer (car reply)) (and (cdr reply) ! (gnus-summary-mark-article-as-replied (cdr reply)))) (when winconf (set-window-configuration winconf))))) --- 763,769 ---- (when (gnus-buffer-exists-p (car-safe reply)) (set-buffer (car reply)) (and (cdr reply) ! (gnus-summary-mark-article-as-replied (cdr reply)))) (when winconf (set-window-configuration winconf))))) *************** *** 772,778 **** "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") ! (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) --- 772,778 ---- "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") ! (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) *************** *** 890,904 **** (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) (message-bounce) ! ;; If there are references, we fetch the article we answered to. (and fetch parent (gnus-summary-refer-article parent) (gnus-summary-show-all-headers))))) ;;; Gcc handling. ! ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) (when (gnus-alive-p) (save-excursion (save-restriction --- 890,905 ---- (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) (message-bounce) ! ;; If there are references, we fetch the article we answered to. (and fetch parent (gnus-summary-refer-article parent) (gnus-summary-show-all-headers))))) ;;; Gcc handling. ! ;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) + (interactive) (when (gnus-alive-p) (save-excursion (save-restriction *************** *** 912,922 **** (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) ! (gnus-check-server (setq method (cond ((and (null (gnus-get-info group)) (eq (car gnus-message-archive-method) ! (car (gnus-server-to-method (gnus-group-method group))))) ;; If the group doesn't exist, we assume --- 913,923 ---- (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) ! (gnus-check-server (setq method (cond ((and (null (gnus-get-info group)) (eq (car gnus-message-archive-method) ! (car (gnus-server-to-method (gnus-group-method group))))) ;; If the group doesn't exist, we assume *************** *** 934,945 **** (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) (goto-char (point-min)) ! (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) (unless (gnus-request-accept-article group method t) ! (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) (kill-buffer (current-buffer)))))))))) --- 935,946 ---- (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) (goto-char (point-min)) ! (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) (unless (gnus-request-accept-article group method t) ! (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) (kill-buffer (current-buffer)))))))))) *************** *** 950,956 **** (save-restriction (gnus-inews-narrow-to-headers) (let* ((group gnus-outgoing-message-group) ! (gcc (cond ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) --- 951,957 ---- (save-restriction (gnus-inews-narrow-to-headers) (let* ((group gnus-outgoing-message-group) ! (gcc (cond ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) *************** *** 968,974 **** result gcc-self-val (groups ! (cond ((null gnus-message-archive-method) ;; Ignore. nil) --- 969,975 ---- result gcc-self-val (groups ! (cond ((null gnus-message-archive-method) ;; Ignore. nil) *************** *** 989,995 **** (while (and var (not (setq result ! (cond ((stringp (caar var)) ;; Regexp. (when (string-match (caar var) group) --- 990,996 ---- (while (and var (not (setq result ! (cond ((stringp (caar var)) ;; Regexp. (when (string-match (caar var) group) *************** *** 1014,1020 **** (setq gcc-self-val (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) ! (progn (insert (if (stringp gcc-self-val) gcc-self-val --- 1015,1021 ---- (setq gcc-self-val (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) ! (progn (insert (if (stringp gcc-self-val) gcc-self-val *************** *** 1027,1033 **** (while (setq name (pop groups)) (insert (if (string-match ":" name) name ! (gnus-group-prefixed-name name gnus-message-archive-method))) (when groups (insert " "))) --- 1028,1034 ---- (while (setq name (pop groups)) (insert (if (string-match ":" name) name ! (gnus-group-prefixed-name name gnus-message-archive-method))) (when groups (insert " "))) *************** *** 1038,1044 **** (interactive) (gnus-set-global-variables) (let (buf) ! (if (not (setq buf (gnus-request-restore-buffer (gnus-summary-article-number) gnus-newsgroup-name))) (error "Couldn't restore the article") (switch-to-buffer buf) --- 1039,1045 ---- (interactive) (gnus-set-global-variables) (let (buf) ! (if (not (setq buf (gnus-request-restore-buffer (gnus-summary-article-number) gnus-newsgroup-name))) (error "Couldn't restore the article") (switch-to-buffer buf) *************** *** 1053,1064 **** (let ((gnus-draft-buffer (current-buffer))) (gnus-configure-windows 'draft t) (goto-char (point)))))) ! (gnus-add-shutdown 'gnus-inews-close 'gnus) (defun gnus-inews-close () (setq gnus-inews-sent-ids nil)) ! ;;; Allow redefinition of functions. (gnus-ems-redefine) --- 1054,1065 ---- (let ((gnus-draft-buffer (current-buffer))) (gnus-configure-windows 'draft t) (goto-char (point)))))) ! (gnus-add-shutdown 'gnus-inews-close 'gnus) (defun gnus-inews-close () (setq gnus-inews-sent-ids nil)) ! ;;; Allow redefinition of functions. (gnus-ems-redefine) *** pub/rgnus/lisp/gnus-nocem.el Sun Feb 16 18:16:36 1997 --- rgnus/lisp/gnus-nocem.el Fri Mar 7 23:51:20 1997 *************** *** 35,48 **** "NoCeM pseudo-cancellation treatment" :group 'gnus-score) ! (defcustom gnus-nocem-groups '("news.lists.filters" "news.admin.net-abuse.bulletins" "alt.nocem.misc" "news.admin.net-abuse.announce") "List of groups that will be searched for NoCeM messages." :group 'gnus-nocem :type '(repeat (string :tag "Group"))) ! (defcustom gnus-nocem-issuers '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] "rbraver@ohww.norman.ok.us" ; Robert Braver "clewis@ferret.ocunix.on.ca;" ; Chris Lewis --- 35,48 ---- "NoCeM pseudo-cancellation treatment" :group 'gnus-score) ! (defcustom gnus-nocem-groups '("news.lists.filters" "news.admin.net-abuse.bulletins" "alt.nocem.misc" "news.admin.net-abuse.announce") "List of groups that will be searched for NoCeM messages." :group 'gnus-nocem :type '(repeat (string :tag "Group"))) ! (defcustom gnus-nocem-issuers '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] "rbraver@ohww.norman.ok.us" ; Robert Braver "clewis@ferret.ocunix.on.ca;" ; Chris Lewis *************** *** 54,60 **** :group 'gnus-nocem :type '(repeat string)) ! (defcustom gnus-nocem-directory (nnheader-concat gnus-article-save-directory "NoCeM/") "*Directory where NoCeM files will be stored." :group 'gnus-nocem --- 54,60 ---- :group 'gnus-nocem :type '(repeat string)) ! (defcustom gnus-nocem-directory (nnheader-concat gnus-article-save-directory "NoCeM/") "*Directory where NoCeM files will be stored." :group 'gnus-nocem *************** *** 110,116 **** (ignore-errors (load (gnus-nocem-active-file) t t t))) ;; Go through all groups and see whether new articles have ! ;; arrived. (while (setq group (pop groups)) (if (not (setq gactive (gnus-activate-group group))) () ; This group doesn't exist. --- 110,116 ---- (ignore-errors (load (gnus-nocem-active-file) t t t))) ;; Go through all groups and see whether new articles have ! ;; arrived. (while (setq group (pop groups)) (if (not (setq gactive (gnus-activate-group group))) () ; This group doesn't exist. *************** *** 126,140 **** (nnheader-temp-write nil (setq headers (if (eq 'nov ! (gnus-retrieve-headers (setq articles (gnus-uncompress-range ! (cons (if active (1+ (cdr active)) (car gactive)) (cdr gactive)))) group)) ! (gnus-get-newsgroup-headers-xover articles nil dependencies) (gnus-get-newsgroup-headers dependencies))) (while (setq header (pop headers)) --- 126,140 ---- (nnheader-temp-write nil (setq headers (if (eq 'nov ! (gnus-retrieve-headers (setq articles (gnus-uncompress-range ! (cons (if active (1+ (cdr active)) (car gactive)) (cdr gactive)))) group)) ! (gnus-get-newsgroup-headers-xover articles nil dependencies) (gnus-get-newsgroup-headers dependencies))) (while (setq header (pop headers)) *************** *** 167,173 **** (let ((date (mail-header-date header)) issuer b e) (when (or (not date) ! (nnmail-time-less (nnmail-time-since (nnmail-date-to-time date)) (nnmail-days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) --- 167,173 ---- (let ((date (mail-header-date header)) issuer b e) (when (or (not date) ! (nnmail-time-less (nnmail-time-since (nnmail-date-to-time date)) (nnmail-days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) *************** *** 245,255 **** (interactive) (unless gnus-nocem-alist ;; The buffer doesn't exist, so we create it and load the NoCeM ! ;; cache. (when (file-exists-p (gnus-nocem-cache-file)) (load (gnus-nocem-cache-file) t t t) (gnus-nocem-alist-to-hashtb)))) ! (defun gnus-nocem-save-cache () "Save the NoCeM cache." (when (and gnus-nocem-alist --- 245,255 ---- (interactive) (unless gnus-nocem-alist ;; The buffer doesn't exist, so we create it and load the NoCeM ! ;; cache. (when (file-exists-p (gnus-nocem-cache-file)) (load (gnus-nocem-cache-file) t t t) (gnus-nocem-alist-to-hashtb)))) ! (defun gnus-nocem-save-cache () "Save the NoCeM cache." (when (and gnus-nocem-alist *** pub/rgnus/lisp/gnus-picon.el Fri Mar 7 07:37:00 1997 --- rgnus/lisp/gnus-picon.el Fri Mar 7 23:51:20 1997 *************** *** 52,58 **** :group 'picons) (defcustom gnus-picons-database "/usr/local/faces" ! "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" :type 'directory --- 52,58 ---- :group 'picons) (defcustom gnus-picons-database "/usr/local/faces" ! "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" :type 'directory *************** *** 69,75 **** :group 'picons) (defcustom gnus-picons-domain-directories '("domains") ! "List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) :group 'picons) --- 69,75 ---- :group 'picons) (defcustom gnus-picons-domain-directories '("domains") ! "List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) :group 'picons) *************** *** 79,85 **** :type 'boolean :group 'picons) ! (defcustom gnus-picons-x-face-file-name (format "/tmp/picon-xface.%s.xbm" (user-login-name)) "The name of the file in which to store the converted X-face header." :type 'string --- 79,85 ---- :type 'boolean :group 'picons) ! (defcustom gnus-picons-x-face-file-name (format "/tmp/picon-xface.%s.xbm" (user-login-name)) "The name of the file in which to store the converted X-face header." :type 'string *************** *** 119,125 **** (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent) ;;; Internal variables. ! (defvar gnus-group-annotations nil) (defvar gnus-article-annotations nil) (defvar gnus-x-face-annotations nil) --- 119,125 ---- (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent) ;;; Internal variables. ! (defvar gnus-group-annotations nil) (defvar gnus-article-annotations nil) (defvar gnus-x-face-annotations nil) *************** *** 180,186 **** (sleep-for .1))) ;; display it (save-excursion ! (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) (gnus-add-current-to-buffer-list) (goto-char (point-min)) --- 180,186 ---- (sleep-for .1))) ;; display it (save-excursion ! (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) (gnus-add-current-to-buffer-list) (goto-char (point-min)) *************** *** 189,195 **** (push (make-annotation "\n" (point) 'text) gnus-x-face-annotations)) ;; append the annotation to gnus-article-annotations for deletion. ! (setq gnus-x-face-annotations (append (gnus-picons-try-to-find-face gnus-picons-x-face-file-name t) gnus-x-face-annotations))) --- 189,195 ---- (push (make-annotation "\n" (point) 'text) gnus-x-face-annotations)) ;; append the annotation to gnus-article-annotations for deletion. ! (setq gnus-x-face-annotations (append (gnus-picons-try-to-find-face gnus-picons-x-face-file-name t) gnus-x-face-annotations))) *************** *** 207,213 **** (when (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x)) (setq from (mail-fetch-field "from")) ! (setq from (downcase (or (cadr (mail-extract-address-components from)) ""))) (or (setq at-idx (string-match "@" from)) --- 207,213 ---- (when (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x)) (setq from (mail-fetch-field "from")) ! (setq from (downcase (or (cadr (mail-extract-address-components from)) ""))) (or (setq at-idx (string-match "@" from)) *************** *** 219,225 **** (nreverse (message-tokenize-header gnus-local-domain ".")) '("")) ! (nreverse (message-tokenize-header (substring from (1+ at-idx)) "."))))) (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) --- 219,225 ---- (nreverse (message-tokenize-header gnus-local-domain ".")) '("")) ! (nreverse (message-tokenize-header (substring from (1+ at-idx)) "."))))) (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) *************** *** 232,238 **** (unless (eolp) (push (make-annotation "\n" (point) 'text) gnus-article-annotations))) ! (gnus-picons-remove gnus-article-annotations) (setq gnus-article-annotations nil) --- 232,238 ---- (unless (eolp) (push (make-annotation "\n" (point) 'text) gnus-article-annotations))) ! (gnus-picons-remove gnus-article-annotations) (setq gnus-article-annotations nil) *************** *** 243,249 **** (nconc (gnus-picons-insert-face-if-exists (car databases) addrs ! "unknown" (or gnus-picons-display-as-address gnus-article-annotations) t t) gnus-article-annotations)) (setq databases (cdr databases))) --- 243,249 ---- (nconc (gnus-picons-insert-face-if-exists (car databases) addrs ! "unknown" (or gnus-picons-display-as-address gnus-article-annotations) t t) gnus-article-annotations)) (setq databases (cdr databases))) *************** *** 252,258 **** (when gnus-picons-display-as-address (setq gnus-article-annotations (nconc gnus-article-annotations ! (list (make-annotation "@" (point) 'text nil nil nil t))))) ;; then do user directories, --- 252,258 ---- (when gnus-picons-display-as-address (setq gnus-article-annotations (nconc gnus-article-annotations ! (list (make-annotation "@" (point) 'text nil nil nil t))))) ;; then do user directories, *************** *** 262,284 **** (while databases (setq found (nconc (gnus-picons-insert-face-if-exists ! (car databases) addrs username ! (or gnus-picons-display-as-address gnus-article-annotations) nil t) found)) (setq databases (cdr databases))) ;; add their name if no face exists (when (and gnus-picons-display-as-address (not found)) (setq found ! (list (make-annotation username (point) 'text nil nil nil t)))) ! (setq gnus-article-annotations (nconc found gnus-article-annotations))) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) (defun gnus-group-display-picons () ! "Display icons for the group in the gnus-picons-display-where buffer." (interactive) ;; let display catch up so far (when gnus-picons-refresh-before-display --- 262,284 ---- (while databases (setq found (nconc (gnus-picons-insert-face-if-exists ! (car databases) addrs username ! (or gnus-picons-display-as-address gnus-article-annotations) nil t) found)) (setq databases (cdr databases))) ;; add their name if no face exists (when (and gnus-picons-display-as-address (not found)) (setq found ! (list (make-annotation username (point) 'text nil nil nil t)))) ! (setq gnus-article-annotations (nconc found gnus-article-annotations))) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) (defun gnus-group-display-picons () ! "Display icons for the group in the gnus-picons-display-where buffer." (interactive) ;; let display catch up so far (when gnus-picons-refresh-before-display *************** *** 328,335 **** ;; '(gnus-picons-insert-face-if-exists ;; "Database" '("edu" "indiana" "cs") "Name") ;; looks for: ! ;; 1. edu/indiana/cs/Name ! ;; 2. edu/indiana/Name ;; 3. edu/Name ;; '(gnus-picons-insert-face-if-exists ;; "Database/MISC" '("edu" "indiana" "cs") "Name") --- 328,335 ---- ;; '(gnus-picons-insert-face-if-exists ;; "Database" '("edu" "indiana" "cs") "Name") ;; looks for: ! ;; 1. edu/indiana/cs/Name ! ;; 2. edu/indiana/Name ;; 3. edu/Name ;; '(gnus-picons-insert-face-if-exists ;; "Database/MISC" '("edu" "indiana" "cs") "Name") *************** *** 339,345 **** ;; picon databases, but otherwise we would always see the MISC/unknown face. (let ((bar (and (not nobar-p) (or gnus-picons-display-as-address ! (annotations-in-region (point) (min (point-max) (1+ (point))) (current-buffer))))) (path (concat (file-name-as-directory gnus-picons-database) --- 339,345 ---- ;; picon databases, but otherwise we would always see the MISC/unknown face. (let ((bar (and (not nobar-p) (or gnus-picons-display-as-address ! (annotations-in-region (point) (min (point-max) (1+ (point))) (current-buffer))))) (path (concat (file-name-as-directory gnus-picons-database) *************** *** 352,383 **** (file-accessible-directory-p path)) (setq cur (pop addrs) path (concat path cur "/")) ! (if (setq found (gnus-picons-try-suffixes (concat path filename "/face."))) ! (progn (setq picons (nconc (when (and domainp first rightp) (list (make-annotation ! "." (point) 'text nil nil nil rightp) picons)) ! (gnus-picons-try-to-find-face found nil (if domainp cur filename) rightp) (when (and domainp first (not rightp)) (list (make-annotation ! "." (point) 'text nil nil nil rightp) picons)) picons))) (when domainp ! (setq picons ! (nconc (list (make-annotation ! (if first (concat (if (not rightp) ".") cur (if rightp ".")) cur) (point) 'text nil nil nil rightp)) picons)))) (when (and bar (or domainp found)) ! (setq bar-ann (gnus-picons-try-to-find-face ! (concat gnus-xmas-glyph-directory "bar.xbm") nil nil t)) (when bar-ann (setq picons (nconc picons bar-ann)) --- 352,383 ---- (file-accessible-directory-p path)) (setq cur (pop addrs) path (concat path cur "/")) ! (if (setq found (gnus-picons-try-suffixes (concat path filename "/face."))) ! (progn (setq picons (nconc (when (and domainp first rightp) (list (make-annotation ! "." (point) 'text nil nil nil rightp) picons)) ! (gnus-picons-try-to-find-face found nil (if domainp cur filename) rightp) (when (and domainp first (not rightp)) (list (make-annotation ! "." (point) 'text nil nil nil rightp) picons)) picons))) (when domainp ! (setq picons ! (nconc (list (make-annotation ! (if first (concat (if (not rightp) ".") cur (if rightp ".")) cur) (point) 'text nil nil nil rightp)) picons)))) (when (and bar (or domainp found)) ! (setq bar-ann (gnus-picons-try-to-find-face ! (concat gnus-xmas-glyph-directory "bar.xbm") nil nil t)) (when bar-ann (setq picons (nconc picons bar-ann)) *************** *** 385,397 **** (setq first t)) (when (and addrs domainp) (let ((it (mapconcat 'downcase (nreverse addrs) "."))) ! (make-annotation ! (if first (concat (if (not rightp) ".") it (if rightp ".")) it) (point) 'text nil nil nil rightp))) picons)) (defvar gnus-picons-glyph-alist nil) ! (defun gnus-picons-try-to-find-face (path &optional xface-p part rightp) "If PATH exists, display it as a bitmap. Returns t if succeeded." (let ((glyph (and (not xface-p) --- 385,397 ---- (setq first t)) (when (and addrs domainp) (let ((it (mapconcat 'downcase (nreverse addrs) "."))) ! (make-annotation ! (if first (concat (if (not rightp) ".") it (if rightp ".")) it) (point) 'text nil nil nil rightp))) picons)) (defvar gnus-picons-glyph-alist nil) ! (defun gnus-picons-try-to-find-face (path &optional xface-p part rightp) "If PATH exists, display it as a bitmap. Returns t if succeeded." (let ((glyph (and (not xface-p) *** pub/rgnus/lisp/gnus-range.el Thu Jan 9 11:59:39 1997 --- rgnus/lisp/gnus-range.el Fri Mar 7 23:51:20 1997 *************** *** 263,269 **** (defun gnus-range-add (range1 range2) "Add RANGE2 to RANGE1 destructively." ! (cond ;; If either are nil, then the job is quite easy. ((or (null range1) (null range2)) (or range1 range2)) --- 263,269 ---- (defun gnus-range-add (range1 range2) "Add RANGE2 to RANGE1 destructively." ! (cond ;; If either are nil, then the job is quite easy. ((or (null range1) (null range2)) (or range1 range2)) *** pub/rgnus/lisp/gnus-salt.el Sun Jan 26 12:08:26 1997 --- rgnus/lisp/gnus-salt.el Fri Mar 7 23:51:21 1997 *************** *** 133,139 **** (save-excursion (set-buffer gnus-summary-buffer) gnus-pick-mode)) ! (message-add-action '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) --- 133,139 ---- (save-excursion (set-buffer gnus-summary-buffer) gnus-pick-mode)) ! (message-add-action '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) *************** *** 153,159 **** (when (or catch-up gnus-mark-unpicked-articles-as-read) (gnus-summary-limit-mark-excluded-as-read)) (gnus-summary-first-article) ! (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow (progn --- 153,159 ---- (when (or catch-up gnus-mark-unpicked-articles-as-read) (gnus-summary-limit-mark-excluded-as-read)) (gnus-summary-first-article) ! (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow (progn *************** *** 315,321 **** (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-binary-mode) ! (setq gnus-binary-mode (if (null arg) (not gnus-binary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-binary-mode --- 315,321 ---- (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-binary-mode) ! (setq gnus-binary-mode (if (null arg) (not gnus-binary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-binary-mode *************** *** 381,387 **** ;;; Internal variables. ! (defvar gnus-tree-line-format-alist `((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) (?N gnus-tmp-number ?d) --- 381,387 ---- ;;; Internal variables. ! (defvar gnus-tree-line-format-alist `((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) (?N gnus-tmp-number ?d) *************** *** 426,436 **** (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) ! (setq gnus-tree-mode-line-format-spec ! (gnus-parse-format gnus-tree-mode-line-format gnus-summary-mode-line-format-alist)) ! (setq gnus-tree-line-format-spec ! (gnus-parse-format gnus-tree-line-format gnus-tree-line-format-alist t)) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) --- 426,436 ---- (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) ! (setq gnus-tree-mode-line-format-spec ! (gnus-parse-format gnus-tree-mode-line-format gnus-summary-mode-line-format-alist)) ! (setq gnus-tree-line-format-spec ! (gnus-parse-format gnus-tree-line-format gnus-tree-line-format-alist t)) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) *************** *** 509,515 **** ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! tree-window (min bottom (save-excursion (forward-line (- top)) (point))))) (select-window selected)))) --- 509,515 ---- ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! tree-window (min bottom (save-excursion (forward-line (- top)) (point))))) (select-window selected)))) *************** *** 528,534 **** (let ((windows 0) tot-win-height) (walk-windows (lambda (window) (incf windows))) ! (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) 2)) --- 528,534 ---- (let ((windows 0) tot-win-height) (walk-windows (lambda (window) (incf windows))) ! (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) 2)) *************** *** 613,620 **** (not (eval (caar list)))) (setq list (cdr list))))) (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (if (boundp face) (symbol-value face) face))))) (defun gnus-tree-indent (level) --- 613,620 ---- (not (eval (caar list)))) (setq list (cdr list))))) (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (if (boundp face) (symbol-value face) face))))) (defun gnus-tree-indent (level) *************** *** 757,764 **** (let ((top (save-excursion (set-buffer gnus-summary-buffer) (gnus-cut-thread ! (gnus-remove-thread ! (mail-header-id (gnus-summary-article-header article)) t)))) (gnus-tmp-limit gnus-newsgroup-limit) --- 757,764 ---- (let ((top (save-excursion (set-buffer gnus-summary-buffer) (gnus-cut-thread ! (gnus-remove-thread ! (mail-header-id (gnus-summary-article-header article)) t)))) (gnus-tmp-limit gnus-newsgroup-limit) *************** *** 788,794 **** (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. ! (gnus-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) --- 788,794 ---- (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. ! (gnus-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) *************** *** 809,815 **** (let (region) (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) ! (set-window-point (get-buffer-window (current-buffer) t) (cdr region)))))) ;;; --- 809,815 ---- (let (region) (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) ! (set-window-point (get-buffer-window (current-buffer) t) (cdr region)))))) ;;; *************** *** 841,847 **** ("exit" . gnus-group-exit))) (defvar gnus-carpal-summary-buffer-buttons ! '("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) --- 841,847 ---- ("exit" . gnus-group-exit))) (defvar gnus-carpal-summary-buffer-buttons ! '("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) *************** *** 874,880 **** ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group))) ! (defvar gnus-carpal-server-buffer-buttons '(("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) --- 874,880 ---- ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group))) ! (defvar gnus-carpal-server-buffer-buttons '(("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) *************** *** 941,950 **** (save-excursion (set-buffer (get-buffer-create buffer)) (gnus-carpal-mode) ! (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) (gnus-add-current-to-buffer-list) ! (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) (buffer-read-only nil) --- 941,950 ---- (save-excursion (set-buffer (get-buffer-create buffer)) (gnus-carpal-mode) ! (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) (gnus-add-current-to-buffer-list) ! (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) (buffer-read-only nil) *** pub/rgnus/lisp/gnus-score.el Thu Feb 20 04:19:51 1997 --- rgnus/lisp/gnus-score.el Fri Mar 7 23:51:21 1997 *************** *** 180,186 **** * A function. If the function returns non-nil, the result will be used ! as the home score file. The function will be passed the name of the group as its parameter. * A string. Use the string as the home score file. --- 180,186 ---- * A function. If the function returns non-nil, the result will be used ! as the home score file. The function will be passed the name of the group as its parameter. * A string. Use the string as the home score file. *************** *** 205,211 **** function)) function)) ! (defcustom gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) (gnus-read-mark (from 3) (subject 30)) --- 205,211 ---- function)) function)) ! (defcustom gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) (gnus-read-mark (from 3) (subject 30)) *************** *** 245,251 **** :group 'gnus-score-adapt :type '(repeat string)) ! (defcustom gnus-default-adaptive-word-score-alist `((,gnus-read-mark . 30) (,gnus-catchup-mark . -10) (,gnus-killed-mark . -20) --- 245,251 ---- :group 'gnus-score-adapt :type '(repeat string)) ! (defcustom gnus-default-adaptive-word-score-alist `((,gnus-read-mark . 30) (,gnus-catchup-mark . -10) (,gnus-killed-mark . -20) *************** *** 387,393 **** (defvar gnus-score-alist nil "Alist containing score information. ! The keys can be symbols or strings. The following symbols are defined. touched: If this alist has been modified. mark: Automatically mark articles below this. --- 387,393 ---- (defvar gnus-score-alist nil "Alist containing score information. ! The keys can be symbols or strings. The following symbols are defined. touched: If this alist has been modified. mark: Automatically mark articles below this. *************** *** 469,475 **** (let* ((nscore (gnus-score-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) ! (char-to-header '((?a "from" nil nil string) (?s "subject" nil nil string) (?b "body" "" nil body-string) --- 469,475 ---- (let* ((nscore (gnus-score-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) ! (char-to-header '((?a "from" nil nil string) (?s "subject" nil nil string) (?b "body" "" nil body-string) *************** *** 498,518 **** (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! (hchar (and gnus-score-default-header (aref (symbol-name gnus-score-default-header) 0))) (tchar (and gnus-score-default-type (aref (symbol-name gnus-score-default-type) 0))) (pchar (and gnus-score-default-duration (aref (symbol-name gnus-score-default-duration) 0))) entry temporary type match) ! (unwind-protect (progn ;; First we read the header to score. (while (not hchar) (if mimic ! (progn (sit-for 1) (message "%c-" prefix)) (message "%s header (%s?): " (if increase "Increase" "Lower") --- 498,518 ---- (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! (hchar (and gnus-score-default-header (aref (symbol-name gnus-score-default-header) 0))) (tchar (and gnus-score-default-type (aref (symbol-name gnus-score-default-type) 0))) (pchar (and gnus-score-default-duration (aref (symbol-name gnus-score-default-duration) 0))) entry temporary type match) ! (unwind-protect (progn ;; First we read the header to score. (while (not hchar) (if mimic ! (progn (sit-for 1) (message "%c-" prefix)) (message "%s header (%s?): " (if increase "Increase" "Lower") *************** *** 532,538 **** (if mimic (message "%c %c" prefix hchar) (message "")) (setq tchar (or tchar ?s) pchar (or pchar ?t))) ! ;; We continue reading - the type. (while (not tchar) (if mimic --- 532,538 ---- (if mimic (message "%c %c" prefix hchar) (message "")) (setq tchar (or tchar ?s) pchar (or pchar ?t))) ! ;; We continue reading - the type. (while (not tchar) (if mimic *************** *** 593,599 **** (eq tchar 114) (eq (- pchar 4) 111)) (error "You rang?")) ! (if mimic (error "%c %c %c %c" prefix hchar tchar pchar) (error "")))) ;; Always kill the score help buffer. --- 593,599 ---- (eq tchar 114) (eq (- pchar 4) 111)) (error "You rang?")) ! (if mimic (error "%c %c %c %c" prefix hchar tchar pchar) (error "")))) ;; Always kill the score help buffer. *************** *** 602,616 **** ;; We have all the data, so we enter this score. (setq match (if (string= (nth 2 entry) "") "" (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) ! ;; Modify the match, perhaps. ! (cond ((equal (nth 1 entry) "xref") (when (string-match "^Xref: *" match) (setq match (substring match (match-end 0)))) (when (string-match "^[^:]* +" match) (setq match (substring match (match-end 0)))))) ! (when (memq type '(r R regexp Regexp)) (setq match (regexp-quote match))) --- 602,616 ---- ;; We have all the data, so we enter this score. (setq match (if (string= (nth 2 entry) "") "" (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) ! ;; Modify the match, perhaps. ! (cond ((equal (nth 1 entry) "xref") (when (string-match "^Xref: *" match) (setq match (substring match (match-end 0)))) (when (string-match "^[^:]* +" match) (setq match (substring match (match-end 0)))))) ! (when (memq type '(r R regexp Regexp)) (setq match (regexp-quote match))) *************** *** 624,630 **** temporary) (not (nth 3 entry))) ; Prompt )) ! (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (save-excursion --- 624,630 ---- temporary) (not (nth 3 entry))) ; Prompt )) ! (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (save-excursion *************** *** 646,652 **** (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end (setq n (/ (1- (window-width)) max)) ; items per line (setq width (/ (1- (window-width)) n)) ; width of each item ! ;; insert `n' items, each in a field of width `width' (while alist (if (< i n) () --- 646,652 ---- (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end (setq n (/ (1- (window-width)) max)) ; items per line (setq width (/ (1- (window-width)) n)) ; width of each item ! ;; insert `n' items, each in a field of width `width' (while alist (if (< i n) () *************** *** 665,671 **** (let ((window-min-height 1)) (shrink-window-if-larger-than-buffer)) (select-window (get-buffer-window gnus-summary-buffer)))) ! (defun gnus-summary-header (header &optional no-err) ;; Return HEADER for current articles, or error. (let ((article (gnus-summary-article-number)) --- 665,671 ---- (let ((window-min-height 1)) (shrink-window-if-larger-than-buffer)) (select-window (get-buffer-window gnus-summary-buffer)))) ! (defun gnus-summary-header (header &optional no-err) ;; Return HEADER for current articles, or error. (let ((article (gnus-summary-article-number)) *************** *** 683,689 **** (defun gnus-newsgroup-score-alist () (or ! (let ((param-file (gnus-group-find-parameter gnus-newsgroup-name 'score-file))) (when param-file (gnus-score-load param-file))) --- 683,689 ---- (defun gnus-newsgroup-score-alist () (or ! (let ((param-file (gnus-group-find-parameter gnus-newsgroup-name 'score-file))) (when param-file (gnus-score-load param-file))) *************** *** 693,700 **** (defsubst gnus-score-get (symbol &optional alist) ;; Get SYMBOL's definition in ALIST. ! (cdr (assoc symbol ! (or alist gnus-score-alist (gnus-newsgroup-score-alist))))) --- 693,700 ---- (defsubst gnus-score-get (symbol &optional alist) ;; Get SYMBOL's definition in ALIST. ! (cdr (assoc symbol ! (or alist gnus-score-alist (gnus-newsgroup-score-alist))))) *************** *** 734,741 **** (header (format "%s" (downcase header))) new) (when prompt ! (setq match (read-string ! (format "Match %s on %s, %s: " (cond ((eq date 'now) "now") ((stringp date) --- 734,741 ---- (header (format "%s" (downcase header))) new) (when prompt ! (setq match (read-string ! (format "Match %s on %s, %s: " (cond ((eq date 'now) "now") ((stringp date) *************** *** 750,756 **** ;; Get rid of string props. (setq match (format "%s" match)) ! ;; If this is an integer comparison, we transform from string to int. (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) (setq match (string-to-int match))) --- 750,756 ---- ;; Get rid of string props. (setq match (format "%s" match)) ! ;; If this is an integer comparison, we transform from string to int. (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) (setq match (string-to-int match))) *************** *** 761,767 **** (let ((old (gnus-score-get header)) elem) (setq new ! (cond (type (list match score (and date (if (numberp date) date --- 761,767 ---- (let ((old (gnus-score-get header)) elem) (setq new ! (cond (type (list match score (and date (if (numberp date) date *************** *** 821,827 **** match) ((eq type 'e) (concat "\\`" (regexp-quote match) "\\'")) ! (t (regexp-quote match))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) --- 821,827 ---- match) ((eq type 'e) (concat "\\`" (regexp-quote match) "\\'")) ! (t (regexp-quote match))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) *************** *** 846,853 **** (error "This article is not crossposted")) (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) ! (when (not (string= ! (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) (gnus-summary-score-entry --- 846,853 ---- (error "This article is not crossposted")) (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) ! (when (not (string= ! (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) (gnus-summary-score-entry *************** *** 863,869 **** ;; Added by Per Abrahamsen . (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." ! (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Mark below: "))))) (setq score (or score gnus-summary-default-score 0)) --- 863,869 ---- ;; Added by Per Abrahamsen . (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." ! (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Mark below: "))))) (setq score (or score gnus-summary-default-score 0)) *************** *** 897,903 **** (defun gnus-score-set-expunge-below (score) "Automatically expunge articles with score below SCORE." ! (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Set expunge below: "))))) (setq score (or score gnus-summary-default-score 0)) --- 897,903 ---- (defun gnus-score-set-expunge-below (score) "Automatically expunge articles with score below SCORE." ! (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Set expunge below: "))))) (setq score (or score gnus-summary-default-score 0)) *************** *** 936,943 **** (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. ! (let* ((alist ! (or alist gnus-score-alist (gnus-newsgroup-score-alist))) (entry (assoc symbol alist))) --- 936,943 ---- (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. ! (let* ((alist ! (or alist gnus-score-alist (gnus-newsgroup-score-alist))) (entry (assoc symbol alist))) *************** *** 986,992 **** (defun gnus-score-change-score-file (file) "Change current score alist." ! (interactive (list (read-file-name "Change to score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) --- 986,992 ---- (defun gnus-score-change-score-file (file) "Change current score alist." ! (interactive (list (read-file-name "Change to score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) *************** *** 1006,1018 **** (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) ! (gnus-message ! 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits"))) ! (defun gnus-score-edit-file (file) "Edit a score file." ! (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-make-directory (file-name-directory file)) (when (buffer-name gnus-summary-buffer) --- 1006,1018 ---- (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) ! (gnus-message ! 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits"))) ! (defun gnus-score-edit-file (file) "Edit a score file." ! (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-make-directory (file-name-directory file)) (when (buffer-name gnus-summary-buffer) *************** *** 1024,1036 **** (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) ! (gnus-message ! 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits"))) ! (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. ! (let* ((file (expand-file-name (or (and (string-match (concat "^" (expand-file-name gnus-kill-files-directory)) --- 1024,1036 ---- (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) ! (gnus-message ! 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits"))) ! (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. ! (let* ((file (expand-file-name (or (and (string-match (concat "^" (expand-file-name gnus-kill-files-directory)) *************** *** 1048,1054 **** (setq gnus-score-alist nil) (setq alist (gnus-score-load-score-alist file)) ;; We add '(touched) to the alist to signify that it hasn't been ! ;; touched (yet). (unless (assq 'touched alist) (push (list 'touched nil) alist)) ;; If it is a global score file, we make it read-only. --- 1048,1054 ---- (setq gnus-score-alist nil) (setq alist (gnus-score-load-score-alist file)) ;; We add '(touched) to the alist to signify that it hasn't been ! ;; touched (yet). (unless (assq 'touched alist) (push (list 'touched nil) alist)) ;; If it is a global score file, we make it read-only. *************** *** 1084,1095 **** (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. (when (and gnus-decay-scores ! (gnus-decay-scores alist (or decay (gnus-time-to-day (current-time))))) (gnus-score-set 'touched '(t) alist) (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) ;; We do not respect eval and files atoms from global score ! ;; files. (and files (not global) (setq lists (apply 'append lists (mapcar (lambda (file) --- 1084,1095 ---- (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. (when (and gnus-decay-scores ! (gnus-decay-scores alist (or decay (gnus-time-to-day (current-time))))) (gnus-score-set 'touched '(t) alist) (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) ;; We do not respect eval and files atoms from global score ! ;; files. (and files (not global) (setq lists (apply 'append lists (mapcar (lambda (file) *************** *** 1098,1106 **** files))))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. ! (setq gnus-scores-exclude-files ! (nconc ! (mapcar (lambda (sfile) (expand-file-name sfile (file-name-directory file))) exclude-files) --- 1098,1106 ---- files))))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. ! (setq gnus-scores-exclude-files ! (nconc ! (mapcar (lambda (sfile) (expand-file-name sfile (file-name-directory file))) exclude-files) *************** *** 1130,1142 **** (t ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) ! (setq gnus-thread-expunge-below (or thread-mark-and-expunge gnus-thread-expunge-below)) ! (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) ! (setq gnus-summary-expunge-below (or expunge mark-and-expunge gnus-summary-expunge-below)) ! (setq gnus-newsgroup-adaptive-score-file (or adapt-file gnus-newsgroup-adaptive-score-file))) (setq gnus-current-score-file file) (setq gnus-score-alist alist) --- 1130,1142 ---- (t ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) ! (setq gnus-thread-expunge-below (or thread-mark-and-expunge gnus-thread-expunge-below)) ! (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) ! (setq gnus-summary-expunge-below (or expunge mark-and-expunge gnus-summary-expunge-below)) ! (setq gnus-newsgroup-adaptive-score-file (or adapt-file gnus-newsgroup-adaptive-score-file))) (setq gnus-current-score-file file) (setq gnus-score-alist alist) *************** *** 1154,1160 **** (push (cons file gnus-score-alist) gnus-score-cache)))) (defun gnus-score-remove-from-cache (file) ! (setq gnus-score-cache (delq (assoc file gnus-score-cache) gnus-score-cache))) (defun gnus-score-load-score-alist (file) --- 1154,1160 ---- (push (cons file gnus-score-alist) gnus-score-cache)))) (defun gnus-score-remove-from-cache (file) ! (setq gnus-score-cache (delq (assoc file gnus-score-cache) gnus-score-cache))) (defun gnus-score-load-score-alist (file) *************** *** 1173,1179 **** (setq alist (condition-case () (read (current-buffer)) ! (error (gnus-error 3.2 "Problem with score file %s" file)))))) (if (eq (car alist) 'setq) ;; This is an old-style score file. --- 1173,1179 ---- (setq alist (condition-case () (read (current-buffer)) ! (error (gnus-error 3.2 "Problem with score file %s" file)))))) (if (eq (car alist) 'setq) ;; This is an old-style score file. *************** *** 1185,1191 **** (defun gnus-score-check-syntax (alist file) "Check the syntax of the score ALIST." ! (cond ((null alist) nil) ((not (consp alist)) --- 1185,1191 ---- (defun gnus-score-check-syntax (alist file) "Check the syntax of the score ALIST." ! (cond ((null alist) nil) ((not (consp alist)) *************** *** 1202,1215 **** ((not (listp (car a))) (format "Illegal score element %s in %s" (car a) file)) ((stringp (caar a)) ! (cond ((not (listp (setq sr (cdar a)))) (format "Illegal header match %s in %s" (nth 1 (car a)) file)) (t (setq type (caar a)) (while (and sr (not err)) (setq s (pop sr)) ! (setq err (cond ((if (member (downcase type) '("lines" "chars")) --- 1202,1215 ---- ((not (listp (car a))) (format "Illegal score element %s in %s" (car a) file)) ((stringp (caar a)) ! (cond ((not (listp (setq sr (cdar a)))) (format "Illegal header match %s in %s" (nth 1 (car a)) file)) (t (setq type (caar a)) (while (and sr (not err)) (setq s (pop sr)) ! (setq err (cond ((if (member (downcase type) '("lines" "chars")) *************** *** 1255,1261 **** out)) (setq alist (cdr alist))) (cons (list 'touched t) (nreverse out)))) ! (defun gnus-score-save () ;; Save all score information. (let ((cache gnus-score-cache) --- 1255,1261 ---- out)) (setq alist (cdr alist))) (cons (list 'touched t) (nreverse out)))) ! (defun gnus-score-save () ;; Save all score information. (let ((cache gnus-score-cache) *************** *** 1276,1282 **** (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) (let (emacs-lisp-mode-hook) ! (if (string-match (concat (regexp-quote gnus-adaptive-file-suffix) "$") file) --- 1276,1282 ---- (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) (let (emacs-lisp-mode-hook) ! (if (string-match (concat (regexp-quote gnus-adaptive-file-suffix) "$") file) *************** *** 1285,1297 **** ;; are not meant to be edited by human hands. (gnus-prin1 score) ;; This is a normal score file, so we print it very ! ;; prettily. (pp score (current-buffer)))) (gnus-make-directory (file-name-directory file)) ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) (delete-file file) ! ;; There are scores, so we write the file. (when (file-writable-p file) (gnus-write-buffer file) (when gnus-score-after-write-file-function --- 1285,1297 ---- ;; are not meant to be edited by human hands. (gnus-prin1 score) ;; This is a normal score file, so we print it very ! ;; prettily. (pp score (current-buffer)))) (gnus-make-directory (file-name-directory file)) ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) (delete-file file) ! ;; There are scores, so we write the file. (when (file-writable-p file) (gnus-write-buffer file) (when gnus-score-after-write-file-function *************** *** 1365,1372 **** ;; Set the global variant of this variable. (setq gnus-current-score-file current-score-file) ;; score orphans ! (when gnus-orphan-score ! (setq gnus-score-index (nth 1 (assoc "references" gnus-header-index))) (gnus-score-orphans gnus-orphan-score)) ;; Run each header through the score process. --- 1365,1372 ---- ;; Set the global variant of this variable. (setq gnus-current-score-file current-score-file) ;; score orphans ! (when gnus-orphan-score ! (setq gnus-score-index (nth 1 (assoc "references" gnus-header-index))) (gnus-score-orphans gnus-orphan-score)) ;; Run each header through the score process. *************** *** 1401,1407 **** (when (listp (caar score)) (gnus-score-advanced (car score) trace)) (pop score)))) ! (gnus-message 5 "Scoring...done")))))) --- 1401,1407 ---- (when (listp (caar score)) (gnus-score-advanced (car score) trace)) (pop score)))) ! (gnus-message 5 "Scoring...done")))))) *************** *** 1422,1428 **** (defun gnus-score-orphans (score) (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) alike articles art arts this last this-id) ! (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) --- 1422,1428 ---- (defun gnus-score-orphans (score) (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) alike articles art arts this last this-id) ! (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) *************** *** 1471,1477 **** arts (cdr arts)) (setcdr art (+ score (cdr art)))) (forward-line)))))) ! (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) --- 1471,1477 ---- arts (cdr arts)) (setcdr art (+ score (cdr art)))) (forward-line)))))) ! (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) *************** *** 1501,1510 **** ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (when (funcall match-func (or (aref (caar articles) gnus-score-index) 0) match) ! (when trace (push (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) (setq found t) --- 1501,1510 ---- ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles ! (when (funcall match-func (or (aref (caar articles) gnus-score-index) 0) match) ! (when trace (push (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) (setq found t) *************** *** 1602,1608 **** (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. ! (unless (gnus-check-backend-function (and (string-match "^gnus-" (symbol-name request-func)) (intern (substring (symbol-name request-func) (match-end 0)))) --- 1602,1608 ---- (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. ! (unless (gnus-check-backend-function (and (string-match "^gnus-" (symbol-name request-func)) (intern (substring (symbol-name request-func) (match-end 0)))) *************** *** 1640,1649 **** gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) ! (case-fold-search (not (or (eq type 'R) (eq type 'S) (eq type 'Regexp) (eq type 'String)))) ! (search-func (cond ((or (eq type 'r) (eq type 'R) (eq type 'regexp) (eq type 'Regexp)) 're-search-forward) --- 1640,1649 ---- gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) ! (case-fold-search (not (or (eq type 'R) (eq type 'S) (eq type 'Regexp) (eq type 'String)))) ! (search-func (cond ((or (eq type 'r) (eq type 'R) (eq type 'regexp) (eq type 'Regexp)) 're-search-forward) *************** *** 1665,1671 **** (unless trace (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;; Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) --- 1665,1671 ---- (unless trace (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;; Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) *************** *** 1695,1701 **** (set-buffer gnus-summary-buffer) (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) --- 1695,1701 ---- (set-buffer gnus-summary-buffer) (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) *************** *** 1716,1722 **** (when last ; Bwadr, duplicate code. (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike)) ! ;; Find matches. (while scores (setq alist (car scores) --- 1716,1722 ---- (when last ; Bwadr, duplicate code. (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike)) ! ;; Find matches. (while scores (setq alist (car scores) *************** *** 1731,1740 **** (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) ! (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) --- 1731,1740 ---- (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) ! (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) *************** *** 1747,1759 **** (= (progn (end-of-line) (point)) (match-end 0)) (progn ! (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while arts (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) --- 1747,1759 ---- (= (progn (end-of-line) (point)) (match-end 0)) (progn ! (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while arts (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) *************** *** 1795,1801 **** (assoc id entry) (setq dont t))) (unless dont ! (gnus-summary-score-entry (if thread "thread" "references") id 's score (current-time-string) nil t))))) --- 1795,1801 ---- (assoc id entry) (setq dont t))) (unless dont ! (gnus-summary-score-entry (if thread "thread" "references") id 's score (current-time-string) nil t))))) *************** *** 1803,1813 **** ;; Score ARTICLES according to HEADER in SCORE-LIST. ;; Update matching entries to NOW and remove unmatched entries older ;; than EXPIRE. ! ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles fuzzies arts words kill) ;; Sorting the articles costs os O(N*log N) but will allow us to --- 1803,1813 ---- ;; Score ARTICLES according to HEADER in SCORE-LIST. ;; Update matching entries to NOW and remove unmatched entries older ;; than EXPIRE. ! ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles fuzzies arts words kill) ;; Sorting the articles costs os O(N*log N) but will allow us to *************** *** 1855,1861 **** (mt (aref (symbol-name type) 0)) (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) (dmt (downcase mt)) ! (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ((= dmt ?w) nil) --- 1855,1861 ---- (mt (aref (symbol-name type) 0)) (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) (dmt (downcase mt)) ! (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ((= dmt ?w) nil) *************** *** 1878,1891 **** (= (gnus-point-at-bol) (match-beginning 0)) ;; Yup. (progn ! (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push ! (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) --- 1878,1891 ---- (= (gnus-point-at-bol) (match-beginning 0)) ;; Yup. (progn ! (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push ! (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) *************** *** 1914,1920 **** ;; Update expiry date (if trace (setq entries (cdr entries)) ! (cond ;; Permanent entry. ((null date) (setq entries (cdr entries))) --- 1914,1920 ---- ;; Update expiry date (if trace (setq entries (cdr entries)) ! (cond ;; Permanent entry. ((null date) (setq entries (cdr entries))) *************** *** 1953,1959 **** (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push (cons ! (car-safe (rassq (cdar fuzzies) gnus-score-cache)) kill) gnus-score-trace)) ;; Found a match, update scores. --- 1953,1959 ---- (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push (cons ! (car-safe (rassq (cdar fuzzies) gnus-score-cache)) kill) gnus-score-trace)) ;; Found a match, update scores. *************** *** 2024,2030 **** (set-syntax-table gnus-adaptive-word-syntax-table) (while (re-search-forward "\\b\\w+\\b" nil t) (setq val ! (gnus-gethash (setq word (downcase (buffer-substring (match-beginning 0) (match-end 0)))) hashtb)) --- 2024,2030 ---- (set-syntax-table gnus-adaptive-word-syntax-table) (while (re-search-forward "\\b\\w+\\b" nil t) (setq val ! (gnus-gethash (setq word (downcase (buffer-substring (match-beginning 0) (match-end 0)))) hashtb)) *************** *** 2047,2053 **** (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) ! (if score-file (gnus-short-group-name (file-name-nondirectory score-file)) "none"))) --- 2047,2053 ---- (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) ! (if score-file (gnus-short-group-name (file-name-nondirectory score-file)) "none"))) *************** *** 2057,2065 **** ;; We change the score file to the adaptive score file. (save-excursion (set-buffer gnus-summary-buffer) ! (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) ;; Perform ordinary line scoring. (when (or (not (listp gnus-newsgroup-adaptive)) --- 2057,2065 ---- ;; We change the score file to the adaptive score file. (save-excursion (set-buffer gnus-summary-buffer) ! (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) ;; Perform ordinary line scoring. (when (or (not (listp gnus-newsgroup-adaptive)) *************** *** 2085,2092 **** (cdar elem))) (setcar (car elem) `(lambda (h) ! (,(intern ! (concat "mail-header-" (if (eq (caar elem) 'followup) "message-id" (downcase (symbol-name (caar elem)))))) --- 2085,2092 ---- (cdar elem))) (setcar (car elem) `(lambda (h) ! (,(intern ! (concat "mail-header-" (if (eq (caar elem) 'followup) "message-id" (downcase (symbol-name (caar elem)))))) *************** *** 2100,2108 **** (gnus-data-pseudo-p (car data))) () (when (setq headers (gnus-data-header (car data))) ! (while elem (setq match (funcall (caar elem) headers)) ! (gnus-summary-score-entry (nth 1 (car elem)) match (cond ((numberp match) --- 2100,2108 ---- (gnus-data-pseudo-p (car data))) () (when (setq headers (gnus-data-header (car data))) ! (while elem (setq match (funcall (caar elem) headers)) ! (gnus-summary-score-entry (nth 1 (car elem)) match (cond ((numberp match) *************** *** 2111,2120 **** 'a) (t ;; Whether we use substring or exact matches is ! ;; controlled here. (if (or (not gnus-score-exact-adapt-limit) (< (length match) gnus-score-exact-adapt-limit)) ! 'e (if (equal (nth 1 (car elem)) "subject") 'f 's)))) (nth 2 (car elem)) date nil t) --- 2111,2120 ---- 'a) (t ;; Whether we use substring or exact matches is ! ;; controlled here. (if (or (not gnus-score-exact-adapt-limit) (< (length match) gnus-score-exact-adapt-limit)) ! 'e (if (equal (nth 1 (car elem)) "subject") 'f 's)))) (nth 2 (car elem)) date nil t) *************** *** 2138,2144 **** (when (and (not (gnus-data-pseudo-p d)) (setq score ! (cdr (assq (gnus-data-mark d) gnus-adaptive-word-score-alist)))) ;; This article has a mark that should lead to --- 2138,2144 ---- (when (and (not (gnus-data-pseudo-p d)) (setq score ! (cdr (assq (gnus-data-mark d) gnus-adaptive-word-score-alist)))) ;; This article has a mark that should lead to *************** *** 2246,2252 **** (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) (gnus-score-update-all-lines)) ! (defun gnus-score-flush-cache () "Flush the cache of score files." (interactive) --- 2246,2252 ---- (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) (gnus-score-update-all-lines)) ! (defun gnus-score-flush-cache () "Flush the cache of score files." (interactive) *************** *** 2325,2349 **** (interactive "P") (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) ! ;;; Finding score files. (defun gnus-score-score-files (group) "Return a list of all possible score files." ;; Search and set any global score files. ! (when gnus-global-score-files (unless gnus-internal-global-score-files (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. ! (setq gnus-kill-files-directory (file-name-as-directory gnus-kill-files-directory)) ;; If we can't read it, there are no score files. (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) (setq gnus-score-file-list nil) (if (not (gnus-use-long-file-name 'not-score)) ;; We do not use long file names, so we have to do some ! ;; directory traversing. ! (setq gnus-score-file-list ! (cons nil (or gnus-short-name-score-file-cache (prog2 (gnus-message 6 "Finding all score files...") --- 2325,2349 ---- (interactive "P") (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) ! ;;; Finding score files. (defun gnus-score-score-files (group) "Return a list of all possible score files." ;; Search and set any global score files. ! (when gnus-global-score-files (unless gnus-internal-global-score-files (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. ! (setq gnus-kill-files-directory (file-name-as-directory gnus-kill-files-directory)) ;; If we can't read it, there are no score files. (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) (setq gnus-score-file-list nil) (if (not (gnus-use-long-file-name 'not-score)) ;; We do not use long file names, so we have to do some ! ;; directory traversing. ! (setq gnus-score-file-list ! (cons nil (or gnus-short-name-score-file-cache (prog2 (gnus-message 6 "Finding all score files...") *************** *** 2356,2366 **** (not (car gnus-score-file-list)) (gnus-file-newer-than gnus-kill-files-directory (car gnus-score-file-list))) ! (setq gnus-score-file-list (cons (nth 5 (file-attributes gnus-kill-files-directory)) ! (nreverse ! (directory-files ! gnus-kill-files-directory t (gnus-score-file-regexp))))))) (cdr gnus-score-file-list))) --- 2356,2366 ---- (not (car gnus-score-file-list)) (gnus-file-newer-than gnus-kill-files-directory (car gnus-score-file-list))) ! (setq gnus-score-file-list (cons (nth 5 (file-attributes gnus-kill-files-directory)) ! (nreverse ! (directory-files ! gnus-kill-files-directory t (gnus-score-file-regexp))))))) (cdr gnus-score-file-list))) *************** *** 2371,2377 **** (case-fold-search nil) seen out file) (while (setq file (pop files)) ! (cond ;; Ignore "." and "..". ((member (file-name-nondirectory file) '("." "..")) nil) --- 2371,2377 ---- (case-fold-search nil) seen out file) (while (setq file (pop files)) ! (cond ;; Ignore "." and "..". ((member (file-name-nondirectory file) '("." "..")) nil) *************** *** 2386,2404 **** (or out ;; Return a dummy value. (list "~/News/this.file.does.not.exist.SCORE")))) ! (defun gnus-score-file-regexp () "Return a regexp that match all score files." (concat "\\(" (regexp-quote gnus-score-file-suffix ) "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) ! (defun gnus-score-find-bnews (group) "Return a list of score files for GROUP. The score files are those files in the ~/News/ directory which matches GROUP using BNews sys file syntax." (let* ((sfiles (append (gnus-score-score-files group) gnus-internal-global-score-files)) ! (kill-dir (file-name-as-directory (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) (score-regexp (gnus-score-file-regexp)) --- 2386,2404 ---- (or out ;; Return a dummy value. (list "~/News/this.file.does.not.exist.SCORE")))) ! (defun gnus-score-file-regexp () "Return a regexp that match all score files." (concat "\\(" (regexp-quote gnus-score-file-suffix ) "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) ! (defun gnus-score-find-bnews (group) "Return a list of score files for GROUP. The score files are those files in the ~/News/ directory which matches GROUP using BNews sys file syntax." (let* ((sfiles (append (gnus-score-score-files group) gnus-internal-global-score-files)) ! (kill-dir (file-name-as-directory (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) (score-regexp (gnus-score-file-regexp)) *************** *** 2408,2414 **** (set-buffer (get-buffer-create "*gnus score files*")) (buffer-disable-undo (current-buffer)) ;; Go through all score file names and create regexp with them ! ;; as the source. (while sfiles (erase-buffer) (insert (car sfiles)) --- 2408,2414 ---- (set-buffer (get-buffer-create "*gnus score files*")) (buffer-disable-undo (current-buffer)) ;; Go through all score file names and create regexp with them ! ;; as the source. (while sfiles (erase-buffer) (insert (car sfiles)) *************** *** 2495,2501 **** (mapcar 'gnus-score-file-name all))) (if (equal prefix "") all ! (mapcar (lambda (file) (concat (file-name-directory file) prefix (file-name-nondirectory file))) --- 2495,2501 ---- (mapcar 'gnus-score-file-name all))) (if (equal prefix "") all ! (mapcar (lambda (file) (concat (file-name-directory file) prefix (file-name-nondirectory file))) *************** *** 2522,2528 **** (erase-buffer) (setq elems (delete "all" elems)) (length elems)))) ! (defun gnus-sort-score-files (files) "Sort FILES so that the most general files come first." (nnheader-temp-write nil --- 2522,2528 ---- (erase-buffer) (setq elems (delete "all" elems)) (length elems)))) ! (defun gnus-sort-score-files (files) "Sort FILES so that the most general files come first." (nnheader-temp-write nil *************** *** 2556,2562 **** ;; progn used just in case ("regexp") has no files ;; and score-files is still nil. -sj ;; this can be construed as a "stop searching here" feature :> ! ;; and used to simplify regexps in the single-alist (setq score-files (nconc score-files (copy-sequence (cdar alist)))) (setq alist nil)) --- 2556,2562 ---- ;; progn used just in case ("regexp") has no files ;; and score-files is still nil. -sj ;; this can be construed as a "stop searching here" feature :> ! ;; and used to simplify regexps in the single-alist (setq score-files (nconc score-files (copy-sequence (cdar alist)))) (setq alist nil)) *************** *** 2575,2581 **** (not (listp funcs)) (setq funcs (list funcs))) ;; Get the initial score files for this group. ! (when funcs (setq score-files (nreverse (gnus-score-find-alist group)))) ;; Add any home adapt files. (let ((home (gnus-home-score-file group t))) --- 2575,2581 ---- (not (listp funcs)) (setq funcs (list funcs))) ;; Get the initial score files for this group. ! (when funcs (setq score-files (nreverse (gnus-score-find-alist group)))) ;; Add any home adapt files. (let ((home (gnus-home-score-file group t))) *************** *** 2591,2597 **** ;; scores) and add them to a list. (while funcs (when (gnus-functionp (car funcs)) ! (setq score-files (nconc score-files (nreverse (funcall (car funcs) group))))) (setq funcs (cdr funcs))) ;; Add any home score files. --- 2591,2597 ---- ;; scores) and add them to a list. (while funcs (when (gnus-functionp (car funcs)) ! (setq score-files (nconc score-files (nreverse (funcall (car funcs) group))))) (setq funcs (cdr funcs))) ;; Add any home score files. *************** *** 2621,2627 **** (pop files))) ;; Do the scoring if there are any score files for this group. score-files)) ! (defun gnus-possibly-score-headers (&optional trace) "Do scoring if scoring is required." (let ((score-files (gnus-all-score-files))) --- 2621,2627 ---- (pop files))) ;; Do the scoring if there are any score files for this group. score-files)) ! (defun gnus-possibly-score-headers (&optional trace) "Do scoring if scoring is required." (let ((score-files (gnus-all-score-files))) *************** *** 2636,2642 **** ((or (null newsgroup) (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. ! (expand-file-name suffix gnus-kill-files-directory)) ((gnus-use-long-file-name 'not-score) ;; Append ".SCORE" to newsgroup name. --- 2636,2642 ---- ((or (null newsgroup) (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. ! (expand-file-name suffix gnus-kill-files-directory)) ((gnus-use-long-file-name 'not-score) ;; Append ".SCORE" to newsgroup name. *************** *** 2657,2663 **** (let (out) (while files (if (string-match "/$" (car files)) ! (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) (push (car files) out)) --- 2657,2663 ---- (let (out) (while files (if (string-match "/$" (car files)) ! (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) (push (car files) out)) *************** *** 2707,2713 **** ;; Group name without any dots. (concat group (if (gnus-use-long-file-name 'not-score) "." "/") gnus-score-file-suffix))) ! (defun gnus-hierarchial-home-adapt-file (group) "Return the adapt file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) --- 2707,2713 ---- ;; Group name without any dots. (concat group (if (gnus-use-long-file-name 'not-score) "." "/") gnus-score-file-suffix))) ! (defun gnus-hierarchial-home-adapt-file (group) "Return the adapt file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group) *** pub/rgnus/lisp/gnus-setup.el Tue Feb 4 03:53:16 1997 --- rgnus/lisp/gnus-setup.el Fri Mar 7 23:51:21 1997 *************** *** 176,182 **** (autoload 'gnus-no-server "gnus" "\ Read network news. If ARG is a positive number, Gnus will use that as the ! startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." t nil) --- 176,182 ---- (autoload 'gnus-no-server "gnus" "\ Read network news. If ARG is a positive number, Gnus will use that as the ! startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." t nil) *** pub/rgnus/lisp/gnus-soup.el Thu Jan 9 11:59:39 1997 --- rgnus/lisp/gnus-soup.el Fri Mar 7 23:51:22 1997 *************** *** 143,159 **** (when (setq headers (gnus-summary-article-header (car articles))) ;; Put the article in a buffer. (set-buffer tmp-buf) ! (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (save-restriction (message-narrow-to-head) (message-remove-header gnus-soup-ignored-headers t)) (gnus-soup-store gnus-soup-directory prefix headers ! gnus-soup-encoding-type gnus-soup-index-type) ! (gnus-soup-area-set-number area (1+ (or (gnus-soup-area-number area) 0))))) ! ;; Mark article as read. (set-buffer gnus-summary-buffer) (gnus-summary-remove-process-mark (car articles)) (gnus-summary-mark-as-read (car articles) gnus-souped-mark) --- 143,159 ---- (when (setq headers (gnus-summary-article-header (car articles))) ;; Put the article in a buffer. (set-buffer tmp-buf) ! (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (save-restriction (message-narrow-to-head) (message-remove-header gnus-soup-ignored-headers t)) (gnus-soup-store gnus-soup-directory prefix headers ! gnus-soup-encoding-type gnus-soup-index-type) ! (gnus-soup-area-set-number area (1+ (or (gnus-soup-area-number area) 0))))) ! ;; Mark article as read. (set-buffer gnus-summary-buffer) (gnus-summary-remove-process-mark (car articles)) (gnus-summary-mark-as-read (car articles) gnus-souped-mark) *************** *** 205,216 **** $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" (interactive) nil) ! ;;; Internal Functions: ! ;; Store the current buffer. (defun gnus-soup-store (directory prefix headers format index) ! ;; Create the directory, if needed. (gnus-make-directory directory) (let* ((msg-buf (nnheader-find-file-noselect (concat directory prefix ".MSG"))) --- 205,216 ---- $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" (interactive) nil) ! ;;; Internal Functions: ! ;; Store the current buffer. (defun gnus-soup-store (directory prefix headers format index) ! ;; Create the directory, if needed. (gnus-make-directory directory) (let* ((msg-buf (nnheader-find-file-noselect (concat directory prefix ".MSG"))) *************** *** 222,228 **** from head-line beg type) (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) (buffer-disable-undo msg-buf) ! (when idx-buf (push idx-buf gnus-soup-buffers) (buffer-disable-undo idx-buf)) (save-excursion --- 222,228 ---- from head-line beg type) (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) (buffer-disable-undo msg-buf) ! (when idx-buf (push idx-buf gnus-soup-buffers) (buffer-disable-undo idx-buf)) (save-excursion *************** *** 239,247 **** (mail-fetch-field "sender")))) (goto-char (point-min)) ;; Depending on what encoding is supposed to be used, we make ! ;; a soup header. (setq head-line ! (cond ((= gnus-soup-encoding-type ?n) (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) --- 239,247 ---- (mail-fetch-field "sender")))) (goto-char (point-min)) ;; Depending on what encoding is supposed to be used, we make ! ;; a soup header. (setq head-line ! (cond ((= gnus-soup-encoding-type ?n) (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) *************** *** 278,284 **** (and (car entry) (> (car entry) 0)) (and (not not-all) ! (gnus-range-length (cdr (assq 'tick (gnus-info-marks (nth 2 entry))))))) (when (gnus-summary-read-group group nil t) (setq gnus-newsgroup-processable --- 278,284 ---- (and (car entry) (> (car entry) 0)) (and (not not-all) ! (gnus-range-length (cdr (assq 'tick (gnus-info-marks (nth 2 entry))))))) (when (gnus-summary-read-group group nil t) (setq gnus-newsgroup-processable *************** *** 299,306 **** (or (mail-header-from header) "(nobody)") (or (mail-header-date header) "") (or (mail-header-id header) ! (concat "soup-dummy-id-" ! (mapconcat (lambda (time) (int-to-string time)) (current-time) "-"))) (or (mail-header-references header) "") --- 299,306 ---- (or (mail-header-from header) "(nobody)") (or (mail-header-date header) "") (or (mail-header-id header) ! (concat "soup-dummy-id-" ! (mapconcat (lambda (time) (int-to-string time)) (current-time) "-"))) (or (mail-header-references header) "") *************** *** 341,347 **** (string-match "%d" packer)) (format packer files (string-to-int (gnus-soup-unique-prefix dir))) ! (format packer (string-to-int (gnus-soup-unique-prefix dir)) files))) (dir (expand-file-name dir))) --- 341,347 ---- (string-match "%d" packer)) (format packer files (string-to-int (gnus-soup-unique-prefix dir))) ! (format packer (string-to-int (gnus-soup-unique-prefix dir)) files))) (dir (expand-file-name dir))) *************** *** 349,358 **** (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) (if (zerop (call-process shell-file-name ! nil nil nil shell-command-switch (concat "cd " dir " ; " packer))) (progn ! (call-process shell-file-name nil nil nil shell-command-switch (concat "cd " dir " ; rm " files)) (gnus-message 4 "Packing...done" packer)) (error "Couldn't pack packet.")))) --- 349,358 ---- (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) (if (zerop (call-process shell-file-name ! nil nil nil shell-command-switch (concat "cd " dir " ; " packer))) (progn ! (call-process shell-file-name nil nil nil shell-command-switch (concat "cd " dir " ; rm " files)) (gnus-message 4 "Packing...done" packer)) (error "Couldn't pack packet.")))) *************** *** 360,366 **** (defun gnus-soup-parse-areas (file) "Parse soup area file FILE. The result is a of vectors, each containing one entry from the AREA file. ! The vector contain five strings, [prefix name encoding description number] though the two last may be nil if they are missing." (let (areas) --- 360,366 ---- (defun gnus-soup-parse-areas (file) "Parse soup area file FILE. The result is a of vectors, each containing one entry from the AREA file. ! The vector contain five strings, [prefix name encoding description number] though the two last may be nil if they are missing." (let (areas) *************** *** 419,425 **** area) (while (setq area (pop areas)) (insert ! (format "%s\t%s\t%s%s\n" (gnus-soup-area-prefix area) (gnus-soup-area-name area) --- 419,425 ---- area) (while (setq area (pop areas)) (insert ! (format "%s\t%s\t%s%s\n" (gnus-soup-area-prefix area) (gnus-soup-area-name area) *************** *** 429,435 **** (concat "\t" (or (gnus-soup-area-description area) "") (if (gnus-soup-area-number area) ! (concat "\t" (int-to-string (gnus-soup-area-number area))) "")) "")))))))) --- 429,435 ---- (concat "\t" (or (gnus-soup-area-description area) "") (if (gnus-soup-area-number area) ! (concat "\t" (int-to-string (gnus-soup-area-number area))) "")) "")))))))) *************** *** 456,462 **** (unless result (setq result (vector (gnus-soup-unique-prefix) ! real-group (format "%c%c%c" gnus-soup-encoding-type gnus-soup-index-type --- 456,462 ---- (unless result (setq result (vector (gnus-soup-unique-prefix) ! real-group (format "%c%c%c" gnus-soup-encoding-type gnus-soup-index-type *************** *** 493,501 **** (gnus-message 4 "Unpacking...done"))) (defun gnus-soup-send-packet (packet) ! (gnus-soup-unpack-packet gnus-soup-replies-directory gnus-soup-unpacker packet) ! (let ((replies (gnus-soup-parse-replies (concat gnus-soup-replies-directory "REPLIES")))) (save-excursion (while replies --- 493,501 ---- (gnus-message 4 "Unpacking...done"))) (defun gnus-soup-send-packet (packet) ! (gnus-soup-unpack-packet gnus-soup-replies-directory gnus-soup-unpacker packet) ! (let ((replies (gnus-soup-parse-replies (concat gnus-soup-replies-directory "REPLIES")))) (save-excursion (while replies *************** *** 506,513 **** (nnheader-find-file-noselect msg-file))) (tmp-buf (get-buffer-create " *soup send*")) beg end) ! (cond ! ((/= (gnus-soup-encoding-format (gnus-soup-reply-encoding (car replies))) ?n) (error "Unsupported encoding")) --- 506,513 ---- (nnheader-find-file-noselect msg-file))) (tmp-buf (get-buffer-create " *soup send*")) beg end) ! (cond ! ((/= (gnus-soup-encoding-format (gnus-soup-reply-encoding (car replies))) ?n) (error "Unsupported encoding")) *************** *** 523,530 **** (error "Bad header.")) (forward-line 1) (setq beg (point) ! end (+ (point) (string-to-int ! (buffer-substring (match-beginning 1) (match-end 1))))) (switch-to-buffer tmp-buf) (erase-buffer) --- 523,530 ---- (error "Bad header.")) (forward-line 1) (setq beg (point) ! end (+ (point) (string-to-int ! (buffer-substring (match-beginning 1) (match-end 1))))) (switch-to-buffer tmp-buf) (erase-buffer) *************** *** 535,541 **** (insert mail-header-separator) (setq message-newsreader (setq message-mailer (gnus-extended-version))) ! (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." (mail-fetch-field "newsgroups")) --- 535,541 ---- (insert mail-header-separator) (setq message-newsreader (setq message-mailer (gnus-extended-version))) ! (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." (mail-fetch-field "newsgroups")) *************** *** 558,564 **** (gnus-message 4 "Sent packet")))) (setq replies (cdr replies))) t))) ! (provide 'gnus-soup) ;;; gnus-soup.el ends here --- 558,564 ---- (gnus-message 4 "Sent packet")))) (setq replies (cdr replies))) t))) ! (provide 'gnus-soup) ;;; gnus-soup.el ends here *** pub/rgnus/lisp/gnus-spec.el Thu Jan 9 11:59:39 1997 --- rgnus/lisp/gnus-spec.el Fri Mar 7 23:51:22 1997 *************** *** 115,126 **** (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) ! (defvar gnus-format-specs `((version . ,emacs-version) (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) (summary-dummy "* %(: :%) %S\n" ,gnus-summary-dummy-line-format-spec) ! (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" ,gnus-summary-line-format-spec)) "Alist of format specs.") --- 115,126 ---- (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) ! (defvar gnus-format-specs `((version . ,emacs-version) (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) (summary-dummy "* %(: :%) %S\n" ,gnus-summary-dummy-line-format-spec) ! (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" ,gnus-summary-line-format-spec)) "Alist of format specs.") *************** *** 351,357 **** ;; Parse this spec fully. (while ! (cond ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") (setq pad-width (string-to-number (match-string 1))) (when (match-beginning 2) --- 351,357 ---- ;; Parse this spec fully. (while ! (cond ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") (setq pad-width (string-to-number (match-string 1))) (when (match-beginning 2) *************** *** 439,445 **** (insert elem-type) (push (car elem) flist)))) (setq fstring (buffer-string))) ! ;; Do some postprocessing to increase efficiency. (setq result --- 439,445 ---- (insert elem-type) (push (car elem) flist)))) (setq fstring (buffer-string))) ! ;; Do some postprocessing to increase efficiency. (setq result *** pub/rgnus/lisp/gnus-srvr.el Sun Mar 2 04:47:14 1997 --- rgnus/lisp/gnus-srvr.el Fri Mar 7 23:51:22 1997 *************** *** 55,61 **** (?w where ?s) (?s status ?s))) ! (defvar gnus-server-mode-line-format-alist `((?S news-server ?s) (?M news-method ?s) (?u user-defined ?s))) --- 55,61 ---- (?w where ?s) (?s status ?s))) ! (defvar gnus-server-mode-line-format-alist `((?S news-server ?s) (?M news-method ?s) (?u user-defined ?s))) *************** *** 137,144 **** All normal editing commands are switched off. \\ ! For more in-depth information on this mode, read the manual ! (`\\[gnus-info-find-node]'). The following commands are available: --- 137,144 ---- All normal editing commands are switched off. \\ ! For more in-depth information on this mode, read the manual ! (`\\[gnus-info-find-node]'). The following commands are available: *************** *** 189,203 **** (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) (gnus-server-mode) ! (when gnus-carpal (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () ! (setq gnus-server-mode-line-format-spec ! (gnus-parse-format gnus-server-mode-line-format gnus-server-mode-line-format-alist)) ! (setq gnus-server-line-format-spec ! (gnus-parse-format gnus-server-line-format gnus-server-line-format-alist t)) (let ((alist gnus-server-alist) (buffer-read-only nil) --- 189,203 ---- (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) (gnus-server-mode) ! (when gnus-carpal (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () ! (setq gnus-server-mode-line-format-spec ! (gnus-parse-format gnus-server-mode-line-format gnus-server-mode-line-format-alist)) ! (setq gnus-server-line-format-spec ! (gnus-parse-format gnus-server-line-format gnus-server-line-format-alist t)) (let ((alist gnus-server-alist) (buffer-read-only nil) *************** *** 209,223 **** (while alist (unless (member (cdar alist) done) (push (cdar alist) done) ! (cdr (setq server (pop alist))) (when (and server (car server) (cdr server)) (gnus-server-insert-server-line (car server) (cdr server))))) ;; Then we insert the list of servers that have been opened in ;; this session. ! (while opened (unless (member (caar opened) done) (push (caar opened) done) ! (gnus-server-insert-server-line (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) (caar opened)) (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) --- 209,223 ---- (while alist (unless (member (cdar alist) done) (push (cdar alist) done) ! (cdr (setq server (pop alist))) (when (and server (car server) (cdr server)) (gnus-server-insert-server-line (car server) (cdr server))))) ;; Then we insert the list of servers that have been opened in ;; this session. ! (while opened (unless (member (caar opened) done) (push (caar opened) done) ! (gnus-server-insert-server-line (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) (caar opened)) (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) *************** *** 241,247 **** (oentry (assoc (gnus-server-to-method server) gnus-opened-servers))) (when entry ! (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string (cdr entry)) ")\n"))) (when (or entry oentry) --- 241,247 ---- (oentry (assoc (gnus-server-to-method server) gnus-opened-servers))) (when entry ! (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string (cdr entry)) ")\n"))) (when (or entry oentry) *************** *** 252,258 **** (gnus-delete-line)) (if entry (gnus-server-insert-server-line (car entry) (cdr entry)) ! (gnus-server-insert-server-line (format "%s:%s" (caar oentry) (nth 1 (car oentry))) (car oentry))) (gnus-server-position-point)))))) --- 252,258 ---- (gnus-delete-line)) (if entry (gnus-server-insert-server-line (car entry) (cdr entry)) ! (gnus-server-insert-server-line (format "%s:%s" (caar oentry) (nth 1 (car oentry))) (car oentry))) (gnus-server-position-point)))))) *************** *** 260,266 **** (defun gnus-server-set-info (server info) ;; Enter a select method into the virtual server alist. (when (and server info) ! (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string info) ")")) (let* ((server (nth 1 info)) --- 260,266 ---- (defun gnus-server-set-info (server info) ;; Enter a select method into the virtual server alist. (when (and server info) ! (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string info) ")")) (let* ((server (nth 1 info)) *************** *** 420,426 **** (gnus-server-yank-server))) (defun gnus-server-add-server (how where) ! (interactive (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))) --- 420,426 ---- (gnus-server-yank-server))) (defun gnus-server-add-server (how where) ! (interactive (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))) *************** *** 472,478 **** (set-buffer buf) (gnus-server-update-server (gnus-server-server-name)) (gnus-server-position-point))))) ! (defun gnus-server-pick-server (e) (interactive "e") (mouse-set-point e) --- 472,478 ---- (set-buffer buf) (gnus-server-update-server (gnus-server-server-name)) (gnus-server-position-point))))) ! (defun gnus-server-pick-server (e) (interactive "e") (mouse-set-point e) *************** *** 731,746 **** "Issue a command to the server to regenerate all its data structures." (interactive) (let ((server (gnus-server-server-name))) ! (unless server (error "No server on the current line")) ! (if (not (gnus-check-backend-function 'request-regenerate (car (gnus-server-to-method server)))) (error "This backend doesn't support regeneration") (gnus-message 5 "Requesting regeneration of %s..." server) (if (gnus-request-regenerate server) (gnus-message 5 "Requesting regeneration of %s...done" server) (gnus-message 5 "Couldn't regenerate %s" server))))) ! (provide 'gnus-srvr) ;;; gnus-srvr.el ends here. --- 731,746 ---- "Issue a command to the server to regenerate all its data structures." (interactive) (let ((server (gnus-server-server-name))) ! (unless server (error "No server on the current line")) ! (if (not (gnus-check-backend-function 'request-regenerate (car (gnus-server-to-method server)))) (error "This backend doesn't support regeneration") (gnus-message 5 "Requesting regeneration of %s..." server) (if (gnus-request-regenerate server) (gnus-message 5 "Requesting regeneration of %s...done" server) (gnus-message 5 "Couldn't regenerate %s" server))))) ! (provide 'gnus-srvr) ;;; gnus-srvr.el ends here. *** pub/rgnus/lisp/gnus-start.el Sun Mar 2 04:47:15 1997 --- rgnus/lisp/gnus-start.el Fri Mar 7 23:51:23 1997 *************** *** 48,54 **** (defcustom gnus-site-init-file (ignore-errors ! (concat (file-name-directory (directory-file-name installation-directory)) "site-lisp/gnus-init")) "The site-wide Gnus elisp startup file. --- 48,54 ---- (defcustom gnus-site-init-file (ignore-errors ! (concat (file-name-directory (directory-file-name installation-directory)) "site-lisp/gnus-init")) "The site-wide Gnus elisp startup file. *************** *** 320,326 **** (const :tag "none" nil))) (defcustom gnus-modtime-botch nil ! "*Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc." :group 'gnus-newsrc --- 320,326 ---- (const :tag "none" nil))) (defcustom gnus-modtime-botch nil ! "*Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc." :group 'gnus-newsrc *************** *** 347,353 **** :group 'gnus-group-new :type 'hook) ! (defcustom gnus-after-getting-new-news-hook (when (gnus-boundp 'display-time-timer) '(display-time-event-handler)) "A hook run after Gnus checks for new news." --- 347,353 ---- :group 'gnus-group-new :type 'hook) ! (defcustom gnus-after-getting-new-news-hook (when (gnus-boundp 'display-time-timer) '(display-time-event-handler)) "A hook run after Gnus checks for new news." *************** *** 815,821 **** If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) ! (when init ;; Clear some variables to re-initialize news information. (setq gnus-newsrc-alist nil gnus-active-hashtb nil) --- 815,821 ---- If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) ! (when init ;; Clear some variables to re-initialize news information. (setq gnus-newsrc-alist nil gnus-active-hashtb nil) *************** *** 849,856 **** (gnus-cache-open)) ;; Possibly eval the dribble file. ! (and init ! (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) ;; Slave Gnusii should then clear the dribble buffer. --- 849,856 ---- (gnus-cache-open)) ;; Possibly eval the dribble file. ! (and init ! (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) ;; Slave Gnusii should then clear the dribble buffer. *************** *** 874,880 **** (gnus-find-new-newsgroups)) ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem (not level) (not dont-connect)) (gnus-nocem-scan-groups)) --- 874,880 ---- (gnus-find-new-newsgroups)) ;; We might read in new NoCeM messages here. ! (when (and gnus-use-nocem (not level) (not dont-connect)) (gnus-nocem-scan-groups)) *************** *** 1156,1162 **** ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, ;; we enter it into the killed or zombie list. ! (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) --- 1156,1162 ---- ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, ;; we enter it into the killed or zombie list. ! (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) *************** *** 1283,1289 **** "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) ! (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active --- 1283,1289 ---- "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) ! (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active *************** *** 1293,1299 **** (defun gnus-get-unread-articles-in-group (info active &optional update) (when active ;; Allow the backend to update the info in the group. ! (when (and update (gnus-request-update-info info (gnus-find-method-for-group (gnus-info-group info)))) (gnus-activate-group (gnus-info-group info) nil t)) --- 1293,1299 ---- (defun gnus-get-unread-articles-in-group (info active &optional update) (when active ;; Allow the backend to update the info in the group. ! (when (and update (gnus-request-update-info info (gnus-find-method-for-group (gnus-info-group info)))) (gnus-activate-group (gnus-info-group info) nil t)) *************** *** 1301,1307 **** (num 0)) ;; If a cache is present, we may have to alter the active info. (when (and gnus-use-cache info) ! (inline (gnus-cache-possibly-alter-active (gnus-info-group info) active))) ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the --- 1301,1307 ---- (num 0)) ;; If a cache is present, we may have to alter the active info. (when (and gnus-use-cache info) ! (inline (gnus-cache-possibly-alter-active (gnus-info-group info) active))) ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the *************** *** 1552,1558 **** ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file (&optional force) (gnus-group-set-mode-line) ! (let ((methods (append (if (gnus-check-server gnus-select-method) ;; The native server is available. --- 1552,1558 ---- ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file (&optional force) (gnus-group-set-mode-line) ! (let ((methods (append (if (gnus-check-server gnus-select-method) ;; The native server is available. *************** *** 1590,1596 **** groups info) (while (setq info (pop newsrc)) (when (gnus-server-equal ! (gnus-find-method-for-group (gnus-info-group info) info) gmethod) (push (gnus-group-real-name (gnus-info-group info)) --- 1590,1596 ---- groups info) (while (setq info (pop newsrc)) (when (gnus-server-equal ! (gnus-find-method-for-group (gnus-info-group info) info) gmethod) (push (gnus-group-real-name (gnus-info-group info)) *************** *** 1628,1634 **** ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)") (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups)) ! ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) (unless method --- 1628,1634 ---- ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)") (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups)) ! ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) (unless method *************** *** 1790,1796 **** (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" newsrc-file))) ! ;; Convert old to new. (gnus-convert-old-newsrc)))) --- 1790,1796 ---- (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" newsrc-file))) ! ;; Convert old to new. (gnus-convert-old-newsrc)))) *************** *** 1874,1880 **** (unless (nthcdr 3 info) (nconc info (list nil))) (gnus-info-set-marks ! info (list (cons 'tick (gnus-compress-sequence (sort (cdr m) '<) t)))))) (setq newsrc killed) (while newsrc --- 1874,1880 ---- (unless (nthcdr 3 info) (nconc info (list nil))) (gnus-info-set-marks ! info (list (cons 'tick (gnus-compress-sequence (sort (cdr m) '<) t)))))) (setq newsrc killed) (while newsrc *************** *** 1954,1960 **** (point))))) (forward-line -1)) (symbol ! ;; Group names can be just numbers. (when (numberp symbol) (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) (unless (boundp symbol) --- 1954,1960 ---- (point))))) (forward-line -1)) (symbol ! ;; Group names can be just numbers. (when (numberp symbol) (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) (unless (boundp symbol) *************** *** 2350,2356 **** ;;; (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method (nconc (when (gnus-archive-server-wanted-p) (list "archive")) --- 2350,2356 ---- ;;; (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method (nconc (when (gnus-archive-server-wanted-p) (list "archive")) *************** *** 2440,2446 **** (defun gnus-set-default-directory () "Set the default directory in the current buffer to `gnus-default-directory'. If this variable is nil, don't do anything." ! (setq default-directory (if (and gnus-default-directory (file-exists-p gnus-default-directory)) (file-name-as-directory (expand-file-name gnus-default-directory)) --- 2440,2446 ---- (defun gnus-set-default-directory () "Set the default directory in the current buffer to `gnus-default-directory'. If this variable is nil, don't do anything." ! (setq default-directory (if (and gnus-default-directory (file-exists-p gnus-default-directory)) (file-name-as-directory (expand-file-name gnus-default-directory)) *** pub/rgnus/lisp/gnus-sum.el Fri Mar 7 07:37:01 1997 --- rgnus/lisp/gnus-sum.el Fri Mar 7 23:51:24 1997 *************** *** 610,616 **** :group 'gnus-summary-visual :type 'hook) ! (defcustom gnus-parse-headers-hook (list 'gnus-decode-rfc1522) "*A hook called before parsing the headers." :group 'gnus-various --- 610,616 ---- :group 'gnus-summary-visual :type 'hook) ! (defcustom gnus-parse-headers-hook (list 'gnus-decode-rfc1522) "*A hook called before parsing the headers." :group 'gnus-various *************** *** 654,660 **** :group 'gnus-summary-visual :type 'face) ! (defcustom gnus-summary-highlight '(((= mark gnus-canceled-mark) . gnus-summary-cancelled-face) ((and (> score default) --- 654,660 ---- :group 'gnus-summary-visual :type 'face) ! (defcustom gnus-summary-highlight '(((= mark gnus-canceled-mark) . gnus-summary-cancelled-face) ((and (> score default) *************** *** 680,692 **** . gnus-summary-low-unread-face) ((and (= mark gnus-unread-mark)) . gnus-summary-normal-unread-face) ! ((> score default) . gnus-summary-high-read-face) ! ((< score default) . gnus-summary-low-read-face) ! (t . gnus-summary-normal-read-face)) ! "Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a a particular summary line should be displayed, each form is evaluated. The content --- 680,692 ---- . gnus-summary-low-unread-face) ((and (= mark gnus-unread-mark)) . gnus-summary-normal-unread-face) ! ((> score default) . gnus-summary-high-read-face) ! ((< score default) . gnus-summary-low-read-face) ! (t . gnus-summary-normal-read-face)) ! "Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a a particular summary line should be displayed, each form is evaluated. The content *************** *** 697,703 **** score: The articles score default: The default article score. ! below: The score below which articles are automatically marked as read. mark: The articles mark." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) --- 697,703 ---- score: The articles score default: The default article score. ! below: The score below which articles are automatically marked as read. mark: The articles mark." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) *************** *** 708,714 **** (defvar gnus-scores-exclude-files nil) ! (defvar gnus-summary-display-table ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. --- 708,714 ---- (defvar gnus-scores-exclude-files nil) ! (defvar gnus-summary-display-table ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. *************** *** 1232,1238 **** "\M-#" gnus-uu-unmark-thread) (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) ! "g" gnus-summary-prepare "c" gnus-summary-insert-cached-articles) (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) --- 1232,1238 ---- "\M-#" gnus-uu-unmark-thread) (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) ! "g" gnus-summary-prepare "c" gnus-summary-insert-cached-articles) (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) *************** *** 1380,1430 **** '(("Default header" ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio :selected (null gnus-score-default-header)] ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio :selected (eq gnus-score-default-header 'a)] ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio :selected (eq gnus-score-default-header 's)] ["Article body" (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio :selected (eq gnus-score-default-header 'b )] ["All headers" (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio :selected (eq gnus-score-default-header 'h )] ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio :selected (eq gnus-score-default-header 'i )] ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio :selected (eq gnus-score-default-header 't )] ["Crossposting" (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio :selected (eq gnus-score-default-header 'x )] ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio :selected (eq gnus-score-default-header 'l )] ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio :selected (eq gnus-score-default-header 'd )] ["Followups to author" (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio :selected (eq gnus-score-default-header 'f )]) ("Default type" ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :style radio :selected (null gnus-score-default-type)] ;; The `:active' key is commented out in the following, ;; because the GNU Emacs hack to support radio buttons use ! ;; active to indicate which button is selected. ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 's)] ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) --- 1380,1430 ---- '(("Default header" ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio :selected (null gnus-score-default-header)] ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio :selected (eq gnus-score-default-header 'a)] ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio :selected (eq gnus-score-default-header 's)] ["Article body" (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio :selected (eq gnus-score-default-header 'b )] ["All headers" (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio :selected (eq gnus-score-default-header 'h )] ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio :selected (eq gnus-score-default-header 'i )] ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio :selected (eq gnus-score-default-header 't )] ["Crossposting" (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio :selected (eq gnus-score-default-header 'x )] ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio :selected (eq gnus-score-default-header 'l )] ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio :selected (eq gnus-score-default-header 'd )] ["Followups to author" (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio :selected (eq gnus-score-default-header 'f )]) ("Default type" ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :style radio :selected (null gnus-score-default-type)] ;; The `:active' key is commented out in the following, ;; because the GNU Emacs hack to support radio buttons use ! ;; active to indicate which button is selected. ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 's)] ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) *************** *** 1436,1469 **** ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'e)] ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) ! :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'f)] ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'b)] ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'n)] ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'a)] ["Less than number" (gnus-score-set-default 'gnus-score-default-type '<) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '<)] ["Equal to number" (gnus-score-set-default 'gnus-score-default-type '=) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '=)] ! ["Greater than number" (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '>)]) ["Default fold" gnus-score-default-fold-toggle --- 1436,1469 ---- ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'e)] ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) ! :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'f)] ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'b)] ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'n)] ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) ! :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'a)] ["Less than number" (gnus-score-set-default 'gnus-score-default-type '<) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '<)] ["Equal to number" (gnus-score-set-default 'gnus-score-default-type '=) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '=)] ! ["Greater than number" (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '>)]) ["Default fold" gnus-score-default-fold-toggle *************** *** 1481,1487 **** (gnus-score-set-default 'gnus-score-default-duration 't) :style radio :selected (eq gnus-score-default-duration 't)] ! ["Immediate" (gnus-score-set-default 'gnus-score-default-duration 'i) :style radio :selected (eq gnus-score-default-duration 'i)])) --- 1481,1487 ---- (gnus-score-set-default 'gnus-score-default-duration 't) :style radio :selected (eq gnus-score-default-duration 't)] ! ["Immediate" (gnus-score-set-default 'gnus-score-default-duration 'i) :style radio :selected (eq gnus-score-default-duration 'i)])) *************** *** 1658,1664 **** ["Articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] ["Show dormant" gnus-summary-limit-include-dormant t] ! ["Hide childless dormant" gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] ["Show expunged" gnus-summary-show-all-expunged t]) --- 1658,1664 ---- ["Articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] ["Show dormant" gnus-summary-limit-include-dormant t] ! ["Hide childless dormant" gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] ["Show expunged" gnus-summary-show-all-expunged t]) *************** *** 1770,1777 **** ("permanent" nil) ("immediate" now))) header) ! (list ! (apply 'nconc (list (if (eq type 'lower) --- 1770,1777 ---- ("permanent" nil) ("immediate" now))) header) ! (list ! (apply 'nconc (list (if (eq type 'lower) *************** *** 1780,1796 **** (let (outh) (while headers (setq header (car headers)) ! (setq outh ! (cons ! (apply 'nconc (list (car header)) (let ((ts (cdr (assoc (nth 2 header) types))) outt) (while ts (setq outt ! (cons ! (apply 'nconc (list (caar ts)) (let ((ps perms) --- 1780,1796 ---- (let (outh) (while headers (setq header (car headers)) ! (setq outh ! (cons ! (apply 'nconc (list (car header)) (let ((ts (cdr (assoc (nth 2 header) types))) outt) (while ts (setq outt ! (cons ! (apply 'nconc (list (caar ts)) (let ((ps perms) *************** *** 1808,1814 **** (string= (nth 1 header) "body")) "" ! (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) (list 'gnus-score-default nil) --- 1808,1814 ---- (string= (nth 1 header) "body")) "" ! (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) (list 'gnus-score-default nil) *************** *** 2048,2054 **** (level (gnus-data-level (car data))) children) (setq data (cdr data)) ! (while (and data (= (gnus-data-level (car data)) (1+ level))) (push (gnus-data-number (car data)) children) (setq data (cdr data))) --- 2048,2054 ---- (level (gnus-data-level (car data))) children) (setq data (cdr data)) ! (while (and data (= (gnus-data-level (car data)) (1+ level))) (push (gnus-data-number (car data)) children) (setq data (cdr data))) *************** *** 2320,2330 **** (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) ! (defun gnus-summary-insert-line (gnus-tmp-header ! gnus-tmp-level gnus-tmp-current ! gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil ! &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) --- 2320,2330 ---- (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) ! (defun gnus-summary-insert-line (gnus-tmp-header ! gnus-tmp-level gnus-tmp-current ! gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil ! &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) *************** *** 2409,2415 **** (defvar gnus-tmp-new-adopts nil) (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) ! "Return the number of articles in THREAD. This may be 0 in some cases -- if none of the articles in the thread are to be displayed." (let* ((number --- 2409,2415 ---- (defvar gnus-tmp-new-adopts nil) (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) ! "Return the number of articles in THREAD. This may be 0 in some cases -- if none of the articles in the thread are to be displayed." (let* ((number *************** *** 2532,2539 **** (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) ! (setq gnus-newsgroup-limit ! (mapcar (lambda (header) (mail-header-number header)) gnus-newsgroup-headers))) ;; Generate the summary buffer. --- 2532,2539 ---- (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) ! (setq gnus-newsgroup-limit ! (mapcar (lambda (header) (mail-header-number header)) gnus-newsgroup-headers))) ;; Generate the summary buffer. *************** *** 2638,2644 **** ;; Just remove the leading "Re:". (t (gnus-simplify-subject-re subject)))) ! (if (and gnus-summary-gather-exclude-subject (string-match gnus-summary-gather-exclude-subject subject)) nil ; This article shouldn't be gathered --- 2638,2644 ---- ;; Just remove the leading "Re:". (t (gnus-simplify-subject-re subject)))) ! (if (and gnus-summary-gather-exclude-subject (string-match gnus-summary-gather-exclude-subject subject)) nil ; This article shouldn't be gathered *************** *** 2661,2667 **** subject hthread whole-subject) (while threads (setq subject (gnus-general-simplify-subject ! (setq whole-subject (mail-header-subject (caar threads))))) (when subject (if (setq hthread (gnus-gethash subject hashtb)) --- 2661,2667 ---- subject hthread whole-subject) (while threads (setq subject (gnus-general-simplify-subject ! (setq whole-subject (mail-header-subject (caar threads))))) (when subject (if (setq hthread (gnus-gethash subject hashtb)) *************** *** 2764,2770 **** ;; Deal with self-referencing References loops. (when (and (car (symbol-value refs)) (not (zerop ! (apply '+ (mapcar (lambda (thread) --- 2764,2770 ---- ;; Deal with self-referencing References loops. (when (and (car (symbol-value refs)) (not (zerop ! (apply '+ (mapcar (lambda (thread) *************** *** 2783,2791 **** (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (deps gnus-newsgroup-dependencies) ! header references generation relations cthread subject child end pthread relation) ! ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. (gnus-message 7 "Making sparse threads...") --- 2783,2791 ---- (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (deps gnus-newsgroup-dependencies) ! header references generation relations cthread subject child end pthread relation) ! ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. (gnus-message 7 "Making sparse threads...") *************** *** 2815,2821 **** (unless (car (symbol-value cthread)) ;; Make this article the parent of these threads. (setcar (symbol-value cthread) ! (vector gnus-reffed-article-number (cadddr relation) "" "" (cadr relation) --- 2815,2821 ---- (unless (car (symbol-value cthread)) ;; Make this article the parent of these threads. (setcar (symbol-value cthread) ! (vector gnus-reffed-article-number (cadddr relation) "" "" (cadr relation) *************** *** 2918,2924 **** (condition-case () (mail-header-subject (gnus-data-header ! (cadr (gnus-data-find-list article (gnus-data-list t))))) --- 2918,2924 ---- (condition-case () (mail-header-subject (gnus-data-header ! (cadr (gnus-data-find-list article (gnus-data-list t))))) *************** *** 2930,2936 **** (when length (gnus-data-update-list (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) ! (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) --- 2930,2936 ---- (when length (gnus-data-update-list (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) ! (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) *************** *** 2941,2947 **** (references (mail-header-references header)) (parent (gnus-id-to-thread ! (or (gnus-parent-id (when (and references (not (equal "" references))) references)) --- 2941,2947 ---- (references (mail-header-references header)) (parent (gnus-id-to-thread ! (or (gnus-parent-id (when (and references (not (equal "" references))) references)) *************** *** 3014,3020 **** (defun gnus-parent-headers (headers &optional generation) "Return the headers of the GENERATIONeth parent of HEADERS." ! (unless generation (setq generation 1)) (let (references parent) (while (and headers (not (zerop generation))) --- 3014,3020 ---- (defun gnus-parent-headers (headers &optional generation) "Return the headers of the GENERATIONeth parent of HEADERS." ! (unless generation (setq generation 1)) (let (references parent) (while (and headers (not (zerop generation))) *************** *** 3045,3051 **** (let ((level (gnus-summary-thread-level article)) (refs (mail-header-references (gnus-summary-article-header article))) particle) ! (cond ((null level) nil) ((zerop level) t) ((null refs) t) --- 3045,3051 ---- (let ((level (gnus-summary-thread-level article)) (refs (mail-header-references (gnus-summary-article-header article))) particle) ! (cond ((null level) nil) ((zerop level) t) ((null refs) t) *************** *** 3058,3064 **** (defun gnus-root-id (id) "Return the id of the root of the thread where ID appears." (let (last-id prev) ! (while (and id (setq prev (car (gnus-gethash id gnus-newsgroup-dependencies)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) --- 3058,3064 ---- (defun gnus-root-id (id) "Return the id of the root of the thread where ID appears." (let (last-id prev) ! (while (and id (setq prev (car (gnus-gethash id gnus-newsgroup-dependencies)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) *************** *** 3127,3133 **** (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) ! (gnus-data-remove number (- (gnus-point-at-bol) (prog1 --- 3127,3133 ---- (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) ! (gnus-data-remove number (- (gnus-point-at-bol) (prog1 *************** *** 3149,3155 **** (gnus-message 7 "Sorting articles...") (prog1 (setq gnus-newsgroup-headers ! (sort articles (gnus-make-sort-function gnus-article-sort-functions))) (gnus-message 7 "Sorting articles...done")))) --- 3149,3155 ---- (gnus-message 7 "Sorting articles...") (prog1 (setq gnus-newsgroup-headers ! (sort articles (gnus-make-sort-function gnus-article-sort-functions))) (gnus-message 7 "Sorting articles...done")))) *************** *** 3562,3568 **** articles fetched-articles cached) (unless (gnus-check-server ! (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) --- 3562,3568 ---- articles fetched-articles cached) (unless (gnus-check-server ! (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) *************** *** 3602,3608 **** (gnus-update-read-articles group gnus-newsgroup-unreads) (unless (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group)) ! (setq articles (gnus-articles-to-read group read-all)) (cond --- 3602,3608 ---- (gnus-update-read-articles group gnus-newsgroup-unreads) (unless (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group)) ! (setq articles (gnus-articles-to-read group read-all)) (cond *************** *** 3628,3634 **** (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)))))) ! (gnus-get-newsgroup-headers-xover articles nil nil gnus-newsgroup-name t) (gnus-get-newsgroup-headers))) (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) --- 3628,3634 ---- (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)))))) ! (gnus-get-newsgroup-headers-xover articles nil nil gnus-newsgroup-name t) (gnus-get-newsgroup-headers))) (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) *************** *** 3826,3832 **** (car type)))))) (push (cons (cdr type) (if (memq (cdr type) uncompressed) list ! (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) --- 3826,3832 ---- (car type)))))) (push (cons (cdr type) (if (memq (cdr type) uncompressed) list ! (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) *************** *** 3903,3909 **** ;; Pad the mode string a bit. (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) ;; Update the mode line. ! (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p t)))) --- 3903,3909 ---- ;; Pad the mode string a bit. (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) ;; Update the mode line. ! (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p t)))) *************** *** 4158,4175 **** (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already ! ;; been seen, so we ignore this one, except we add ! ;; any additional Xrefs (in case the two articles ! ;; came from different servers). (progn ! (mail-header-set-xref ! (car (symbol-value id-dep)) ! (concat (or (mail-header-xref ! (car (symbol-value id-dep))) ! "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header --- 4158,4171 ---- (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) ! ;; An article with this Message-ID has already been seen, ! ;; so we rename the Message-ID. (progn ! (set ! (setq id-dep (intern (setq id (nnmail-message-id)) ! dependencies)) ! (list header)) ! (mail-header-set-id header id)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header *************** *** 4240,4247 **** (gnus-nov-read-integer) ; lines (if (= (following-char) ?\n) nil ! (gnus-nov-field)) ; misc ! ))) (widen)) --- 4236,4242 ---- (gnus-nov-read-integer) ; lines (if (= (following-char) ?\n) nil ! (gnus-nov-field))))) ; misc (widen)) *************** *** 4253,4269 **** (if (and (car (symbol-value id-dep)) (not force-new)) ;; An article with this Message-ID has already been seen, ! ;; so we ignore this one, except we add any additional ! ;; Xrefs (in case the two articles came from different ! ;; servers. (progn ! (mail-header-set-xref ! (car (symbol-value id-dep)) ! (concat (or (mail-header-xref ! (car (symbol-value id-dep))) ! "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header --- 4248,4260 ---- (if (and (car (symbol-value id-dep)) (not force-new)) ;; An article with this Message-ID has already been seen, ! ;; so we rename the Message-ID. (progn ! (set ! (setq id-dep (intern (setq id (nnmail-message-id)) ! dependencies)) ! (list header)) ! (mail-header-set-id header id)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header *************** *** 4275,4281 **** header)) ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) "Parse the news overview data in the server buffer, and return a --- 4266,4272 ---- header)) ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) "Parse the news overview data in the server buffer, and return a *************** *** 4362,4368 **** old-header) (when (setq d (gnus-data-find (mail-header-number old-header))) (goto-char (gnus-data-pos d)) ! (gnus-data-remove number (- (gnus-point-at-bol) (prog1 --- 4353,4359 ---- old-header) (when (setq d (gnus-data-find (mail-header-number old-header))) (goto-char (gnus-data-pos d)) ! (gnus-data-remove number (- (gnus-point-at-bol) (prog1 *************** *** 4589,4595 **** ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) --- 4580,4586 ---- ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) *************** *** 4712,4718 **** (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) ! ;; We have to adjust the point of group mode buffer because ;; point was moved to the next unread newsgroup by exiting. (gnus-summary-jump-to-group group) (when rescan --- 4703,4709 ---- (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) ! ;; We have to adjust the point of group mode buffer because ;; point was moved to the next unread newsgroup by exiting. (gnus-summary-jump-to-group group) (when rescan *************** *** 5361,5367 **** (defun gnus-summary-next-unread-article () "Select unread article after current one." (interactive) ! (gnus-summary-next-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-last-article-p (gnus-summary-article-number))) (and gnus-auto-select-same --- 5352,5358 ---- (defun gnus-summary-next-unread-article () "Select unread article after current one." (interactive) ! (gnus-summary-next-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-last-article-p (gnus-summary-article-number))) (and gnus-auto-select-same *************** *** 5592,5598 **** If given a prefix, remove all limits." (interactive "P") (gnus-set-global-variables) ! (when total (setq gnus-newsgroup-limits (list (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers)))) --- 5583,5589 ---- If given a prefix, remove all limits." (interactive "P") (gnus-set-global-variables) ! (when total (setq gnus-newsgroup-limits (list (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers)))) *************** *** 5622,5628 **** (gnus-summary-limit-to-subject from "from")) (defun gnus-summary-limit-to-age (age &optional younger-p) ! "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." (interactive "nTime in days: \nP") --- 5613,5619 ---- (gnus-summary-limit-to-subject from "from")) (defun gnus-summary-limit-to-age (age &optional younger-p) ! "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." (interactive "nTime in days: \nP") *************** *** 5672,5678 **** Returns how many articles were removed." (interactive "sMarks: ") (gnus-summary-limit-to-marks marks t)) ! (defun gnus-summary-limit-to-marks (marks &optional reverse) "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). If REVERSE (the prefix), limit the summary buffer to articles that are --- 5663,5669 ---- Returns how many articles were removed." (interactive "sMarks: ") (gnus-summary-limit-to-marks marks t)) ! (defun gnus-summary-limit-to-marks (marks &optional reverse) "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). If REVERSE (the prefix), limit the summary buffer to articles that are *************** *** 5740,5746 **** ;; children. (while (setq d (pop data)) (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) ! (and (setq children (gnus-article-children (gnus-data-number d))) (let (found) (while children --- 5731,5737 ---- ;; children. (while (setq d (pop data)) (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) ! (and (setq children (gnus-article-children (gnus-data-number d))) (let (found) (while children *************** *** 5957,5963 **** (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))) (progn ! (setq gnus-newsgroup-reads (delq number gnus-newsgroup-unreads)) t)))) ;; Nope, invisible article. --- 5948,5954 ---- (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))) (progn ! (setq gnus-newsgroup-reads (delq number gnus-newsgroup-unreads)) t)))) ;; Nope, invisible article. *************** *** 6062,6078 **** (setq message-id (concat message-id ">"))) (let* ((header (gnus-id-to-header message-id)) (sparse (and header ! (gnus-summary-article-sparse-p (mail-header-number header))))) (if header (prog1 ;; The article is present in the buffer, to we just go to it. ! (gnus-summary-goto-article (mail-header-number header) nil header) (when sparse (gnus-summary-update-article (mail-header-number header)))) ;; We fetch the article ! (let ((gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) number) --- 6053,6069 ---- (setq message-id (concat message-id ">"))) (let* ((header (gnus-id-to-header message-id)) (sparse (and header ! (gnus-summary-article-sparse-p (mail-header-number header))))) (if header (prog1 ;; The article is present in the buffer, to we just go to it. ! (gnus-summary-goto-article (mail-header-number header) nil header) (when sparse (gnus-summary-update-article (mail-header-number header)))) ;; We fetch the article ! (let ((gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) number) *************** *** 6121,6127 **** (unwind-protect (if (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) ! (nndoc-article-type ,(if force 'digest 'guess))) t) ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) --- 6112,6118 ---- (unwind-protect (if (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) ! (nndoc-article-type ,(if force 'digest 'guess))) t) ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) *************** *** 6182,6188 **** (cons (current-buffer) 'summary))) (t (error "Couldn't select virtual nndoc group"))))) ! (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." --- 6173,6179 ---- (cons (current-buffer) 'summary))) (t (error "Couldn't select virtual nndoc group"))))) ! (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." *************** *** 6487,6493 **** (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))))) ! (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. --- 6478,6484 ---- (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))))) ! (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. *************** *** 6537,6546 **** (symbol-value (intern (format "gnus-current-%s-group" action))) articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) ! (setq to-method (or select-method (gnus-group-name-to-method to-newsgroup))) ;; Check the method we are to move this article to... ! (unless (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (unless (gnus-check-server to-method) --- 6528,6537 ---- (symbol-value (intern (format "gnus-current-%s-group" action))) articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) ! (setq to-method (or select-method (gnus-group-name-to-method to-newsgroup))) ;; Check the method we are to move this article to... ! (unless (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (unless (gnus-check-server to-method) *************** *** 6578,6588 **** " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) ":" article)) ! (unless xref (setq xref (list (system-name)))) (setq new-xref (concat ! (mapconcat 'identity (delete "Xref:" (delete new-xref xref)) " ") " " new-xref)) --- 6569,6579 ---- " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) ":" article)) ! (unless xref (setq xref (list (system-name)))) (setq new-xref (concat ! (mapconcat 'identity (delete "Xref:" (delete new-xref xref)) " ") " " new-xref)) *************** *** 6610,6616 **** (gnus-gethash (gnus-group-prefixed-name (car art-group) ! (or select-method (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) --- 6601,6607 ---- (gnus-gethash (gnus-group-prefixed-name (car art-group) ! (or select-method (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) *************** *** 6648,6654 **** (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) (setcdr (gnus-active to-group) to-article) (setcdr gnus-newsgroup-active to-article)) ! (while marks (when (memq article (symbol-value (intern (format "gnus-newsgroup-%s" --- 6639,6645 ---- (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) (setcdr (gnus-active to-group) to-article) (setcdr gnus-newsgroup-active to-article)) ! (while marks (when (memq article (symbol-value (intern (format "gnus-newsgroup-%s" *************** *** 6683,6689 **** ;; Re-activate all groups that have been moved to. (while to-groups (gnus-activate-group (pop to-groups))) ! (gnus-kill-buffer copy-buf) (gnus-summary-position-point) (gnus-set-mode-line 'summary))) --- 6674,6680 ---- ;; Re-activate all groups that have been moved to. (while to-groups (gnus-activate-group (pop to-groups))) ! (gnus-kill-buffer copy-buf) (gnus-summary-position-point) (gnus-set-mode-line 'summary))) *************** *** 6702,6708 **** (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil ! "Default method for respooling an article. If nil, use to the current newsgroup method." :type 'gnus-select-method-name :group 'gnus-summary-mail) --- 6693,6699 ---- (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil ! "Default method for respooling an article. If nil, use to the current newsgroup method." :type 'gnus-select-method-name :group 'gnus-summary-mail) *************** *** 6721,6727 **** In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive (list current-prefix-arg (let* ((methods (gnus-methods-using 'respool)) (methname --- 6712,6718 ---- In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive (list current-prefix-arg (let* ((methods (gnus-methods-using 'respool)) (methname *************** *** 6729,6740 **** (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method ! (gnus-completing-read methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) (cond ! ((zerop (length (setq ms (gnus-servers-using-backend (intern method))))) (list (intern method) "")) ((= 1 (length ms)) --- 6720,6731 ---- (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method ! (gnus-completing-read methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) (cond ! ((zerop (length (setq ms (gnus-servers-using-backend (intern method))))) (list (intern method) "")) ((= 1 (length ms)) *************** *** 6905,6911 **** "Edit the current article. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only ! groups." (interactive "P") (save-excursion (set-buffer gnus-summary-buffer) --- 6896,6902 ---- "Edit the current article. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only ! groups." (interactive "P") (save-excursion (set-buffer gnus-summary-buffer) *************** *** 6979,6985 **** (defun gnus-summary-edit-wash (key) "Perform editing command in the article buffer." ! (interactive (list (progn (message "%s" (concat (this-command-keys) "- ")) --- 6970,6976 ---- (defun gnus-summary-edit-wash (key) "Perform editing command in the article buffer." ! (interactive (list (progn (message "%s" (concat (this-command-keys) "- ")) *************** *** 7519,7525 **** (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while (progn (and (< (gnus-summary-article-score) score) (gnus-summary-mark-article nil mark)) --- 7510,7516 ---- (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while (progn (and (< (gnus-summary-article-score) score) (gnus-summary-mark-article nil mark)) *************** *** 7585,7591 **** (defun gnus-summary-catchup (&optional all quietly to-here not-mark) "Mark all unread articles in this newsgroup as read. ! If prefix argument ALL is non-nil, ticked and dormant articles will also be marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All --- 7576,7582 ---- (defun gnus-summary-catchup (&optional all quietly to-here not-mark) "Mark all unread articles in this newsgroup as read. ! If prefix argument ALL is non-nil, ticked and dormant articles will also be marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All *************** *** 7746,7752 **** (error "Beginning of summary buffer.")))))) (unless (not (eq current-article parent-article)) (error "An article may not be self-referential.")) ! (let ((message-id (mail-header-id (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent.")) --- 7737,7743 ---- (error "Beginning of summary buffer.")))))) (unless (not (eq current-article parent-article)) (error "An article may not be self-referential.")) ! (let ((message-id (mail-header-id (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent.")) *************** *** 7879,7885 **** (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) (decf n)) ! (unless silent (gnus-summary-position-point)) (when (and (not silent) (/= 0 n)) (gnus-message 7 "No more threads")) --- 7870,7876 ---- (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) (decf n)) ! (unless silent (gnus-summary-position-point)) (when (and (not silent) (/= 0 n)) (gnus-message 7 "No more threads")) *************** *** 8048,8054 **** (interactive "P") (gnus-set-global-variables) (let* ((articles (gnus-summary-work-articles n)) ! (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) header article file) --- 8039,8045 ---- (interactive "P") (gnus-set-global-variables) (let* ((articles (gnus-summary-work-articles n)) ! (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) header article file) *************** *** 8228,8234 **** nil nil 'gnus-group-history)) (t ! (gnus-completing-read nil prom (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil --- 8219,8225 ---- nil nil 'gnus-group-history)) (t ! (gnus-completing-read nil prom (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil *************** *** 8236,8247 **** (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) ! (setq to-newsgroup (or default ""))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) ! (or (and (gnus-request-create-group to-newsgroup (gnus-group-name-to-method to-newsgroup)) (gnus-activate-group to-newsgroup nil nil (gnus-group-name-to-method --- 8227,8240 ---- (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) ! (setq to-newsgroup default)) ! (unless to-newsgroup ! (error "No group name entered")) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) ! (or (and (gnus-request-create-group to-newsgroup (gnus-group-name-to-method to-newsgroup)) (gnus-activate-group to-newsgroup nil nil (gnus-group-name-to-method *************** *** 8334,8340 **** (setq buffer-read-only nil) (let ((command (if automatic command (read-string "Command: " command))) ;; Just binding this here doesn't help, because there might ! ;; be output from the process after exiting the scope of ;; this `let'. ;; (buffer-read-only nil) ) --- 8327,8333 ---- (setq buffer-read-only nil) (let ((command (if automatic command (read-string "Command: " command))) ;; Just binding this here doesn't help, because there might ! ;; be output from the process after exiting the scope of ;; this `let'. ;; (buffer-read-only nil) ) *************** *** 8368,8374 **** (defun gnus-read-header (id &optional header) "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) ! (gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) where) --- 8361,8367 ---- (defun gnus-read-header (id &optional header) "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) ! (gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) where) *************** *** 8445,8451 **** ;; Fix by Mike Dugan . (from (if (get-text-property beg gnus-mouse-face-prop) beg ! (or (next-single-property-change beg gnus-mouse-face-prop nil end) beg))) (to --- 8438,8444 ---- ;; Fix by Mike Dugan . (from (if (get-text-property beg gnus-mouse-face-prop) beg ! (or (next-single-property-change beg gnus-mouse-face-prop nil end) beg))) (to *************** *** 8489,8496 **** (setq list (cdr list)))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))) --- 8482,8489 ---- (setq list (cdr list)))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) ! (gnus-put-text-property ! beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))) *** pub/rgnus/lisp/gnus-topic.el Thu Feb 20 04:19:53 1997 --- rgnus/lisp/gnus-topic.el Fri Mar 7 23:51:24 1997 *************** *** 199,205 **** (- (1+ (cdr active)) (car active)))) clevel (or (gnus-info-level info) (if (member group gnus-zombie-list) 8 9)))) ! (and unread ; nil means that the group is dead. (<= clevel level) (>= clevel lowest) ; Is inside the level we want. --- 199,205 ---- (- (1+ (cdr active)) (car active)))) clevel (or (gnus-info-level info) (if (member group gnus-zombie-list) 8 9)))) ! (and unread ; nil means that the group is dead. (<= clevel level) (>= clevel lowest) ; Is inside the level we want. *************** *** 236,249 **** result found) (while (and topology (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic topic (car topology))))) (setq topology (cdr topology))) (or result (and found parent)))) (defun gnus-topic-next-topic (topic &optional previous) "Return the next sibling of TOPIC." ! (let ((parentt (cddr (gnus-topic-find-topology (gnus-topic-parent-topic topic)))) prev) (while (and parentt --- 236,249 ---- result found) (while (and topology (not (setq found (equal (caaar topology) topic))) ! (not (setq result (gnus-topic-parent-topic topic (car topology))))) (setq topology (cdr topology))) (or result (and found parent)))) (defun gnus-topic-next-topic (topic &optional previous) "Return the next sibling of TOPIC." ! (let ((parentt (cddr (gnus-topic-find-topology (gnus-topic-parent-topic topic)))) prev) (while (and parentt *************** *** 278,284 **** (defun gnus-topic-list (&optional topology) "Return a list of all topics in the topology." (unless topology ! (setq topology gnus-topic-topology gnus-tmp-topics nil)) (push (caar topology) gnus-tmp-topics) (mapcar 'gnus-topic-list (cdr topology)) --- 278,284 ---- (defun gnus-topic-list (&optional topology) "Return a list of all topics in the topology." (unless topology ! (setq topology gnus-topic-topology gnus-tmp-topics nil)) (push (caar topology) gnus-tmp-topics) (mapcar 'gnus-topic-list (cdr topology)) *************** *** 354,371 **** (not gnus-topology-checked-p)) (gnus-topic-check-topology)) ! (unless list-topic (erase-buffer)) ! ;; List dead groups? (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) ! (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) ! (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) ! (gnus-group-prepare-flat-list-dead (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) --- 354,371 ---- (not gnus-topology-checked-p)) (gnus-topic-check-topology)) ! (unless list-topic (erase-buffer)) ! ;; List dead groups? (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) ! (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) ! (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) ! (gnus-group-prepare-flat-list-dead (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) *************** *** 379,385 **** (or topic-level level) all)) (gnus-topic-prepare-topic gnus-topic-topology 0 (or topic-level level) all))) ! (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook)))) --- 379,385 ---- (or topic-level level) all)) (gnus-topic-prepare-topic gnus-topic-topology 0 (or topic-level level) all))) ! (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook)))) *************** *** 391,397 **** (let* ((type (pop topicl)) (entries (gnus-topic-find-groups (car type) list-level all)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) ! (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) (beg (progn (beginning-of-line) (point))) (topicl (reverse topicl)) --- 391,397 ---- (let* ((type (pop topicl)) (entries (gnus-topic-find-groups (car type) list-level all)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) ! (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) (beg (progn (beginning-of-line) (point))) (topicl (reverse topicl)) *************** *** 403,416 **** ;; Insert any sub-topics. (while topicl (incf unread ! (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level all (not visiblep)))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. (while (setq entry (pop entries)) ! (when visiblep (if (stringp entry) ;; Dead groups. (gnus-group-insert-group-line --- 403,416 ---- ;; Insert any sub-topics. (while topicl (incf unread ! (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level all (not visiblep)))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. (while (setq entry (pop entries)) ! (when visiblep (if (stringp entry) ;; Dead groups. (gnus-group-insert-group-line *************** *** 420,426 **** nil) ;; Living groups. (when (setq info (nth 2 entry)) ! (gnus-group-insert-group-line (gnus-info-group info) (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))))) --- 420,426 ---- nil) ;; Living groups. (when (setq info (nth 2 entry)) ! (gnus-group-insert-group-line (gnus-info-group info) (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))))) *************** *** 437,446 **** (when (and (not silent) (or gnus-topic-display-empty-topics ;We want empty topics (not (zerop unread)) ;Non-empty ! tick ;Ticked articles (/= point-max (point-max)))) ;Unactivated groups (gnus-extent-start-open (point)) ! (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) level all-entries unread)) --- 437,446 ---- (when (and (not silent) (or gnus-topic-display-empty-topics ;We want empty topics (not (zerop unread)) ;Non-empty ! tick ;Ticked articles (/= point-max (point-max)))) ;Unactivated groups (gnus-extent-start-open (point)) ! (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) level all-entries unread)) *************** *** 473,482 **** (defun gnus-topic-insert-topic (topic &optional level) "Insert TOPIC." ! (gnus-group-prepare-topics (car gnus-group-list-mode) (cdr gnus-group-list-mode) nil nil topic level)) ! (defun gnus-topic-fold (&optional insert) "Remove/insert the current topic." (let ((topic (gnus-group-topic-name))) --- 473,482 ---- (defun gnus-topic-insert-topic (topic &optional level) "Insert TOPIC." ! (gnus-group-prepare-topics (car gnus-group-list-mode) (cdr gnus-group-list-mode) nil nil topic level)) ! (defun gnus-topic-fold (&optional insert) "Remove/insert the current topic." (let ((topic (gnus-group-topic-name))) *************** *** 492,498 **** (or insert (not (gnus-topic-visible-p))) nil nil 9) (gnus-topic-enter-dribble))))))) ! (defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) (let* ((visible (if visiblep "" "...")) (indentation (make-string (* gnus-topic-indent-level level) ? )) --- 492,498 ---- (or insert (not (gnus-topic-visible-p))) nil nil 9) (gnus-topic-enter-dribble))))))) ! (defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) (let* ((visible (if visiblep "" "...")) (indentation (make-string (* gnus-topic-indent-level level) ? )) *************** *** 501,507 **** (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) (beginning-of-line) ;; Insert the text. ! (gnus-add-text-properties (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec) --- 501,507 ---- (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) (beginning-of-line) ;; Insert the text. ! (gnus-add-text-properties (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec) *************** *** 534,540 **** gnus-topic-mode) (let ((group (gnus-group-group-name)) (buffer-read-only nil)) ! (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) (gnus-topic-update-topic-line (gnus-group-topic-name)) --- 534,540 ---- gnus-topic-mode) (let ((group (gnus-group-group-name)) (buffer-read-only nil)) ! (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) (gnus-topic-update-topic-line (gnus-group-topic-name)) *************** *** 565,571 **** (let* ((top (gnus-topic-find-topology topic-name)) (type (cadr top)) (children (cddr top)) ! (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (parent (gnus-topic-parent-topic topic-name)) --- 565,571 ---- (let* ((top (gnus-topic-find-topology topic-name)) (type (cadr top)) (children (cddr top)) ! (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (parent (gnus-topic-parent-topic topic-name)) *************** *** 583,589 **** (incf unread (car entry))))) (setq old-unread (gnus-group-topic-unread)) ;; Insert the topic line. ! (gnus-topic-insert-topic-line (car type) (gnus-topic-visible-p) (not (eq (nth 2 type) 'hidden)) (gnus-group-topic-level) all-entries unread) --- 583,589 ---- (incf unread (car entry))))) (setq old-unread (gnus-group-topic-unread)) ;; Insert the topic line. ! (gnus-topic-insert-topic-line (car type) (gnus-topic-visible-p) (not (eq (nth 2 type) 'hidden)) (gnus-group-topic-level) all-entries unread) *************** *** 595,601 **** unread)) (defun gnus-topic-group-indentation () ! (make-string (* gnus-topic-indent-level (or (save-excursion (forward-line -1) --- 595,601 ---- unread)) (defun gnus-topic-group-indentation () ! (make-string (* gnus-topic-indent-level (or (save-excursion (forward-line -1) *************** *** 697,703 **** "Run when changing levels to enter/remove groups from topics." (save-excursion (set-buffer gnus-group-buffer) ! (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) ;; Remove the group from the topics. --- 697,703 ---- "Run when changing levels to enter/remove groups from topics." (save-excursion (set-buffer gnus-group-buffer) ! (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) ;; Remove the group from the topics. *************** *** 713,719 **** (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation ! (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) --- 713,719 ---- (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation ! (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) *************** *** 723,729 **** (yanked (list group)) alist talist end) ;; Then we enter the yanked groups into the topics they belong ! ;; to. (when (setq alist (assoc (save-excursion (forward-line -1) (or --- 723,729 ---- (yanked (list group)) alist talist end) ;; Then we enter the yanked groups into the topics they belong ! ;; to. (when (setq alist (assoc (save-excursion (forward-line -1) (or *************** *** 764,770 **** ;; Then try to put point on a group before point. (unless after (setq after (cdr (member group (reverse (cdr list))))) ! (while (and after (not (gnus-group-goto-group (car after)))) (setq after (cdr after)))) ;; Finally, just put point on the topic. --- 764,770 ---- ;; Then try to put point on a group before point. (unless after (setq after (cdr (member group (reverse (cdr list))))) ! (while (and after (not (gnus-group-goto-group (car after)))) (setq after (cdr after)))) ;; Finally, just put point on the topic. *************** *** 779,785 **** (defun gnus-topic-grok-active (&optional force) "Parse all active groups and create topic structures for them." ! ;; First we make sure that we have really read the active file. (when (or force (not gnus-topic-active-alist)) (let (groups) --- 779,785 ---- (defun gnus-topic-grok-active (&optional force) "Parse all active groups and create topic structures for them." ! ;; First we make sure that we have really read the active file. (when (or force (not gnus-topic-active-alist)) (let (groups) *************** *** 809,816 **** ;; topic. (push (pop groups) tgroups) ;; New sub-hierarchy, so we add it to the topology. ! (nconc topology (list (setq ntopology ! (list (list (substring group 0 (match-end 0)) 'invisible))))) ;; Descend the hierarchy. --- 809,816 ---- ;; topic. (push (pop groups) tgroups) ;; New sub-hierarchy, so we add it to the topology. ! (nconc topology (list (setq ntopology ! (list (list (substring group 0 (match-end 0)) 'invisible))))) ;; Descend the hierarchy. *************** *** 902,916 **** (interactive (list current-prefix-arg t)) (when (eq major-mode 'gnus-group-mode) (make-local-variable 'gnus-topic-mode) ! (setq gnus-topic-mode (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (when gnus-topic-mode (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) ! (setq gnus-topic-line-format-spec ! (gnus-parse-format gnus-topic-line-format gnus-topic-line-format-alist t)) (unless (assq 'gnus-topic-mode minor-mode-alist) (push '(gnus-topic-mode " Topic") minor-mode-alist)) --- 902,916 ---- (interactive (list current-prefix-arg t)) (when (eq major-mode 'gnus-group-mode) (make-local-variable 'gnus-topic-mode) ! (setq gnus-topic-mode (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (when gnus-topic-mode (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) ! (setq gnus-topic-line-format-spec ! (gnus-parse-format gnus-topic-line-format gnus-topic-line-format-alist t)) (unless (assq 'gnus-topic-mode minor-mode-alist) (push '(gnus-topic-mode " Topic") minor-mode-alist)) *************** *** 943,956 **** ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) ! (remove-hook 'gnus-group-change-level-function 'gnus-topic-change-level) (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) (when redisplay (gnus-group-list-groups)))) ! (defun gnus-topic-select-group (&optional all) "Select this newsgroup. No article is selected automatically. --- 943,956 ---- ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) ! (remove-hook 'gnus-group-change-level-function 'gnus-topic-change-level) (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) (when redisplay (gnus-group-list-groups)))) ! (defun gnus-topic-select-group (&optional all) "Select this newsgroup. No article is selected automatically. *************** *** 960,966 **** If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) ! (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-select-group all))) --- 960,966 ---- If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) ! (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-select-group all))) *************** *** 982,994 **** If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) ! (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-read-group all no-article group))) (defun gnus-topic-create-topic (topic parent &optional previous full-topic) ! (interactive (list (read-string "New topic: ") (gnus-current-topic))) --- 982,994 ---- If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) ! (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-read-group all no-article group))) (defun gnus-topic-create-topic (topic parent &optional previous full-topic) ! (interactive (list (read-string "New topic: ") (gnus-current-topic))) *************** *** 1025,1031 **** (start-group (progn (forward-line 1) (gnus-group-group-name))) (start-topic (gnus-group-topic-name)) entry) ! (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and --- 1025,1031 ---- (start-group (progn (forward-line 1) (gnus-group-group-name))) (start-topic (gnus-group-topic-name)) entry) ! (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and *************** *** 1043,1049 **** (defun gnus-topic-remove-group (&optional arg) "Remove the current group from the topic." (interactive "P") ! (gnus-group-iterate arg (lambda (group) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) (buffer-read-only nil)) --- 1043,1049 ---- (defun gnus-topic-remove-group (&optional arg) "Remove the current group from the topic." (interactive "P") ! (gnus-group-iterate arg (lambda (group) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) (buffer-read-only nil)) *************** *** 1065,1071 **** (interactive "P") (if (gnus-group-topic-p) (let ((topic (gnus-group-topic-name))) ! (push (cons (gnus-topic-find-topology topic) (assoc topic gnus-topic-alist)) gnus-topic-killed-topics) --- 1065,1071 ---- (interactive "P") (if (gnus-group-topic-p) (let ((topic (gnus-group-topic-name))) ! (push (cons (gnus-topic-find-topology topic) (assoc topic gnus-topic-alist)) gnus-topic-killed-topics) *************** *** 1074,1085 **** (gnus-topic-enter-dribble)) (gnus-group-kill-group n discard) (gnus-topic-update-topic))) ! (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." (interactive "p") (if gnus-topic-killed-topics ! (let* ((previous (or (gnus-group-topic-name) (gnus-topic-next-topic (gnus-current-topic)))) (data (pop gnus-topic-killed-topics)) --- 1074,1085 ---- (gnus-topic-enter-dribble)) (gnus-group-kill-group n discard) (gnus-topic-update-topic))) ! (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." (interactive "p") (if gnus-topic-killed-topics ! (let* ((previous (or (gnus-group-topic-name) (gnus-topic-next-topic (gnus-current-topic)))) (data (pop gnus-topic-killed-topics)) *************** *** 1094,1100 **** (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation ! (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) --- 1094,1100 ---- (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation ! (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) *************** *** 1105,1111 **** ;; We first yank the groups the normal way... (setq yanked (gnus-group-yank-group arg)) ;; Then we enter the yanked groups into the topics they belong ! ;; to. (setq alist (assoc (save-excursion (forward-line -1) (gnus-current-topic)) --- 1105,1111 ---- ;; We first yank the groups the normal way... (setq yanked (gnus-group-yank-group arg)) ;; Then we enter the yanked groups into the topics they belong ! ;; to. (setq alist (assoc (save-excursion (forward-line -1) (gnus-current-topic)) *************** *** 1210,1216 **** (entry (assoc old-name gnus-topic-alist))) (when top (setcar (cadr top) new-name)) ! (when entry (setcar entry new-name)) (forward-line -1) (gnus-dribble-touch) --- 1210,1216 ---- (entry (assoc old-name gnus-topic-alist))) (when top (setcar (cadr top) new-name)) ! (when entry (setcar entry new-name)) (forward-line -1) (gnus-dribble-touch) *** pub/rgnus/lisp/gnus-util.el Fri Mar 7 07:37:01 1997 --- rgnus/lisp/gnus-util.el Fri Mar 7 23:51:25 1997 *************** *** 320,326 **** (defun gnus-completing-read (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. ! (let* ((prompt (if default (concat prompt " (default " default ") ") (concat prompt " "))) (answer (apply 'completing-read prompt args))) --- 320,326 ---- (defun gnus-completing-read (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. ! (let* ((prompt (if default (concat prompt " (default " default ") ") (concat prompt " "))) (answer (apply 'completing-read prompt args))) *************** *** 375,381 **** (defsubst gnus-time-iso8601 (time) "Return a string of TIME in YYMMDDTHHMMSS format." (format-time-string "%Y%m%dT%H%M%S" time)) ! (defun gnus-date-iso8601 (header) "Convert the date field in HEADER to YYMMDDTHHMMSS" (condition-case () --- 375,381 ---- (defsubst gnus-time-iso8601 (time) "Return a string of TIME in YYMMDDTHHMMSS format." (format-time-string "%Y%m%dT%H%M%S" time)) ! (defun gnus-date-iso8601 (header) "Convert the date field in HEADER to YYMMDDTHHMMSS" (condition-case () *************** *** 481,487 **** (goto-char orig) ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) ! (set-window-hscroll (get-buffer-window (current-buffer) t) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) --- 481,487 ---- (goto-char orig) ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) ! (set-window-hscroll (get-buffer-window (current-buffer) t) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) *************** *** 499,506 **** Timezone package is used." (condition-case () (progn ! (setq date (inline (timezone-fix-time ! date nil (aref (inline (timezone-parse-date date)) 4)))) (inline (timezone-make-sortable-date --- 499,506 ---- Timezone package is used." (condition-case () (progn ! (setq date (inline (timezone-fix-time ! date nil (aref (inline (timezone-parse-date date)) 4)))) (inline (timezone-make-sortable-date *************** *** 509,515 **** (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5)))))) (error ""))) ! (defun gnus-copy-file (file &optional to) "Copy FILE to TO." (interactive --- 509,515 ---- (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5)))))) (error ""))) ! (defun gnus-copy-file (file &optional to) "Copy FILE to TO." (interactive *************** *** 552,558 **** (defun gnus-make-sort-function (funs) "Return a composite sort condition based on the functions in FUNC." ! (cond ((not (listp funs)) funs) ((null funs) funs) ((cdr funs) --- 552,558 ---- (defun gnus-make-sort-function (funs) "Return a composite sort condition based on the functions in FUNC." ! (cond ((not (listp funs)) funs) ((null funs) funs) ((cdr funs) *** pub/rgnus/lisp/gnus-uu.el Sun Mar 2 04:47:17 1997 --- rgnus/lisp/gnus-uu.el Fri Mar 7 23:51:25 1997 *************** *** 24,30 **** ;;; Commentary: ! ;;; Code: (require 'gnus) (require 'gnus-art) --- 24,30 ---- ;;; Commentary: ! ;;; Code: (require 'gnus) (require 'gnus-art) *************** *** 51,63 **** ;; Default viewing action rules ! (defcustom gnus-uu-default-view-rules '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") ("\\.pas$" "cat %s | sed s/\r//g") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") ! ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") ("\\.midi?$" "playmidi -f") --- 51,63 ---- ;; Default viewing action rules ! (defcustom gnus-uu-default-view-rules '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") ("\\.pas$" "cat %s | sed s/\r//g") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") ! ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") ("\\.midi?$" "playmidi -f") *************** *** 67,75 **** ("\\.html$" "xmosaic") ("\\.mpe?g$" "mpeg_play") ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ! ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) ! "Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. --- 67,75 ---- ("\\.html$" "xmosaic") ("\\.mpe?g$" "mpeg_play") ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ! ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) ! "Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. *************** *** 100,123 **** :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ! (defcustom gnus-uu-user-view-rules nil "What actions are to be taken to view a file. ! See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ! (defcustom gnus-uu-user-view-rules-end '(("" "file")) "What actions are to be taken if no rule matched the file name. ! See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ;; Default unpacking commands ! (defcustom gnus-uu-default-archive-rules '(("\\.tar$" "tar xf") ("\\.zip$" "unzip -o") ("\\.ar$" "ar x") --- 100,123 ---- :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ! (defcustom gnus-uu-user-view-rules nil "What actions are to be taken to view a file. ! See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ! (defcustom gnus-uu-user-view-rules-end '(("" "file")) "What actions are to be taken if no rule matched the file name. ! See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ;; Default unpacking commands ! (defcustom gnus-uu-default-archive-rules '(("\\.tar$" "tar xf") ("\\.zip$" "unzip -o") ("\\.ar$" "ar x") *************** *** 131,144 **** :group 'gnus-extract-archive :type '(repeat (group regexp (string :tag "Command")))) ! (defvar gnus-uu-destructive-archivers (list "uncompress" "gunzip")) (defcustom gnus-uu-user-archive-rules nil "A list that can be set to override the default archive unpacking commands. To use, for instance, 'untar' to unpack tar files and 'zip -x' to unpack zip files, say the following: ! (setq gnus-uu-user-archive-rules '((\"\\\\.tar$\" \"untar\") (\"\\\\.zip$\" \"zip -x\")))" :group 'gnus-extract-archive --- 131,144 ---- :group 'gnus-extract-archive :type '(repeat (group regexp (string :tag "Command")))) ! (defvar gnus-uu-destructive-archivers (list "uncompress" "gunzip")) (defcustom gnus-uu-user-archive-rules nil "A list that can be set to override the default archive unpacking commands. To use, for instance, 'untar' to unpack tar files and 'zip -x' to unpack zip files, say the following: ! (setq gnus-uu-user-archive-rules '((\"\\\\.tar$\" \"untar\") (\"\\\\.zip$\" \"zip -x\")))" :group 'gnus-extract-archive *************** *** 146,152 **** (defcustom gnus-uu-ignore-files-by-name nil "*A regular expression saying what files should not be viewed based on name. ! If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") --- 146,152 ---- (defcustom gnus-uu-ignore-files-by-name nil "*A regular expression saying what files should not be viewed based on name. ! If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") *************** *** 159,165 **** (defcustom gnus-uu-ignore-files-by-type nil "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. ! If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") --- 159,165 ---- (defcustom gnus-uu-ignore-files-by-type nil "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. ! If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") *************** *** 211,226 **** ("\\.rsrc$" "video/rsrc") ("\\..*$" "unknown/unknown"))) ! ;; Various variables users may set ! (defcustom gnus-uu-tmp-dir "/tmp/" "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract :type 'directory) ! (defcustom gnus-uu-do-not-unpack-archives nil ! "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. Default is nil." :group 'gnus-extract-archive :type 'boolean) --- 211,226 ---- ("\\.rsrc$" "video/rsrc") ("\\..*$" "unknown/unknown"))) ! ;; Various variables users may set ! (defcustom gnus-uu-tmp-dir "/tmp/" "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract :type 'directory) ! (defcustom gnus-uu-do-not-unpack-archives nil ! "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. Default is nil." :group 'gnus-extract-archive :type 'boolean) *************** *** 234,247 **** (defcustom gnus-uu-grabbed-file-functions nil "Functions run on each file after successful decoding. They will be called with the name of the file as the argument. ! Likely functions you can use in this list are `gnus-uu-grab-view' and `gnus-uu-grab-move'." :group 'gnus-extract :options '(gnus-uu-grab-view gnus-uu-grab-move) :type 'hook) ! (defcustom gnus-uu-ignore-default-archive-rules nil ! "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil." :group 'gnus-extract-archive :type 'boolean) --- 234,247 ---- (defcustom gnus-uu-grabbed-file-functions nil "Functions run on each file after successful decoding. They will be called with the name of the file as the argument. ! Likely functions you can use in this list are `gnus-uu-grab-view' and `gnus-uu-grab-move'." :group 'gnus-extract :options '(gnus-uu-grab-view gnus-uu-grab-move) :type 'hook) ! (defcustom gnus-uu-ignore-default-archive-rules nil ! "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil." :group 'gnus-extract-archive :type 'boolean) *************** *** 261,287 **** :type 'boolean) (defcustom gnus-uu-unmark-articles-not-decoded nil ! "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-correct-stripped-uucode nil ! "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-save-in-digest nil "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. ! If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - ! no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them." :group 'gnus-extract :type 'boolean) ! (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" "^Summary:" "^References:") "List of regexps to match headers included in digested messages. --- 261,287 ---- :type 'boolean) (defcustom gnus-uu-unmark-articles-not-decoded nil ! "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-correct-stripped-uucode nil ! "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-save-in-digest nil "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. ! If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - ! no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them." :group 'gnus-extract :type 'boolean) ! (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" "^Summary:" "^References:") "List of regexps to match headers included in digested messages. *************** *** 371,377 **** "p" gnus-uu-decode-postscript "P" gnus-uu-decode-postscript-and-save) ! (gnus-define-keys (gnus-uu-extract-view-map "v" gnus-uu-extract-map) "u" gnus-uu-decode-uu-view "U" gnus-uu-decode-uu-and-save-view --- 371,377 ---- "p" gnus-uu-decode-postscript "P" gnus-uu-decode-postscript-and-save) ! (gnus-define-keys (gnus-uu-extract-view-map "v" gnus-uu-extract-map) "u" gnus-uu-decode-uu-view "U" gnus-uu-decode-uu-and-save-view *************** *** 421,427 **** "Saves the current article." (interactive (list current-prefix-arg ! (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") --- 421,427 ---- "Saves the current article." (interactive (list current-prefix-arg ! (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") *************** *** 438,449 **** (read-file-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) ! (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (&optional n) ! "Uudecodes and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) --- 438,449 ---- (read-file-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) ! (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (&optional n) ! "Uudecodes and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) *************** *** 491,497 **** (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) ! (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) --- 491,497 ---- (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) ! (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) *************** *** 528,534 **** (setq fs (cdr fs)))) (unless subject (setq subject "Digested Articles")) ! (unless from (setq from (if (gnus-news-group-p gnus-newsgroup-name) gnus-newsgroup-name --- 528,534 ---- (setq fs (cdr fs)))) (unless subject (setq subject "Digested Articles")) ! (unless from (setq from (if (gnus-news-group-p gnus-newsgroup-name) gnus-newsgroup-name *************** *** 603,614 **** "Set the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max))) ! (defun gnus-uu-unmark-buffer () "Remove the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max) t)) ! (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) --- 603,614 ---- "Set the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max))) ! (defun gnus-uu-unmark-buffer () "Remove the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max) t)) ! (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) *************** *** 668,677 **** (setq gnus-newsgroup-processable nil) (save-excursion (while marked ! (and (vectorp (setq headers (gnus-summary-article-header (car marked)))) (setq subject (mail-header-subject headers) ! articles (gnus-uu-find-articles-matching (gnus-uu-reginize-string subject)) total (nconc total articles))) (while articles --- 668,677 ---- (setq gnus-newsgroup-processable nil) (save-excursion (while marked ! (and (vectorp (setq headers (gnus-summary-article-header (car marked)))) (setq subject (mail-header-subject headers) ! articles (gnus-uu-find-articles-matching (gnus-uu-reginize-string subject)) total (nconc total articles))) (while articles *************** *** 699,705 **** (setq data (cdr data))))) (gnus-summary-position-point)) ! ;; All PostScript functions written by Erik Selberg . (defun gnus-uu-decode-postscript (&optional n) "Gets postscript of the current article." --- 699,705 ---- (setq data (cdr data))))) (gnus-summary-position-point)) ! ;; All PostScript functions written by Erik Selberg . (defun gnus-uu-decode-postscript (&optional n) "Gets postscript of the current article." *************** *** 720,726 **** (read-file-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) --- 720,726 ---- (read-file-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) *************** *** 736,742 **** ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save not-insert scan cdir) (gnus-uu-initialize scan) (when save --- 736,742 ---- ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save not-insert scan cdir) (gnus-uu-initialize scan) (when save *************** *** 770,776 **** out) (when (file-directory-p file) (setq out (nconc (gnus-uu-scan-directory file t) out))))) ! (if rec out (nreverse out)))) --- 770,776 ---- out) (when (file-directory-p file) (setq out (nconc (gnus-uu-scan-directory file t) out))))) ! (if rec out (nreverse out)))) *************** *** 799,812 **** ;; Function called by gnus-uu-grab-articles to treat each article. (defun gnus-uu-save-article (buffer in-state) ! (cond (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) (gnus-write-buffer (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ! ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) --- 799,812 ---- ;; Function called by gnus-uu-grab-articles to treat each article. (defun gnus-uu-save-article (buffer in-state) ! (cond (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) (gnus-write-buffer (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ! ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) *************** *** 815,821 **** (set-buffer buffer) (write-region (point-min) (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ! ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) --- 815,821 ---- (set-buffer buffer) (write-region (point-min) (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ! ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) *************** *** 829,842 **** beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) ! (progn (setq state (list 'begin)) (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) (erase-buffer)) ! (save-excursion (set-buffer (get-buffer-create "*gnus-uu-pre*")) (erase-buffer) ! (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" (current-time-string) name name)))) (when (not (eq in-state 'end)) --- 829,842 ---- beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) ! (progn (setq state (list 'begin)) (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) (erase-buffer)) ! (save-excursion (set-buffer (get-buffer-create "*gnus-uu-pre*")) (erase-buffer) ! (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" (current-time-string) name name)))) (when (not (eq in-state 'end)) *************** *** 869,877 **** (setq headers (cdr headers)) (goto-char (point-min)) (while (re-search-forward headline nil t) ! (setq sorthead (concat sorthead ! (buffer-substring (match-beginning 0) (or (and (re-search-forward "^[^ \t]" nil t) (1- (point))) --- 869,877 ---- (setq headers (cdr headers)) (goto-char (point-min)) (while (re-search-forward headline nil t) ! (setq sorthead (concat sorthead ! (buffer-substring (match-beginning 0) (or (and (re-search-forward "^[^ \t]" nil t) (1- (point))) *************** *** 883,889 **** (goto-char beg) (when (re-search-forward "^Subject: \\(.*\\)$" nil t) (setq subj (buffer-substring (match-beginning 1) (match-end 1))) ! (save-excursion (set-buffer (get-buffer "*gnus-uu-pre*")) (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) --- 883,889 ---- (goto-char beg) (when (re-search-forward "^Subject: \\(.*\\)$" nil t) (setq subj (buffer-substring (match-beginning 1) (match-end 1))) ! (save-excursion (set-buffer (get-buffer "*gnus-uu-pre*")) (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) *************** *** 895,901 **** (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (point-max)) ! (insert (concat (setq end-string (format "End of %s Digest" name)) "\n")) (insert (concat (make-string (length end-string) ?*) "\n")) --- 895,901 ---- (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (point-max)) ! (insert (concat (setq end-string (format "End of %s Digest" name)) "\n")) (insert (concat (make-string (length end-string) ?*) "\n")) *************** *** 908,918 **** (cons gnus-uu-saved-article-name state) state))))) ! ;; Binhex treatment - not very advanced. ! (defconst gnus-uu-binhex-body-line "^[^:]...............................................................$") ! (defconst gnus-uu-binhex-begin-line "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") --- 908,918 ---- (cons gnus-uu-saved-article-name state) state))))) ! ;; Binhex treatment - not very advanced. ! (defconst gnus-uu-binhex-body-line "^[^:]...............................................................$") ! (defconst gnus-uu-binhex-begin-line "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") *************** *** 937,943 **** (write-region 1 1 gnus-uu-binhex-article-name)) (setq state (list 'middle))) (goto-char (point-max)) ! (re-search-backward (concat gnus-uu-binhex-body-line "\\|" gnus-uu-binhex-end-line) nil t) (when (looking-at gnus-uu-binhex-end-line) --- 937,943 ---- (write-region 1 1 gnus-uu-binhex-article-name)) (setq state (list 'middle))) (goto-char (point-max)) ! (re-search-backward (concat gnus-uu-binhex-body-line "\\|" gnus-uu-binhex-end-line) nil t) (when (looking-at gnus-uu-binhex-end-line) *************** *** 974,980 **** (write-region (point-min) (point-max) file-name) (setq state (list file-name 'begin 'end))))) state)) ! ;; Find actions. --- 974,980 ---- (write-region (point-min) (point-max) file-name) (setq state (list file-name 'begin 'end))))) state)) ! ;; Find actions. *************** *** 983,989 **** action name) (while files (setq name (cdr (assq 'name (car files)))) ! (and (setq action (gnus-uu-get-action name)) (setcar files (nconc (list (if (string= action "gnus-uu-archive") (cons 'action "file") --- 983,989 ---- action name) (while files (setq name (cdr (assq 'name (car files)))) ! (and (setq action (gnus-uu-get-action name)) (setcar files (nconc (list (if (string= action "gnus-uu-archive") (cons 'action "file") *************** *** 996,1013 **** (defun gnus-uu-get-action (file-name) (let (action) ! (setq action ! (gnus-uu-choose-action file-name ! (append gnus-uu-user-view-rules ! (if gnus-uu-ignore-default-view-rules ! nil gnus-uu-default-view-rules) gnus-uu-user-view-rules-end))) (when (and (not (string= (or action "") "gnus-uu-archive")) gnus-uu-view-with-metamail) ! (when (setq action (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) --- 996,1013 ---- (defun gnus-uu-get-action (file-name) (let (action) ! (setq action ! (gnus-uu-choose-action file-name ! (append gnus-uu-user-view-rules ! (if gnus-uu-ignore-default-view-rules ! nil gnus-uu-default-view-rules) gnus-uu-user-view-rules-end))) (when (and (not (string= (or action "") "gnus-uu-archive")) gnus-uu-view-with-metamail) ! (when (setq action (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) *************** *** 1050,1056 **** (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" nil t) (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) ! (goto-char beg) (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]*" t t)) --- 1050,1056 ---- (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" nil t) (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) ! (goto-char beg) (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]*" t t)) *************** *** 1061,1071 **** ;; If N is non-nil, the article numbers of the N next articles ;; will be returned. ;; If any articles have been marked as processable, they will be ! ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. (let (articles) ! (cond (n (setq n (prefix-numeric-value n)) (let ((backward (< n 0)) --- 1061,1071 ---- ;; If N is non-nil, the article numbers of the N next articles ;; will be returned. ;; If any articles have been marked as processable, they will be ! ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. (let (articles) ! (cond (n (setq n (prefix-numeric-value n)) (let ((backward (< n 0)) *************** *** 1085,1097 **** (defun gnus-uu-string< (l1 l2) (string< (car l1) (car l2))) ! (defun gnus-uu-find-articles-matching (&optional subject only-unread do-not-translate) ;; Finds all articles that matches the regexp SUBJECT. If it is ;; nil, the current article name will be used. If ONLY-UNREAD is ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is ;; non-nil, article names are not equalized before sorting. ! (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-article-subject)))) list-of-subjects) (save-excursion --- 1085,1097 ---- (defun gnus-uu-string< (l1 l2) (string< (car l1) (car l2))) ! (defun gnus-uu-find-articles-matching (&optional subject only-unread do-not-translate) ;; Finds all articles that matches the regexp SUBJECT. If it is ;; nil, the current article name will be used. If ONLY-UNREAD is ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is ;; non-nil, article names are not equalized before sorting. ! (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-article-subject)))) list-of-subjects) (save-excursion *************** *** 1117,1123 **** ;; Expand numbers, sort, and return the list of article ;; numbers. (mapcar (lambda (sub) (cdr sub)) ! (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) 'gnus-uu-string<)))))) --- 1117,1123 ---- ;; Expand numbers, sort, and return the list of article ;; numbers. (mapcar (lambda (sub) (cdr sub)) ! (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) 'gnus-uu-string<)))))) *************** *** 1142,1156 **** (replace-match " ")) ;; Translate all characters to "a". (goto-char (point-min)) ! (when translate (while (re-search-forward "[A-Za-z]" nil t) (replace-match "a" t t))) ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) ! (replace-match ! (format "%06d" ! (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) (setq string (buffer-substring 1 (point-max))) (setcar (car string-list) string) --- 1142,1156 ---- (replace-match " ")) ;; Translate all characters to "a". (goto-char (point-min)) ! (when translate (while (re-search-forward "[A-Za-z]" nil t) (replace-match "a" t t))) ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) ! (replace-match ! (format "%06d" ! (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) (setq string (buffer-substring 1 (point-max))) (setcar (car string-list) string) *************** *** 1199,1209 **** (setq gnus-uu-has-been-grabbed (list art)))))) ;; This function takes a list of articles and a function to apply to ! ;; each article grabbed. ! ;; ;; This function returns a list of files decoded if the grabbing and ;; the process-function has been successful and nil otherwise. ! (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) (gnus-asynchronous nil) --- 1199,1209 ---- (setq gnus-uu-has-been-grabbed (list art)))))) ;; This function takes a list of articles and a function to apply to ! ;; each article grabbed. ! ;; ;; This function returns a list of files decoded if the grabbing and ;; the process-function has been successful and nil otherwise. ! (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) (gnus-asynchronous nil) *************** *** 1211,1218 **** gnus-summary-display-article-function gnus-article-display-hook gnus-article-prepare-hook article-series files) ! ! (while (and articles (not (memq 'error process-state)) (or sloppy (not (memq 'end process-state)))) --- 1211,1218 ---- gnus-summary-display-article-function gnus-article-display-hook gnus-article-prepare-hook article-series files) ! ! (while (and articles (not (memq 'error process-state)) (or sloppy (not (memq 'end process-state)))) *************** *** 1220,1248 **** (setq article (pop articles)) (push article article-series) ! (unless articles (if (eq state 'first) (setq state 'first-and-last) (setq state 'last))) (let ((part (gnus-uu-part-number article))) ! (gnus-message 6 "Getting article %d%s..." article (if (string= part "") "" (concat ", " part)))) (gnus-summary-display-article article) ! ;; Push the article to the processing function. (save-excursion (set-buffer gnus-original-article-buffer) (let ((buffer-read-only nil)) (save-excursion (set-buffer gnus-summary-buffer) ! (setq process-state (funcall process-function gnus-original-article-buffer state))))) (gnus-summary-remove-process-mark article) ! ;; If this is the beginning of a decoded file, we push it ;; on to a list. (when (or (memq 'begin process-state) (and (or (eq state 'first) --- 1220,1248 ---- (setq article (pop articles)) (push article article-series) ! (unless articles (if (eq state 'first) (setq state 'first-and-last) (setq state 'last))) (let ((part (gnus-uu-part-number article))) ! (gnus-message 6 "Getting article %d%s..." article (if (string= part "") "" (concat ", " part)))) (gnus-summary-display-article article) ! ;; Push the article to the processing function. (save-excursion (set-buffer gnus-original-article-buffer) (let ((buffer-read-only nil)) (save-excursion (set-buffer gnus-summary-buffer) ! (setq process-state (funcall process-function gnus-original-article-buffer state))))) (gnus-summary-remove-process-mark article) ! ;; If this is the beginning of a decoded file, we push it ;; on to a list. (when (or (memq 'begin process-state) (and (or (eq state 'first) *************** *** 1251,1257 **** (when has-been-begin ;; If there is a `result-file' here, that means that the ;; file was unsuccessfully decoded, so we delete it. ! (when (and result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) --- 1251,1257 ---- (when has-been-begin ;; If there is a `result-file' here, that means that the ;; file was unsuccessfully decoded, so we delete it. ! (when (and result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) *************** *** 1292,1305 **** ;; the partially decoded file. (and (or (eq state 'last) (eq state 'first-and-last)) (not (memq 'end process-state)) ! result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) (delete-file result-file)) ! ;; If this was a file of the wrong sort, then (when (and (or (memq 'wrong-type process-state) (memq 'error process-state)) gnus-uu-unmark-articles-not-decoded) --- 1292,1305 ---- ;; the partially decoded file. (and (or (eq state 'last) (eq state 'first-and-last)) (not (memq 'end process-state)) ! result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) (delete-file result-file)) ! ;; If this was a file of the wrong sort, then (when (and (or (memq 'wrong-type process-state) (memq 'error process-state)) gnus-uu-unmark-articles-not-decoded) *************** *** 1355,1361 **** (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) (subject (and header (mail-header-subject header)))) ! (if (and subject (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) (match-string 0 subject) ""))) --- 1355,1361 ---- (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) (subject (and header (mail-header-subject header)))) ! (if (and subject (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) (match-string 0 subject) ""))) *************** *** 1368,1374 **** (save-excursion (set-buffer process-buffer) (let ((state (list 'wrong-type)) ! process-connection-type case-fold-search buffer-read-only files start-char) (goto-char (point-min)) --- 1368,1374 ---- (save-excursion (set-buffer process-buffer) (let ((state (list 'wrong-type)) ! process-connection-type case-fold-search buffer-read-only files start-char) (goto-char (point-min)) *************** *** 1389,1395 **** (setq state (list 'middle)) ;; This is the beginning of an uuencoded article. ;; We replace certain characters that could make things messy. ! (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) --- 1389,1395 ---- (setq state (list 'middle)) ;; This is the beginning of an uuencoded article. ;; We replace certain characters that could make things messy. ! (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) *************** *** 1414,1437 **** (progn (cd gnus-uu-work-dir) (setq gnus-uu-uudecode-process ! (start-process ! "*uudecode*" (get-buffer-create gnus-uu-output-buffer-name) shell-file-name shell-command-switch (format "cd %s %s uudecode" gnus-uu-work-dir gnus-shell-command-separator)))) (cd cdir))) ! (set-process-sentinel gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) (setq state (list 'begin)) (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) ! ;; We look for the end of the thing to be decoded. (if (re-search-forward gnus-uu-end-string nil t) (push 'end state) (goto-char (point-max)) (re-search-backward gnus-uu-body-line nil t)) ! (forward-line 1) (when gnus-uu-uudecode-process --- 1414,1437 ---- (progn (cd gnus-uu-work-dir) (setq gnus-uu-uudecode-process ! (start-process ! "*uudecode*" (get-buffer-create gnus-uu-output-buffer-name) shell-file-name shell-command-switch (format "cd %s %s uudecode" gnus-uu-work-dir gnus-shell-command-separator)))) (cd cdir))) ! (set-process-sentinel gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) (setq state (list 'begin)) (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) ! ;; We look for the end of the thing to be decoded. (if (re-search-forward gnus-uu-end-string nil t) (push 'end state) (goto-char (point-max)) (re-search-backward gnus-uu-body-line nil t)) ! (forward-line 1) (when gnus-uu-uudecode-process *************** *** 1444,1451 **** (condition-case nil (process-send-region gnus-uu-uudecode-process start-char (point)) ! (error ! (progn (delete-process gnus-uu-uudecode-process) (gnus-message 2 "gnus-uu: Couldn't uudecode") (setq state (list 'wrong-type))))) --- 1444,1451 ---- (condition-case nil (process-send-region gnus-uu-uudecode-process start-char (point)) ! (error ! (progn (delete-process gnus-uu-uudecode-process) (gnus-message 2 "gnus-uu: Couldn't uudecode") (setq state (list 'wrong-type))))) *************** *** 1479,1489 **** (setq state (list 'wrong-type)) (beginning-of-line) (setq start-char (point)) ! (call-process-region ! start-char (point-max) shell-file-name nil ! (get-buffer-create gnus-uu-output-buffer-name) nil ! shell-command-switch ! (concat "cd " gnus-uu-work-dir " " gnus-shell-command-separator " sh")))) state)) --- 1479,1489 ---- (setq state (list 'wrong-type)) (beginning-of-line) (setq start-char (point)) ! (call-process-region ! start-char (point-max) shell-file-name nil ! (get-buffer-create gnus-uu-output-buffer-name) nil ! shell-command-switch ! (concat "cd " gnus-uu-work-dir " " gnus-shell-command-separator " sh")))) state)) *************** *** 1504,1518 **** (let ((action-list (copy-sequence file-action-list)) (case-fold-search t) rule action) ! (and ! (unless no-ignore ! (and (not (and gnus-uu-ignore-files-by-name (string-match gnus-uu-ignore-files-by-name file-name))) ! (not (and gnus-uu-ignore-files-by-type ! (string-match gnus-uu-ignore-files-by-type ! (or (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list t) "")))))) (while (not (or (eq action-list ()) action)) --- 1504,1518 ---- (let ((action-list (copy-sequence file-action-list)) (case-fold-search t) rule action) ! (and ! (unless no-ignore ! (and (not (and gnus-uu-ignore-files-by-name (string-match gnus-uu-ignore-files-by-name file-name))) ! (not (and gnus-uu-ignore-files-by-type ! (string-match gnus-uu-ignore-files-by-type ! (or (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list t) "")))))) (while (not (or (eq action-list ()) action)) *************** *** 1526,1532 **** ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) action command dir) ! (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules nil --- 1526,1532 ---- ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) action command dir) ! (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules nil *************** *** 1549,1555 **** (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) ! (if (= 0 (call-process shell-file-name nil (get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") --- 1549,1555 ---- (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) ! (if (= 0 (call-process shell-file-name nil (get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") *************** *** 1572,1578 **** files)) (defun gnus-uu-unpack-files (files &optional ignore) ! ;; Go through FILES and look for files to unpack. (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) file did-unpack) --- 1572,1578 ---- files)) (defun gnus-uu-unpack-files (files &optional ignore) ! ;; Go through FILES and look for files to unpack. (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) file did-unpack) *************** *** 1594,1600 **** (setq nfiles (cdr nfiles))) (setq totfiles newfiles))) (setq files (cdr files))) ! (if did-unpack (gnus-uu-unpack-files ofiles (append did-unpack ignore)) ofiles))) --- 1594,1600 ---- (setq nfiles (cdr nfiles))) (setq totfiles newfiles))) (setq files (cdr files))) ! (if did-unpack (gnus-uu-unpack-files ofiles (append did-unpack ignore)) ofiles))) *************** *** 1636,1644 **** (when (looking-at "\n") (replace-match "")) (forward-line 1)))) ! (while (not (eobp)) ! (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) () (when (not found) --- 1636,1644 ---- (when (looking-at "\n") (replace-match "")) (forward-line 1)))) ! (while (not (eobp)) ! (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) () (when (not found) *************** *** 1665,1679 **** (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) nil))) t ! (setq gnus-uu-tmp-dir (file-name-as-directory (expand-file-name gnus-uu-tmp-dir))) (if (not (file-directory-p gnus-uu-tmp-dir)) (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) (when (not (file-writable-p gnus-uu-tmp-dir)) ! (error "Temp directory %s can't be written to" gnus-uu-tmp-dir))) ! (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (gnus-make-directory gnus-uu-work-dir) (set-file-modes gnus-uu-work-dir 448) --- 1665,1679 ---- (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) nil))) t ! (setq gnus-uu-tmp-dir (file-name-as-directory (expand-file-name gnus-uu-tmp-dir))) (if (not (file-directory-p gnus-uu-tmp-dir)) (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) (when (not (file-writable-p gnus-uu-tmp-dir)) ! (error "Temp directory %s can't be written to" gnus-uu-tmp-dir))) ! (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (gnus-make-directory gnus-uu-work-dir) (set-file-modes gnus-uu-work-dir 448) *************** *** 1750,1757 **** "Function used for encoding binary files. There are three functions supplied with gnus-uu for encoding files: `gnus-uu-post-encode-uuencode', which does straight uuencoding; ! `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME ! headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with uuencode and adds MIME headers." :group 'gnus-extract-post :type '(radio (function-item gnus-uu-post-encode-uuencode) --- 1750,1757 ---- "Function used for encoding binary files. There are three functions supplied with gnus-uu for encoding files: `gnus-uu-post-encode-uuencode', which does straight uuencoding; ! `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME ! headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with uuencode and adds MIME headers." :group 'gnus-extract-post :type '(radio (function-item gnus-uu-post-encode-uuencode) *************** *** 1777,1783 **** "Non-nil means that gnus-uu will post the encoded file in a thread. This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen ! one package that does that - gnus-uu, but somehow, I don't think that counts...) Default is nil." :group 'gnus-extract-post :type 'boolean) --- 1777,1783 ---- "Non-nil means that gnus-uu will post the encoded file in a thread. This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen ! one package that does that - gnus-uu, but somehow, I don't think that counts...) Default is nil." :group 'gnus-extract-post :type 'boolean) *************** *** 1785,1792 **** (defcustom gnus-uu-post-separate-description t "Non-nil means that the description will be posted in a separate article. The first article will typically be numbered (0/x). If this variable ! is nil, the description the user enters will be included at the ! beginning of the first article, which will be numbered (1/x). Default is t." :group 'gnus-extract-post :type 'boolean) --- 1785,1792 ---- (defcustom gnus-uu-post-separate-description t "Non-nil means that the description will be posted in a separate article. The first article will typically be numbered (0/x). If this variable ! is nil, the description the user enters will be included at the ! beginning of the first article, which will be numbered (1/x). Default is t." :group 'gnus-extract-post :type 'boolean) *************** *** 1809,1824 **** (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) ! (when gnus-uu-post-include-before-composing ! (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) ! (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) ;; Encodes with uuencode and substitutes all spaces with backticks. --- 1809,1824 ---- (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) ! (when gnus-uu-post-include-before-composing ! (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) ! (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) ;; Encodes with uuencode and substitutes all spaces with backticks. *************** *** 1845,1851 **** ;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) (goto-char (point-min)) ! (insert (format "Content-Type: %s; name=\"%s\"\n" (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) --- 1845,1851 ---- ;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) (goto-char (point-min)) ! (insert (format "Content-Type: %s; name=\"%s\"\n" (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) *************** *** 1863,1869 **** ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) ! (= 0 (call-process shell-file-name nil t nil shell-command-switch (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () --- 1863,1869 ---- ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) ! (= 0 (call-process shell-file-name nil t nil shell-command-switch (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () *************** *** 1876,1884 **** (if gnus-uu-post-inserted-file-name (setq file-name gnus-uu-post-inserted-file-name) (setq file-name (gnus-uu-post-insert-binary))) ! (if gnus-uu-post-threaded ! (let ((message-required-news-headers (if (memq 'Message-ID message-required-news-headers) message-required-news-headers (cons 'Message-ID message-required-news-headers))) --- 1876,1884 ---- (if gnus-uu-post-inserted-file-name (setq file-name gnus-uu-post-inserted-file-name) (setq file-name (gnus-uu-post-insert-binary))) ! (if gnus-uu-post-threaded ! (let ((message-required-news-headers (if (memq 'Message-ID message-required-news-headers) message-required-news-headers (cons 'Message-ID message-required-news-headers))) *************** *** 1892,1899 **** (save-excursion (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) ! (setq gnus-uu-post-message-id ! (buffer-substring (match-beginning 1) (match-end 1))) (setq gnus-uu-post-message-id nil)))) gnus-inews-article-hook) --- 1892,1899 ---- (save-excursion (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) ! (setq gnus-uu-post-message-id ! (buffer-substring (match-beginning 1) (match-end 1))) (setq gnus-uu-post-message-id nil)))) gnus-inews-article-hook) *************** *** 1902,1922 **** (setq gnus-uu-post-inserted-file-name nil) (when gnus-uu-winconf-post-news (set-window-configuration gnus-uu-winconf-post-news))) ! ;; Asks for a file to encode, encodes it and inserts the result in ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") file-path uubuf file-name) ! (setq file-path (read-file-name "What file do you want to encode? ")) (when (not (file-exists-p file-path)) (error "%s: No such file" file-path)) (goto-char (point-max)) (insert (format "\n%s\n" gnus-uu-post-binary-separator)) ! (when (string-match "^~/" file-path) (setq file-path (concat "$HOME" (substring file-path 1)))) (if (string-match "/[^/]*$" file-path) --- 1902,1922 ---- (setq gnus-uu-post-inserted-file-name nil) (when gnus-uu-winconf-post-news (set-window-configuration gnus-uu-winconf-post-news))) ! ;; Asks for a file to encode, encodes it and inserts the result in ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") file-path uubuf file-name) ! (setq file-path (read-file-name "What file do you want to encode? ")) (when (not (file-exists-p file-path)) (error "%s: No such file" file-path)) (goto-char (point-max)) (insert (format "\n%s\n" gnus-uu-post-binary-separator)) ! (when (string-match "^~/" file-path) (setq file-path (concat "$HOME" (substring file-path 1)))) (if (string-match "/[^/]*$" file-path) *************** *** 1925,1931 **** (unwind-protect (if (save-excursion ! (set-buffer (setq uubuf (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) --- 1925,1931 ---- (unwind-protect (if (save-excursion ! (set-buffer (setq uubuf (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) *************** *** 1946,1953 **** (setq post-buf (current-buffer)) (goto-char (point-min)) ! (when (not (re-search-forward ! (if gnus-uu-post-separate-description (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") (concat "^" (regexp-quote mail-header-separator) "$")) --- 1946,1953 ---- (setq post-buf (current-buffer)) (goto-char (point-min)) ! (when (not (re-search-forward ! (if gnus-uu-post-separate-description (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") (concat "^" (regexp-quote mail-header-separator) "$")) *************** *** 1958,1964 **** (setq beg-binary (point)) (setq end-binary (point-max)) ! (save-excursion (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) --- 1958,1964 ---- (setq beg-binary (point)) (setq end-binary (point-max)) ! (save-excursion (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) *************** *** 1973,1979 **** (kill-region (point) (point-max)) (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (setq header (buffer-substring 1 (point))) --- 1973,1979 ---- (kill-region (point) (point-max)) (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (setq header (buffer-substring 1 (point))) *************** *** 2000,2011 **** (- 62 (length (format top-string "" file-name i parts "")))) (when (> 1 (setq minlen (/ whole-len 2))) (setq minlen 1)) ! (setq ! beg-line (format top-string (make-string minlen ?-) file-name i parts ! (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) (goto-char (point-min)) --- 2000,2011 ---- (- 62 (length (format top-string "" file-name i parts "")))) (when (> 1 (setq minlen (/ whole-len 2))) (setq minlen 1)) ! (setq ! beg-line (format top-string (make-string minlen ?-) file-name i parts ! (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) (goto-char (point-min)) *************** *** 2018,2024 **** (when (or (and (= i 2) gnus-uu-post-separate-description) (and (= i 1) (not gnus-uu-post-separate-description))) (replace-match "Subject: Re: ")))) ! (goto-char (point-max)) (save-excursion (set-buffer uubuf) --- 2018,2024 ---- (when (or (and (= i 2) gnus-uu-post-separate-description) (and (= i 1) (not gnus-uu-post-separate-description))) (replace-match "Subject: Re: ")))) ! (goto-char (point-max)) (save-excursion (set-buffer uubuf) *************** *** 2039,2045 **** (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) ! (when (re-search-forward (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") nil t) (replace-match "") --- 2039,2045 ---- (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) ! (when (re-search-forward (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") nil t) (replace-match "") *** pub/rgnus/lisp/gnus-vm.el Thu Jan 9 11:59:36 1997 --- rgnus/lisp/gnus-vm.el Fri Mar 7 23:51:25 1997 *************** *** 23,31 **** ;;; Commentary: ! ;; Major contributors: ;; Christian Limpach ! ;; Some code stolen from: ;; Rick Sladkey ;;; Code: --- 23,31 ---- ;;; Commentary: ! ;; Major contributors: ;; Christian Limpach ! ;; Some code stolen from: ;; Rick Sladkey ;;; Code: *************** *** 74,80 **** (insert "\n") (vm-mode) tmp-folder)) ! (defun gnus-summary-save-article-vm (&optional arg) "Append the current article to a vm folder. If N is a positive number, save the N next articles. --- 74,80 ---- (insert "\n") (vm-mode) tmp-folder)) ! (defun gnus-summary-save-article-vm (&optional arg) "Append the current article to a vm folder. If N is a positive number, save the N next articles. *************** *** 93,99 **** (setq folder (cond ((eq folder 'default) default-name) (folder folder) ! (t (gnus-read-save-file-name "Save %s in VM folder:" default-name)))) (gnus-make-directory (file-name-directory folder)) (set-buffer gnus-original-article-buffer) --- 93,99 ---- (setq folder (cond ((eq folder 'default) default-name) (folder folder) ! (t (gnus-read-save-file-name "Save %s in VM folder:" default-name)))) (gnus-make-directory (file-name-directory folder)) (set-buffer gnus-original-article-buffer) *** pub/rgnus/lisp/gnus-win.el Thu Jan 9 11:59:36 1997 --- rgnus/lisp/gnus-win.el Fri Mar 7 23:51:26 1997 *************** *** 64,71 **** (summary 1.0 point) (if gnus-carpal '(summary-carpal 4)))) (article ! (cond ! ((and gnus-use-picons (eq gnus-picons-display-where 'picons)) '(frame 1.0 (vertical 1.0 --- 64,71 ---- (summary 1.0 point) (if gnus-carpal '(summary-carpal 4)))) (article ! (cond ! ((and gnus-use-picons (eq gnus-picons-display-where 'picons)) '(frame 1.0 (vertical 1.0 *************** *** 198,204 **** "Kill all frames Gnus has created." (while gnus-created-frames (when (frame-live-p (car gnus-created-frames)) ! ;; We slap a condition-case around this `delete-frame' to ensure ;; against errors if we try do delete the single frame that's left. (ignore-errors (delete-frame (car gnus-created-frames)))) --- 198,204 ---- "Kill all frames Gnus has created." (while gnus-created-frames (when (frame-live-p (car gnus-created-frames)) ! ;; We slap a condition-case around this `delete-frame' to ensure ;; against errors if we try do delete the single frame that's left. (ignore-errors (delete-frame (car gnus-created-frames)))) *************** *** 225,231 **** (memq setting '(group summary article))))) setting (let* ((elem ! (cond ((eq setting 'group) (gnus-window-configuration-element '(group newsgroups ExitNewsgroup))) --- 225,231 ---- (memq setting '(group summary article))))) setting (let* ((elem ! (cond ((eq setting 'group) (gnus-window-configuration-element '(group newsgroups ExitNewsgroup))) *************** *** 417,423 **** ;; We want to remove all other windows. (if (not gnus-frame-split-p) ;; This is not a `frame' split, so we ignore the ! ;; other frames. (delete-other-windows) ;; This is a `frame' split, so we delete all windows ;; on all frames. --- 417,423 ---- ;; We want to remove all other windows. (if (not gnus-frame-split-p) ;; This is not a `frame' split, so we ignore the ! ;; other frames. (delete-other-windows) ;; This is a `frame' split, so we delete all windows ;; on all frames. *************** *** 439,448 **** (when (and (boundp (cdr elem)) (symbol-value (cdr elem))) (get-buffer (symbol-value (cdr elem)))) ! (when (cdr elem) (get-buffer (cdr elem))))) gnus-window-to-buffer))) ! (mapcar (lambda (frame) (unless (eq (cdr (assq 'minibuffer (frame-parameters frame))) --- 439,448 ---- (when (and (boundp (cdr elem)) (symbol-value (cdr elem))) (get-buffer (symbol-value (cdr elem)))) ! (when (cdr elem) (get-buffer (cdr elem))))) gnus-window-to-buffer))) ! (mapcar (lambda (frame) (unless (eq (cdr (assq 'minibuffer (frame-parameters frame))) *** pub/rgnus/lisp/gnus-xmas.el Sun Mar 2 04:47:17 1997 --- rgnus/lisp/gnus-xmas.el Fri Mar 7 23:51:26 1997 *************** *** 120,126 **** (if (stringp buffer) nil (map-extents (lambda (extent ignored) ! (remove-text-properties start end (list (extent-property extent 'text-prop) nil) buffer)) --- 120,126 ---- (if (stringp buffer) nil (map-extents (lambda (extent ignored) ! (remove-text-properties start end (list (extent-property extent 'text-prop) nil) buffer)) *************** *** 132,138 **** (when gnus-summary-selected-face (when gnus-newsgroup-selected-overlay (delete-extent gnus-newsgroup-selected-overlay)) ! (setq gnus-newsgroup-selected-overlay (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay gnus-summary-selected-face))) --- 132,138 ---- (when gnus-summary-selected-face (when gnus-newsgroup-selected-overlay (delete-extent gnus-newsgroup-selected-overlay)) ! (setq gnus-newsgroup-selected-overlay (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay gnus-summary-selected-face))) *************** *** 195,201 **** (map-extents (lambda (extent arg) (set-extent-property extent 'start-open t)) nil point (min (1+ (point)) (point-max)))) ! (defun gnus-xmas-article-push-button (event) "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, --- 195,201 ---- (map-extents (lambda (extent arg) (set-extent-property extent 'start-open t)) nil point (min (1+ (point)) (point-max)))) ! (defun gnus-xmas-article-push-button (event) "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, *************** *** 217,223 **** (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face --- 217,223 ---- (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face *************** *** 255,262 **** (window-search t)) (while window-search (let* ((this-window (next-window)) ! (next-bottom-edge (car (cdr (cdr (cdr ! (window-pixel-edges this-window))))))) (when (< bottom-edge next-bottom-edge) (setq bottom-edge next-bottom-edge) --- 255,262 ---- (window-search t)) (while window-search (let* ((this-window (next-window)) ! (next-bottom-edge (car (cdr (cdr (cdr ! (window-pixel-edges this-window))))))) (when (< bottom-edge next-bottom-edge) (setq bottom-edge next-bottom-edge) *************** *** 332,354 **** (button-press-event-p event))) (dispatch-event event) (setq event (next-command-event))) ! (cons (and (key-press-event-p event) ! (event-to-character event)) event))) (defun gnus-xmas-group-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) (remove-text-properties (1+ beg) end '(gnus-group nil)) ! (remove-text-properties ! beg end '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil)) (goto-char end) ! (map-extents (lambda (e ma) (set-extent-property e 'start-closed t)) (current-buffer) beg end))) ! (defun gnus-xmas-topic-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) --- 332,354 ---- (button-press-event-p event))) (dispatch-event event) (setq event (next-command-event))) ! (cons (and (key-press-event-p event) ! (event-to-character event)) event))) (defun gnus-xmas-group-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) (remove-text-properties (1+ beg) end '(gnus-group nil)) ! (remove-text-properties ! beg end '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil)) (goto-char end) ! (map-extents (lambda (e ma) (set-extent-property e 'start-closed t)) (current-buffer) beg end))) ! (defun gnus-xmas-topic-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) *************** *** 365,373 **** (aref (timezone-parse-date date) 3)))) (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date "Jan 1 12:00:00 1970"))) ! (tday (- (timezone-absolute-from-gregorian (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) ! (timezone-absolute-from-gregorian (nth 1 edate) (nth 2 edate) (nth 0 edate))))) (+ (nth 2 ttime) (* (nth 1 ttime) 60) --- 365,373 ---- (aref (timezone-parse-date date) 3)))) (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date "Jan 1 12:00:00 1970"))) ! (tday (- (timezone-absolute-from-gregorian (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) ! (timezone-absolute-from-gregorian (nth 1 edate) (nth 2 edate) (nth 0 edate))))) (+ (nth 2 ttime) (* (nth 1 ttime) 60) *************** *** 401,407 **** (fset 'gnus-extent-detached-p 'extent-detached-p) (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) ! (require 'text-props) (if (and (<= emacs-major-version 19) (< emacs-minor-version 14)) --- 401,407 ---- (fset 'gnus-extent-detached-p 'extent-detached-p) (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) ! (require 'text-props) (if (and (<= emacs-major-version 19) (< emacs-minor-version 14)) *************** *** 419,430 **** (defun encode-time (sec minute hour day month year &optional zone) (let ((seconds (gnus-xmas-seconds-since-epoch ! (timezone-make-arpa-date year month day (timezone-make-time-string hour minute sec) zone)))) (list (floor (/ seconds (expt 2 16))) (round (mod seconds (expt 2 16))))))) ! (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) --- 419,430 ---- (defun encode-time (sec minute hour day month year &optional zone) (let ((seconds (gnus-xmas-seconds-since-epoch ! (timezone-make-arpa-date year month day (timezone-make-time-string hour minute sec) zone)))) (list (floor (/ seconds (expt 2 16))) (round (mod seconds (expt 2 16))))))) ! (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) *************** *** 432,438 **** (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) ! (fset 'gnus-x-color-values (if (fboundp 'x-color-values) 'x-color-values (lambda (color) --- 432,438 ---- (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) ! (fset 'gnus-x-color-values (if (fboundp 'x-color-values) 'x-color-values (lambda (color) *************** *** 451,457 **** (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) ! (fset 'gnus-appt-select-lowest-window 'gnus-xmas-appt-select-lowest-window) (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) (fset 'gnus-add-hook 'gnus-xmas-add-hook) --- 451,457 ---- (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) ! (fset 'gnus-appt-select-lowest-window 'gnus-xmas-appt-select-lowest-window) (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) (fset 'gnus-add-hook 'gnus-xmas-add-hook) *************** *** 460,466 **** 'gnus-xmas-mode-line-buffer-identification) (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) ! (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) --- 460,466 ---- 'gnus-xmas-mode-line-buffer-identification) (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) ! (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) *************** *** 502,512 **** (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (erase-buffer) (let ((logo (and gnus-xmas-glyph-directory ! (concat (file-name-as-directory gnus-xmas-glyph-directory) "gnus." (if (featurep 'xpm) "xpm" "xbm")))) ! (xpm-color-symbols (and (featurep 'xpm) (append `(("thing" ,(car gnus-xmas-logo-colors)) ("shadow" ,(cadr gnus-xmas-logo-colors))) --- 502,512 ---- (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (erase-buffer) (let ((logo (and gnus-xmas-glyph-directory ! (concat (file-name-as-directory gnus-xmas-glyph-directory) "gnus." (if (featurep 'xpm) "xpm" "xbm")))) ! (xpm-color-symbols (and (featurep 'xpm) (append `(("thing" ,(car gnus-xmas-logo-colors)) ("shadow" ,(cadr gnus-xmas-logo-colors))) *************** *** 532,556 **** (insert (format " %s ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! " "")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) --- 532,556 ---- (insert (format " %s ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! " "")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) *************** *** 565,571 **** (goto-char (point-min)) (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) (goto-char (point-min)) ! (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) (set-buffer-modified-p t))) --- 565,571 ---- (goto-char (point-min)) (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) (goto-char (point-min)) ! (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) (set-buffer-modified-p t))) *************** *** 580,592 **** `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") ! (defvar gnus-group-toolbar '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] ! [gnus-group-get-new-news-this-group gnus-group-get-new-news-this-group t "Get new news in this group"] ! [gnus-group-catchup-current gnus-group-catchup-current t "Catchup group"] ! [gnus-group-describe-group gnus-group-describe-group t "Describe group"] [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] --- 580,592 ---- `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") ! (defvar gnus-group-toolbar '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] ! [gnus-group-get-new-news-this-group gnus-group-get-new-news-this-group t "Get new news in this group"] ! [gnus-group-catchup-current gnus-group-catchup-current t "Catchup group"] ! [gnus-group-describe-group gnus-group-describe-group t "Describe group"] [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] *************** *** 595,615 **** ) "The group buffer toolbar.") ! (defvar gnus-summary-toolbar ! '([gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] ! [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] ! [gnus-summary-post-news gnus-summary-post-news t "Post an article"] [gnus-summary-followup-with-original ! gnus-summary-followup-with-original t "Post a followup and yank the original"] ! [gnus-summary-followup gnus-summary-followup t "Post a followup"] [gnus-summary-reply-with-original gnus-summary-reply-with-original t "Mail a reply and yank the original"] ! [gnus-summary-reply gnus-summary-reply t "Mail a reply"] [gnus-summary-caesar-message gnus-summary-caesar-message t "Rot 13"] --- 595,615 ---- ) "The group buffer toolbar.") ! (defvar gnus-summary-toolbar ! '([gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] ! [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] ! [gnus-summary-post-news gnus-summary-post-news t "Post an article"] [gnus-summary-followup-with-original ! gnus-summary-followup-with-original t "Post a followup and yank the original"] ! [gnus-summary-followup gnus-summary-followup t "Post a followup"] [gnus-summary-reply-with-original gnus-summary-reply-with-original t "Mail a reply and yank the original"] ! [gnus-summary-reply gnus-summary-reply t "Mail a reply"] [gnus-summary-caesar-message gnus-summary-caesar-message t "Rot 13"] *************** *** 619,625 **** gnus-summary-save-article-file t "Save article in file"] [gnus-summary-save-article gnus-summary-save-article t "Save article"] ! [gnus-uu-post-news gnus-uu-post-news t "Post an uuencoded article"] [gnus-summary-cancel-article gnus-summary-cancel-article t "Cancel article"] --- 619,625 ---- gnus-summary-save-article-file t "Save article in file"] [gnus-summary-save-article gnus-summary-save-article t "Save article"] ! [gnus-uu-post-news gnus-uu-post-news t "Post an uuencoded article"] [gnus-summary-cancel-article gnus-summary-cancel-article t "Cancel article"] *************** *** 633,641 **** (defvar gnus-summary-mail-toolbar '( ! [gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] ! [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] [gnus-summary-mail-reply gnus-summary-reply t "Reply"] ; [gnus-summary-mail-get gnus-mail-get t "Message get"] --- 633,641 ---- (defvar gnus-summary-mail-toolbar '( ! [gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] ! [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] [gnus-summary-mail-reply gnus-summary-reply t "Reply"] ; [gnus-summary-mail-get gnus-mail-get t "Message get"] *************** *** 699,705 **** (let (xface-glyph) (if (featurep 'xface) (setq xface-glyph ! (make-glyph (vector 'xface :data (concat "X-Face: " (buffer-substring beg end))))) (let ((cur (current-buffer))) --- 699,705 ---- (let (xface-glyph) (if (featurep 'xface) (setq xface-glyph ! (make-glyph (vector 'xface :data (concat "X-Face: " (buffer-substring beg end))))) (let ((cur (current-buffer))) *************** *** 717,737 **** (set-glyph-face xface-glyph 'gnus-x-face) (goto-char (point-min)) (re-search-forward "^From:" nil t) ! (set-extent-begin-glyph (make-extent (point) (1+ (point))) xface-glyph)))) ! (defvar gnus-xmas-pointer-glyph (progn (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (make-pointer-glyph (concat gnus-xmas-glyph-directory "gnus-pointer." (if (featurep 'xpm) "xpm" "xbm"))))) ! (defvar gnus-xmas-modeline-left-extent (let ((ext (copy-extent modeline-buffer-id-left-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) ! ! (defvar gnus-xmas-modeline-right-extent (let ((ext (copy-extent modeline-buffer-id-right-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) --- 717,737 ---- (set-glyph-face xface-glyph 'gnus-x-face) (goto-char (point-min)) (re-search-forward "^From:" nil t) ! (set-extent-begin-glyph (make-extent (point) (1+ (point))) xface-glyph)))) ! (defvar gnus-xmas-pointer-glyph (progn (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (make-pointer-glyph (concat gnus-xmas-glyph-directory "gnus-pointer." (if (featurep 'xpm) "xpm" "xbm"))))) ! (defvar gnus-xmas-modeline-left-extent (let ((ext (copy-extent modeline-buffer-id-left-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) ! ! (defvar gnus-xmas-modeline-right-extent (let ((ext (copy-extent modeline-buffer-id-right-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) *************** *** 761,767 **** ;; We have a standard line, so we colorize and glyphize it a bit. (t (setq chop (match-end 0)) ! (list (if gnus-xmas-modeline-glyph (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) --- 761,767 ---- ;; We have a standard line, so we colorize and glyphize it a bit. (t (setq chop (match-end 0)) ! (list (if gnus-xmas-modeline-glyph (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) *** pub/rgnus/lisp/gnus.el Fri Mar 7 07:37:01 1997 --- rgnus/lisp/gnus.el Fri Mar 7 23:51:27 1997 *************** *** 226,232 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.21" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) --- 226,232 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.4.22" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) *************** *** 308,314 **** ;; 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)) --- 308,314 ---- ;; 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)) *************** *** 330,336 **** ())) "Level 1 empty newsgroup face.") ! (defface gnus-group-news-2-face '((((class color) (background dark)) (:foreground "turquoise" :bold t)) --- 330,336 ---- ())) "Level 1 empty newsgroup face.") ! (defface gnus-group-news-2-face '((((class color) (background dark)) (:foreground "turquoise" :bold t)) *************** *** 352,358 **** ())) "Level 2 empty newsgroup face.") ! (defface gnus-group-news-3-face '((((class color) (background dark)) (:bold t)) --- 352,358 ---- ())) "Level 2 empty newsgroup face.") ! (defface gnus-group-news-3-face '((((class color) (background dark)) (:bold t)) *************** *** 374,380 **** ())) "Level 3 empty newsgroup face.") ! (defface gnus-group-news-low-face '((((class color) (background dark)) (:foreground "DarkTurquoise" :bold t)) --- 374,380 ---- ())) "Level 3 empty newsgroup face.") ! (defface gnus-group-news-low-face '((((class color) (background dark)) (:foreground "DarkTurquoise" :bold t)) *************** *** 396,402 **** ())) "Low level empty newsgroup face.") ! (defface gnus-group-mail-1-face '((((class color) (background dark)) (:foreground "aquamarine1" :bold t)) --- 396,402 ---- ())) "Low level empty newsgroup face.") ! (defface gnus-group-mail-1-face '((((class color) (background dark)) (:foreground "aquamarine1" :bold t)) *************** *** 418,424 **** (:italic t :bold t))) "Level 1 empty mailgroup face.") ! (defface gnus-group-mail-2-face '((((class color) (background dark)) (:foreground "aquamarine2" :bold t)) --- 418,424 ---- (:italic t :bold t))) "Level 1 empty mailgroup face.") ! (defface gnus-group-mail-2-face '((((class color) (background dark)) (:foreground "aquamarine2" :bold t)) *************** *** 440,446 **** (:bold t))) "Level 2 empty mailgroup face.") ! (defface gnus-group-mail-3-face '((((class color) (background dark)) (:foreground "aquamarine3" :bold t)) --- 440,446 ---- (:bold t))) "Level 2 empty mailgroup face.") ! (defface gnus-group-mail-3-face '((((class color) (background dark)) (:foreground "aquamarine3" :bold t)) *************** *** 462,468 **** ())) "Level 3 empty mailgroup face.") ! (defface gnus-group-mail-low-face '((((class color) (background dark)) (:foreground "aquamarine4" :bold t)) --- 462,468 ---- ())) "Level 3 empty mailgroup face.") ! (defface gnus-group-mail-low-face '((((class color) (background dark)) (:foreground "aquamarine4" :bold t)) *************** *** 486,496 **** ;; 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.") --- 486,496 ---- ;; 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.") *************** *** 502,508 **** (((class color) (background light)) (:foreground "firebrick" :bold t)) ! (t (:bold t))) "Face used for high interest ticked articles.") --- 502,508 ---- (((class color) (background light)) (:foreground "firebrick" :bold t)) ! (t (:bold t))) "Face used for high interest ticked articles.") *************** *** 513,519 **** (((class color) (background light)) (:foreground "firebrick" :italic t)) ! (t (:italic t))) "Face used for low interest ticked articles.") --- 513,519 ---- (((class color) (background light)) (:foreground "firebrick" :italic t)) ! (t (:italic t))) "Face used for low interest ticked articles.") *************** *** 524,533 **** (((class color) (background light)) (:foreground "firebrick")) ! (t ())) "Face used for normal interest ticked articles.") ! (defface gnus-summary-high-ancient-face '((((class color) (background dark)) --- 524,533 ---- (((class color) (background light)) (:foreground "firebrick")) ! (t ())) "Face used for normal interest ticked articles.") ! (defface gnus-summary-high-ancient-face '((((class color) (background dark)) *************** *** 535,541 **** (((class color) (background light)) (:foreground "RoyalBlue" :bold t)) ! (t (:bold t))) "Face used for high interest ancient articles.") --- 535,541 ---- (((class color) (background light)) (:foreground "RoyalBlue" :bold t)) ! (t (:bold t))) "Face used for high interest ancient articles.") *************** *** 546,552 **** (((class color) (background light)) (:foreground "RoyalBlue" :italic t)) ! (t (:italic t))) "Face used for low interest ancient articles.") --- 546,552 ---- (((class color) (background light)) (:foreground "RoyalBlue" :italic t)) ! (t (:italic t))) "Face used for low interest ancient articles.") *************** *** 557,581 **** (((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)) --- 557,581 ---- (((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)) *************** *** 585,591 **** (background light)) (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for high interest read articles.") --- 585,591 ---- (background light)) (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for high interest read articles.") *************** *** 598,604 **** (background light)) (:foreground "DarkGreen" :italic t)) ! (t (:italic t))) "Face used for low interest read articles.") --- 598,604 ---- (background light)) (:foreground "DarkGreen" :italic t)) ! (t (:italic t))) "Face used for low interest read articles.") *************** *** 609,615 **** (((class color) (background light)) (:foreground "DarkGreen")) ! (t ())) "Face used for normal interest read articles.") --- 609,615 ---- (((class color) (background light)) (:foreground "DarkGreen")) ! (t ())) "Face used for normal interest read articles.") *************** *** 621,627 **** (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) ! (defface gnus-splash-face '((((class color) (background dark)) (:foreground "red")) --- 621,627 ---- (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) ! (defface gnus-splash-face '((((class color) (background dark)) (:foreground "red")) *************** *** 797,807 **** :group 'gnus-server :type 'gnus-select-method) ! (defcustom gnus-message-archive-method `(nnfolder "archive" (nnfolder-directory ,(nnheader-concat message-directory "archive")) ! (nnfolder-active-file ,(nnheader-concat message-directory "archive/active")) (nnfolder-get-new-mail nil) (nnfolder-inhibit-expiry t)) --- 797,807 ---- :group 'gnus-server :type 'gnus-select-method) ! (defcustom gnus-message-archive-method `(nnfolder "archive" (nnfolder-directory ,(nnheader-concat message-directory "archive")) ! (nnfolder-active-file ,(nnheader-concat message-directory "archive/active")) (nnfolder-get-new-mail nil) (nnfolder-inhibit-expiry t)) *************** *** 825,833 **** If you want to save your mail in one group and the news articles you write in another group, you could say something like: ! \(setq gnus-message-archive-group '((if (message-news-p) ! \"misc-news\" \"misc-mail\"))) Normally the group names returned by this variable should be --- 825,833 ---- If you want to save your mail in one group and the news articles you write in another group, you could say something like: ! \(setq gnus-message-archive-group '((if (message-news-p) ! \"misc-news\" \"misc-mail\"))) Normally the group names returned by this variable should be *************** *** 1048,1054 **** :group 'gnus-meta :type '(choice (const :tag "off" nil) integer ! (sexp :format "all" :value t))) (defcustom gnus-use-nocem nil --- 1048,1054 ---- :group 'gnus-meta :type '(choice (const :tag "off" nil) integer ! (sexp :format "all" :value t))) (defcustom gnus-use-nocem nil *************** *** 1076,1082 **** :group 'gnus-meta :type 'boolean) ! (defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default." --- 1076,1082 ---- :group 'gnus-meta :type 'boolean) ! (defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default." *************** *** 1173,1179 **** (string :tag "Address") (editable-list :inline t (list :format "%v" ! variable (sexp :tag "Value"))))) (defcustom gnus-updated-mode-lines '(group article summary tree) --- 1173,1179 ---- (string :tag "Address") (editable-list :inline t (list :format "%v" ! variable (sexp :tag "Value"))))) (defcustom gnus-updated-mode-lines '(group article summary tree) *************** *** 1262,1269 **** ;;; Face thingies. ! (defcustom gnus-visual ! '(summary-highlight group-highlight article-highlight mouse-face summary-menu group-menu article-menu tree-highlight menu highlight --- 1262,1269 ---- ;;; Face thingies. ! (defcustom gnus-visual ! '(summary-highlight group-highlight article-highlight mouse-face summary-menu group-menu article-menu tree-highlight menu highlight *************** *** 1623,1629 **** ("gnus-picon" :interactive t gnus-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) ! ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) ("gnus-win" gnus-configure-windows gnus-add-configuration) --- 1623,1629 ---- ("gnus-picon" :interactive t gnus-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) ! ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) ("gnus-win" gnus-configure-windows gnus-add-configuration) *************** *** 1653,1659 **** 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 article-decode-rfc1522) ("gnus-int" gnus-request-type) --- 1653,1659 ---- 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 article-decode-rfc1522) ("gnus-int" gnus-request-type) *************** *** 1743,1749 **** (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) ! (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 (while keys (define-key keymap (pop keys) 'undefined)))) --- 1743,1749 ---- (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) ! (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 (while keys (define-key keymap (pop keys) 'undefined)))) *************** *** 1751,1757 **** (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) ! (defvar gnus-summary-mode-map (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) --- 1751,1757 ---- (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) ! (defvar gnus-summary-mode-map (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) *************** *** 1952,1958 **** (string-to-number (if (zerop major) (format "%s00%02d%02d" ! (cond ((member alpha '("(ding)" "d")) "4.99") ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03")) --- 1952,1958 ---- (string-to-number (if (zerop major) (format "%s00%02d%02d" ! (cond ((member alpha '("(ding)" "d")) "4.99") ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03")) *************** *** 2066,2072 **** (let ((method-name (symbol-name (car method)))) (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) (not (assq (intern (concat method-name "-address")) method)) ! (memq 'physical-address (assq (car method) gnus-valid-select-methods))) (append method (list (list (intern (concat method-name "-address")) (nth 1 method)))) --- 2066,2072 ---- (let ((method-name (symbol-name (car method)))) (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) (not (assq (intern (concat method-name "-address")) method)) ! (memq 'physical-address (assq (car method) gnus-valid-select-methods))) (append method (list (list (intern (concat method-name "-address")) (nth 1 method)))) *************** *** 2089,2095 **** (defun gnus-server-to-method (server) "Map virtual server names to select methods." ! (or ;; Is this a method, perhaps? (and server (listp server) server) ;; Perhaps this is the native server? --- 2089,2095 ---- (defun gnus-server-to-method (server) "Map virtual server names to select methods." ! (or ;; Is this a method, perhaps? (and server (listp server) server) ;; Perhaps this is the native server? *************** *** 2140,2146 **** (defun gnus-archive-server-wanted-p () "Say whether the user wants to use the archive server." ! (cond ((or (not gnus-message-archive-method) (not gnus-message-archive-group)) nil) --- 2140,2146 ---- (defun gnus-archive-server-wanted-p () "Say whether the user wants to use the archive server." ! (cond ((or (not gnus-message-archive-method) (not gnus-message-archive-group)) nil) *************** *** 2356,2362 **** (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." ! (cond ;; The global KILL file is placed at top of the directory. ((or (null newsgroup) (string-equal newsgroup "")) --- 2356,2362 ---- (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." ! (cond ;; The global KILL file is placed at top of the directory. ((or (null newsgroup) (string-equal newsgroup "")) *************** *** 2492,2498 **** prompt (append gnus-valid-select-methods gnus-predefined-server-alist gnus-server-alist) nil t nil 'gnus-method-history))) ! (cond ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods) --- 2492,2498 ---- prompt (append gnus-valid-select-methods gnus-predefined-server-alist gnus-server-alist) nil t nil 'gnus-method-history))) ! (cond ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods) *** pub/rgnus/lisp/lpath.el Fri Mar 7 07:37:02 1997 --- rgnus/lisp/lpath.el Fri Mar 7 23:51:27 1997 *************** *** 3,9 **** (defvar byte-compile-default-warnings) (defun maybe-fbind (args) ! (while args (or (fboundp (car args)) (fset (car args) 'ignore)) (setq args (cdr args)))) --- 3,9 ---- (defvar byte-compile-default-warnings) (defun maybe-fbind (args) ! (while args (or (fboundp (car args)) (fset (car args) 'ignore)) (setq args (cdr args)))) *************** *** 12,18 **** (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) (if (string-match "XEmacs" emacs-version) ! (progn (defvar track-mouse nil) (maybe-fbind '(posn-point event-start x-popup-menu --- 12,18 ---- (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) (if (string-match "XEmacs" emacs-version) ! (progn (defvar track-mouse nil) (maybe-fbind '(posn-point event-start x-popup-menu *************** *** 29,44 **** make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu ! )) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name ! gnus-newsgroup-name gnus-article-x-face-too-ugly)) ! ;; XEmacs thinks writting compatible code is obsolete. ! (require 'bytecomp) ! (setq byte-compile-default-warnings ! (delq 'obsolete byte-compile-default-warnings))) (defvar browse-url-browser-function nil) (maybe-fbind '(color-instance-rgb-components make-color-instance color-instance-name specifier-instance --- 29,40 ---- make-char-table set-char-table-range font-create-object x-color-values widget-make-intangible error-message-string w3-form-encode-xwfu ! )) (maybe-bind '(global-face-data mark-active transient-mark-mode mouse-selection-click-count mouse-selection-click-count-buffer buffer-display-table font-lock-defaults user-full-name user-login-name ! gnus-newsgroup-name gnus-article-x-face-too-ugly))) (defvar browse-url-browser-function nil) (maybe-fbind '(color-instance-rgb-components make-color-instance color-instance-name specifier-instance *** pub/rgnus/lisp/mailheader.el Mon Sep 9 19:35:46 1996 --- rgnus/lisp/mailheader.el Fri Mar 7 23:51:27 1997 *************** *** 62,68 **** (> (skip-chars-forward "^\0- :") 0) (= (following-char) ?:) (setq end (point)) ! (progn (forward-char) (> (skip-chars-forward " \t") 0))) (let ((header (intern (downcase (buffer-substring start end)))) (value (list (buffer-substring --- 62,68 ---- (> (skip-chars-forward "^\0- :") 0) (= (following-char) ?:) (setq end (point)) ! (progn (forward-char) (> (skip-chars-forward " \t") 0))) (let ((header (intern (downcase (buffer-substring start end)))) (value (list (buffer-substring *** pub/rgnus/lisp/md5.el Fri Mar 7 07:37:02 1997 --- rgnus/lisp/md5.el Fri Mar 7 23:51:27 1997 *************** *** 11,17 **** ;; This is a direct translation into Emacs LISP of the reference C ;; implementation of the MD5 Message-Digest Algorithm written by RSA ;; Data Security, Inc. ! ;; ;; The algorithm takes a message (that is, a string of bytes) and ;; computes a 16-byte checksum or "digest" for the message. This digest ;; is supposed to be cryptographically strong in the sense that if you --- 11,17 ---- ;; This is a direct translation into Emacs LISP of the reference C ;; implementation of the MD5 Message-Digest Algorithm written by RSA ;; Data Security, Inc. ! ;; ;; The algorithm takes a message (that is, a string of bytes) and ;; computes a 16-byte checksum or "digest" for the message. This digest ;; is supposed to be cryptographically strong in the sense that if you *************** *** 20,26 **** ;; space of messages. However, the robustness of the algorithm has not ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ;; so treat with caution! ! ;; ;; The C algorithm uses 32-bit integers; because GNU Emacs ;; implementations provide 28-bit integers (with 24-bit integers on ;; versions prior to 19.29), the code represents a 32-bit integer as the --- 20,26 ---- ;; space of messages. However, the robustness of the algorithm has not ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ;; so treat with caution! ! ;; ;; The C algorithm uses 32-bit integers; because GNU Emacs ;; implementations provide 28-bit integers (with 24-bit integers on ;; versions prior to 19.29), the code represents a 32-bit integer as the *************** *** 33,44 **** ;; To compute the MD5 Message Digest for a message M (represented as a ;; string or as a vector of bytes), call ! ;; ;; (md5-encode M) ! ;; ;; which returns the message digest as a vector of 16 bytes. If you ;; need to supply the message in pieces M1, M2, ... Mn, then call ! ;; ;; (md5-init) ;; (md5-update M1) ;; (md5-update M2) --- 33,44 ---- ;; To compute the MD5 Message Digest for a message M (represented as a ;; string or as a vector of bytes), call ! ;; ;; (md5-encode M) ! ;; ;; which returns the message digest as a vector of 16 bytes. If you ;; need to supply the message in pieces M1, M2, ... Mn, then call ! ;; ;; (md5-init) ;; (md5-update M1) ;; (md5-update M2) *************** *** 50,66 **** ;; Copyright (C) 1995 by Gareth Rees ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm ! ;; ;; md5.el 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. ! ;; ;; md5.el 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. ! ;; ;; The original copyright notice is given below, as required by the ;; licence for the original code. This code is distributed under *both* ;; RSA's original licence and the GNU General Public Licence. (There --- 50,66 ---- ;; Copyright (C) 1995 by Gareth Rees ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm ! ;; ;; md5.el 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. ! ;; ;; md5.el 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. ! ;; ;; The original copyright notice is given below, as required by the ;; licence for the original code. This code is distributed under *both* ;; RSA's original licence and the GNU General Public Licence. (There *************** *** 155,163 **** ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ;; by y bits to the left): ! ;; ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b ! ;; ;; so we use the macro `md5-make-step' to construct each one. The ;; helper functions F, G, H and I operate on 16-bit numbers; the full ;; operation splits its inputs, operates on the halves separately and --- 155,163 ---- ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ;; by y bits to the left): ! ;; ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b ! ;; ;; so we use the macro `md5-make-step' to construct each one. The ;; helper functions F, G, H and I operate on 16-bit numbers; the full ;; operation splits its inputs, operates on the halves separately and *** pub/rgnus/lisp/message.el Fri Mar 7 07:37:02 1997 --- rgnus/lisp/message.el Fri Mar 7 23:51:28 1997 *************** *** 166,173 **** :group 'message-news) (defcustom message-required-news-headers ! '(From Newsgroups Subject Date Message-ID ! (optional . Organization) Lines (optional . X-Newsreader)) "Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, --- 166,173 ---- :group 'message-news) (defcustom message-required-news-headers ! '(From Newsgroups Subject Date Message-ID ! (optional . Organization) Lines (optional . X-Newsreader)) "Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, *************** *** 178,184 **** :group 'message-headers :type '(repeat sexp)) ! (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) "Headers to be generated or prompted for when mailing a message. --- 178,184 ---- :group 'message-headers :type '(repeat sexp)) ! (defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) "Headers to be generated or prompted for when mailing a message. *************** *** 193,199 **** :group 'message-headers :type 'sexp) ! (defcustom message-ignored-news-headers "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news --- 193,199 ---- :group 'message-headers :type 'sexp) ! (defcustom message-ignored-news-headers "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news *************** *** 222,228 **** (defcustom message-elide-elipsis "\n[...]\n\n" "*The string which is inserted for elided text.") ! (defcustom message-interactive nil "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending --- 222,228 ---- (defcustom message-elide-elipsis "\n[...]\n\n" "*The string which is inserted for elided text.") ! (defcustom message-interactive nil "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending *************** *** 245,251 **** :type 'boolean) (defvar gnus-local-organization) ! (defcustom message-user-organization (or (and (boundp 'gnus-local-organization) (stringp gnus-local-organization) gnus-local-organization) --- 245,251 ---- :type 'boolean) (defvar gnus-local-organization) ! (defcustom message-user-organization (or (and (boundp 'gnus-local-organization) (stringp gnus-local-organization) gnus-local-organization) *************** *** 270,276 **** :group 'message-buffers :type 'directory) ! (defcustom message-forward-start-separator "------- Start of forwarded message -------\n" "*Delimiter inserted before forwarded messages." :group 'message-forwarding --- 270,276 ---- :group 'message-buffers :type 'directory) ! (defcustom message-forward-start-separator "------- Start of forwarded message -------\n" "*Delimiter inserted before forwarded messages." :group 'message-forwarding *************** *** 287,293 **** :group 'message-forwarding :type 'boolean) ! (defcustom message-included-forward-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding --- 287,293 ---- :group 'message-forwarding :type 'boolean) ! (defcustom message-included-forward-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding *************** *** 389,395 **** (defvar gnus-post-method) (defvar gnus-select-method) ! (defcustom message-post-method (cond ((and (boundp 'gnus-post-method) gnus-post-method) gnus-post-method) --- 389,395 ---- (defvar gnus-post-method) (defvar gnus-select-method) ! (defcustom message-post-method (cond ((and (boundp 'gnus-post-method) gnus-post-method) gnus-post-method) *************** *** 416,422 **** (defcustom message-signature-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. ! It is run after the headers have been inserted and before the signature is inserted." :group 'message-various :type 'hook) --- 416,422 ---- (defcustom message-signature-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. ! It is run after the headers have been inserted and before the signature is inserted." :group 'message-various :type 'hook) *************** *** 555,561 **** ;; Note: could use /usr/ucb/mail instead of sendmail; ;; options -t, and -v if not interactive. (defcustom message-mailer-swallows-blank-line ! (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) (file-readable-p "/etc/sendmail.cf") (let ((buffer (get-buffer-create " *temp*"))) --- 555,561 ---- ;; Note: could use /usr/ucb/mail instead of sendmail; ;; options -t, and -v if not interactive. (defcustom message-mailer-swallows-blank-line ! (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) (file-readable-p "/etc/sendmail.cf") (let ((buffer (get-buffer-create " *temp*"))) *************** *** 581,587 **** (ignore-errors (define-mail-user-agent 'message-user-agent ! 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)) (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) --- 581,587 ---- (ignore-errors (define-mail-user-agent 'message-user-agent ! 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)) (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) *************** *** 590,596 **** ;;; Internal variables. ;;; Well, not really internal. ! (defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) table) --- 590,596 ---- ;;; Internal variables. ;;; Well, not really internal. ! (defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) table) *************** *** 604,689 **** :link '(custom-manual "(message)Variables") :group 'message) ! (defface message-header-to-face '((((class color) (background dark)) ! (:foreground "light blue" :bold t :italic t)) (((class color) (background light)) ! (:foreground "MidnightBlue" :bold t :italic t)) ! (t (:bold t :italic t))) ! "Face used for displaying from headers." :group 'message-headers) ! (defface message-header-subject-face '((((class color) (background dark)) ! (:foreground "pink" :bold t :italic t)) (((class color) (background light)) ! (:foreground "firebrick" :bold t :italic t)) ! (t ! (:bold t :italic t))) "Face used for displaying subject headers." :group 'message-headers) ! (defface message-header-newsgroups-face '((((class color) (background dark)) (:foreground "yellow" :bold t :italic t)) (((class color) (background light)) (:foreground "indianred" :bold t :italic t)) ! (t (:bold t :italic t))) "Face used for displaying newsgroups headers." :group 'message-headers) ! (defface message-header-name-face '((((class color) (background dark)) ! (:foreground "cyan" :bold t)) (((class color) (background light)) ! (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for displaying header names." :group 'message-headers) ! (defface message-header-xheader-face '((((class color) (background dark)) ! (:foreground "blue" :bold t)) (((class color) (background light)) ! (:foreground "blue" :bold t)) ! (t (:bold t))) "Face used for displaying X-Header headers." :group 'message-headers) ! (defface message-separator-face '((((class color) (background dark)) ! (:foreground "red" :bold t)) (((class color) (background light)) ! (:foreground "brown" :bold t)) ! (t (:bold t))) "Face used for displaying the separator." :group 'message-headers) ! (defface message-cited-text-face '((((class color) (background dark)) ! (:foreground "LightBlue" :bold t)) (((class color) (background light)) ! (:foreground "DarkGreen" :bold t)) ! (t (:bold t))) "Face used for displaying cited text names." :group 'message-headers) --- 604,713 ---- :link '(custom-manual "(message)Variables") :group 'message) ! (defface message-header-to-face '((((class color) (background dark)) ! (:foreground "green2" :italic t)) (((class color) (background light)) ! (:foreground "MidnightBlue" :bold t)) ! (t (:bold t :italic t))) ! "Face used for displaying From headers." :group 'message-headers) ! (defface message-header-cc-face '((((class color) (background dark)) ! (:foreground "green4" :bold t)) (((class color) (background light)) ! (:foreground "blue4")) ! (t ! (:bold t))) ! "Face used for displaying Cc headers." ! :group 'message-headers) ! ! (defface message-header-subject-face ! '((((class color) ! (background dark)) ! (:foreground "green3")) ! (((class color) ! (background light)) ! (:foreground "firebrick" :bold t)) ! (t ! (:bold t))) "Face used for displaying subject headers." :group 'message-headers) ! (defface message-header-newsgroups-face '((((class color) (background dark)) (:foreground "yellow" :bold t :italic t)) (((class color) (background light)) (:foreground "indianred" :bold t :italic t)) ! (t ! (:bold t :italic t))) ! "Face used for displaying newsgroups headers." ! :group 'message-headers) ! ! (defface message-header-other-face ! '((((class color) ! (background dark)) ! (:foreground "red4")) ! (((class color) ! (background light)) ! (:foreground "red3")) ! (t (:bold t :italic t))) "Face used for displaying newsgroups headers." :group 'message-headers) ! (defface message-header-name-face '((((class color) (background dark)) ! (:foreground "DarkGreen")) (((class color) (background light)) ! (:foreground "red4")) ! (t (:bold t))) "Face used for displaying header names." :group 'message-headers) ! (defface message-header-xheader-face '((((class color) (background dark)) ! (:foreground "blue")) (((class color) (background light)) ! (:foreground "blue")) ! (t (:bold t))) "Face used for displaying X-Header headers." :group 'message-headers) ! (defface message-separator-face '((((class color) (background dark)) ! (:foreground "blue4")) (((class color) (background light)) ! (:foreground "brown")) ! (t (:bold t))) "Face used for displaying the separator." :group 'message-headers) ! (defface message-cited-text-face '((((class color) (background dark)) ! (:foreground "red")) (((class color) (background light)) ! (:foreground "DarkGreen")) ! (t (:bold t))) "Face used for displaying cited text names." :group 'message-headers) *************** *** 691,717 **** (defvar message-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) ! (list '("^To:" . message-header-to-face) ! '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face) '("^\\(Subject:\\)[ \t]*\\(.+\\)?" ! (1 message-header-name-face) (2 message-header-subject-face nil t)) '("^\\(Newsgroups:\\|Followup-to:\\)[ \t]*\\(.+\\)?" ! (1 message-header-name-face) ! (2 message-header-newsgroups-face nil t)) (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") ! 1 'message-separator-face) ! (cons (concat "^[ \t]*" ! "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" ! "[>|}].*") ! 'message-cited-text-face) '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*" ! . message-header-xheader-face))) "Additional expressions to highlight in Message mode.") (defvar message-face-alist '((bold . bold-region) (underline . underline-region) ! (default . (lambda (b e) (unbold-region b e) (ununderline-region b e)))) "Alist of mail and news faces for facemenu. --- 715,749 ---- (defvar message-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) ! (list '("^\\(To:\\)[ \t]*\\(.+\\)?" ! (1 'message-header-name-face) ! (2 'message-header-to-face nil t)) ! '("^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)[ \t]*\\(.+\\)?" ! (1 'message-header-name-face) ! (2 'message-header-cc-face nil t)) '("^\\(Subject:\\)[ \t]*\\(.+\\)?" ! (1 'message-header-name-face) ! (2 'message-header-subject-face nil t)) '("^\\(Newsgroups:\\|Followup-to:\\)[ \t]*\\(.+\\)?" ! (1 'message-header-name-face) ! (2 'message-header-newsgroups-face nil t)) ! '("^\\([^: \n\t]+:\\)[ \t]*\\(.+\\)?" ! (1 'message-header-name-face) ! (2 'message-header-other-face nil t)) (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") ! 1 '(quote message-separator-face)) ! `(,(concat "^[ \t]*" ! "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" ! "[>|}].*") ! (0 'message-cited-text-face)) '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*" ! (0 'message-header-xheader-face)))) "Additional expressions to highlight in Message mode.") (defvar message-face-alist '((bold . bold-region) (underline . underline-region) ! (default . (lambda (b e) (unbold-region b e) (ununderline-region b e)))) "Alist of mail and news faces for facemenu. *************** *** 749,755 **** (defvar gnus-read-active-file) ;;; Regexp matching the delimiter of messages in UNIX mail format ! ;;; (UNIX From lines), minus the initial ^. (defvar message-unix-mail-delimiter (let ((time-zone-regexp (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" --- 781,787 ---- (defvar gnus-read-active-file) ;;; Regexp matching the delimiter of messages in UNIX mail format ! ;;; (UNIX From lines), minus the initial ^. (defvar message-unix-mail-delimiter (let ((time-zone-regexp (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" *************** *** 797,805 **** "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") ! (defvar message-header-format-alist `((Newsgroups) ! (To . message-fill-address) (Cc . message-fill-address) (Subject) (In-Reply-To) --- 829,837 ---- "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") ! (defvar message-header-format-alist `((Newsgroups) ! (To . message-fill-address) (Cc . message-fill-address) (Subject) (In-Reply-To) *************** *** 827,833 **** ! ;;; ;;; Utility functions. ;;; --- 859,865 ---- ! ;;; ;;; Utility functions. ;;; *************** *** 998,1009 **** (not (if (re-search-forward "^[^ \t]" nil t) (beginning-of-line) (goto-char (point-max))))) ! (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." (goto-char (point-min)) ! (sort-subr ! nil 'message-next-header (lambda () (message-next-header) (unless (bobp) --- 1030,1041 ---- (not (if (re-search-forward "^[^ \t]" nil t) (beginning-of-line) (goto-char (point-max))))) ! (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." (goto-char (point-min)) ! (sort-subr ! nil 'message-next-header (lambda () (message-next-header) (unless (bobp) *************** *** 1063,1069 **** (define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) ! (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) --- 1095,1101 ---- (define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) ! (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) *************** *** 1080,1086 **** (define-key message-mode-map "\t" 'message-tab)) ! (easy-menu-define message-mode-menu message-mode-map "Message Menu." '("Message" ["Sort Headers" message-sort-headers t] --- 1112,1118 ---- (define-key message-mode-map "\t" 'message-tab)) ! (easy-menu-define message-mode-menu message-mode-map "Message Menu." '("Message" ["Sort Headers" message-sort-headers t] *************** *** 1096,1102 **** ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t])) ! (easy-menu-define message-mode-field-menu message-mode-map "" '("Field" ["Fetch To" message-insert-to t] --- 1128,1134 ---- ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t])) ! (easy-menu-define message-mode-field-menu message-mode-map "" '("Field" ["Fetch To" message-insert-to t] *************** *** 1279,1285 **** "Insert a To header that points to the author of the article being replied to." (interactive) (let ((co (message-fetch-field "courtesy-copies-to"))) ! (when (and co (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") --- 1311,1317 ---- "Insert a To header that points to the author of the article being replied to." (interactive) (let ((co (message-fetch-field "courtesy-copies-to"))) ! (when (and co (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") *************** *** 1305,1311 **** (defun message-insert-signature (&optional force) "Insert a signature. See documentation for the `message-signature' variable." (interactive (list 0)) ! (let* ((signature (cond ((and (null message-signature) (eq force 0)) --- 1337,1343 ---- (defun message-insert-signature (&optional force) "Insert a signature. See documentation for the `message-signature' variable." (interactive (list 0)) ! (let* ((signature (cond ((and (null message-signature) (eq force 0)) *************** *** 1368,1384 **** (/= (aref message-caesar-translation-table ?a) (+ ?a n))) (setq message-caesar-translation-table (message-make-caesar-translation-table n))) ! ;; Then we translate the region. Do it this way to retain ;; text properties. (while (< b e) ! (subst-char-in-region b (1+ b) (char-after b) (aref message-caesar-translation-table (char-after b))) (incf b)))) (defun message-make-caesar-translation-table (n) "Create a rot table with offset N." ! (let ((i -1) (table (make-string 256 0))) (while (< (incf i) 256) (aset table i i)) --- 1400,1416 ---- (/= (aref message-caesar-translation-table ?a) (+ ?a n))) (setq message-caesar-translation-table (message-make-caesar-translation-table n))) ! ;; Then we translate the region. Do it this way to retain ;; text properties. (while (< b e) ! (subst-char-in-region b (1+ b) (char-after b) (aref message-caesar-translation-table (char-after b))) (incf b)))) (defun message-make-caesar-translation-table (n) "Create a rot table with offset N." ! (let ((i -1) (table (make-string 256 0))) (while (< (incf i) 256) (aset table i i)) *************** *** 1418,1431 **** (message "%s failed." program)))))) (defun message-rename-buffer (&optional enter-string) ! "Rename the *message* buffer to \"*message* RECIPIENT\". If the function is run with a prefix, it will ask for a new buffer name, rather than giving an automatic name." (interactive "Pbuffer name: ") (save-excursion (save-restriction (goto-char (point-min)) ! (narrow-to-region (point) (search-forward mail-header-separator nil 'end)) (let* ((mail-to (or (if (message-news-p) (message-fetch-field "Newsgroups") --- 1450,1463 ---- (message "%s failed." program)))))) (defun message-rename-buffer (&optional enter-string) ! "Rename the *message* buffer to \"*message* RECIPIENT\". If the function is run with a prefix, it will ask for a new buffer name, rather than giving an automatic name." (interactive "Pbuffer name: ") (save-excursion (save-restriction (goto-char (point-min)) ! (narrow-to-region (point) (search-forward mail-header-separator nil 'end)) (let* ((mail-to (or (if (message-news-p) (message-fetch-field "Newsgroups") *************** *** 1464,1470 **** ;; Remove unwanted headers. (when message-ignored-cited-headers (save-restriction ! (narrow-to-region (goto-char start) (if (search-forward "\n\n" nil t) (1- (point)) --- 1496,1502 ---- ;; Remove unwanted headers. (when message-ignored-cited-headers (save-restriction ! (narrow-to-region (goto-char start) (if (search-forward "\n\n" nil t) (1- (point)) *************** *** 1519,1525 **** (defun message-cite-original () "Cite function in the standard Message manner." (let ((start (point)) ! (functions (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function --- 1551,1557 ---- (defun message-cite-original () "Cite function in the standard Message manner." (let ((start (point)) ! (functions (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function *************** *** 1543,1549 **** (narrow-to-region (goto-char (point-min)) (progn ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) (goto-char (point-min)) --- 1575,1581 ---- (narrow-to-region (goto-char (point-min)) (progn ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) (goto-char (point-min)) *************** *** 1554,1560 **** (skip-chars-backward "\n") t) (while (and afters ! (not (re-search-forward (concat "^" (regexp-quote (car afters)) ":") nil t))) (pop afters)) --- 1586,1592 ---- (skip-chars-backward "\n") t) (while (and afters ! (not (re-search-forward (concat "^" (regexp-quote (car afters)) ":") nil t))) (pop afters)) *************** *** 1697,1703 **** ;; Now perform actions on successful sending. (while actions (ignore-errors ! (cond ;; A simple function. ((message-functionp (car actions)) (funcall (car actions))) --- 1729,1735 ---- ;; Now perform actions on successful sending. (while actions (ignore-errors ! (cond ;; A simple function. ((message-functionp (car actions)) (funcall (car actions))) *************** *** 1725,1731 **** (set-buffer tembuf) (erase-buffer) ;; Avoid copying text props. ! (insert (format "%s" (save-excursion (set-buffer mailbuf) (buffer-string)))) --- 1757,1763 ---- (set-buffer tembuf) (erase-buffer) ;; Avoid copying text props. ! (insert (format "%s" (save-excursion (set-buffer mailbuf) (buffer-string)))) *************** *** 1835,1841 **** ;; ;; qmail also has the advantage of not having been raped by ;; various vendors, so we don't have to allow for that, either -- ! ;; compare this with message-send-mail-with-sendmail and weep ;; for sendmail's lost innocence. ;; ;; all this is way cool coz it lets us keep the arguments entirely --- 1867,1873 ---- ;; ;; qmail also has the advantage of not having been raped by ;; various vendors, so we don't have to allow for that, either -- ! ;; compare this with message-send-mail-with-sendmail and weep ;; for sendmail's lost innocence. ;; ;; all this is way cool coz it lets us keep the arguments entirely *************** *** 1855,1861 **** "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) (name (make-temp-name ! (concat (file-name-as-directory (expand-file-name message-autosave-directory)) "msg.")))) (setq buffer-file-name name) --- 1887,1893 ---- "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) (name (make-temp-name ! (concat (file-name-as-directory (expand-file-name message-autosave-directory)) "msg.")))) (setq buffer-file-name name) *************** *** 1863,1870 **** (when message-mh-deletable-headers (let ((headers message-mh-deletable-headers)) (while headers ! (goto-char (point-min)) ! (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (message-delete-line)) (pop headers)))) --- 1895,1902 ---- (when message-mh-deletable-headers (let ((headers message-mh-deletable-headers)) (while headers ! (goto-char (point-min)) ! (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (message-delete-line)) (pop headers)))) *************** *** 1900,1908 **** (save-excursion (set-buffer tembuf) (buffer-disable-undo (current-buffer)) ! (erase-buffer) ;; Avoid copying text props. ! (insert (format "%s" (save-excursion (set-buffer messbuf) (buffer-string)))) --- 1932,1940 ---- (save-excursion (set-buffer tembuf) (buffer-disable-undo (current-buffer)) ! (erase-buffer) ;; Avoid copying text props. ! (insert (format "%s" (save-excursion (set-buffer messbuf) (buffer-string)))) *************** *** 1962,1968 **** (save-excursion (save-restriction (widen) ! (and ;; We narrow to the headers and check them first. (save-excursion (save-restriction --- 1994,2000 ---- (save-excursion (save-restriction (widen) ! (and ;; We narrow to the headers and check them first. (save-excursion (save-restriction *************** *** 1972,1978 **** (message-check-news-body-syntax))))) (defun message-check-news-header-syntax () ! (and ;; Check for commands in Subject. (message-check 'subject-cmsg (if (string-match "^cmsg " (message-fetch-field "subject")) --- 2004,2010 ---- (message-check-news-body-syntax))))) (defun message-check-news-header-syntax () ! (and ;; Check for commands in Subject. (message-check 'subject-cmsg (if (string-match "^cmsg " (message-fetch-field "subject")) *************** *** 1982,1992 **** ;; Check for multiple identical headers. (message-check 'multiple-headers (let (found) ! (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) (save-excursion ! (or (re-search-forward ! (concat "^" (regexp-quote (setq found (buffer-substring --- 2014,2024 ---- ;; Check for multiple identical headers. (message-check 'multiple-headers (let (found) ! (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) (save-excursion ! (or (re-search-forward ! (concat "^" (regexp-quote (setq found (buffer-substring *************** *** 2002,2008 **** (if (re-search-forward "^Sendsys:\\|^Version:" nil t) (y-or-n-p (format "The article contains a %s command. Really post? " ! (buffer-substring (match-beginning 0) (1- (match-end 0))))) t)) ;; See whether we can shorten Followup-To. --- 2034,2040 ---- (if (re-search-forward "^Sendsys:\\|^Version:" nil t) (y-or-n-p (format "The article contains a %s command. Really post? " ! (buffer-substring (match-beginning 0) (1- (match-end 0))))) t)) ;; See whether we can shorten Followup-To. *************** *** 2016,2026 **** (not (zerop (length ! (setq to (completing-read ! "Followups to: (default all groups) " (mapcar (lambda (g) (list g)) ! (cons "poster" ! (message-tokenize-header newsgroups))))))))) (goto-char (point-min)) (insert "Followup-To: " to "\n")) --- 2048,2058 ---- (not (zerop (length ! (setq to (completing-read ! "Followups to: (default all groups) " (mapcar (lambda (g) (list g)) ! (cons "poster" ! (message-tokenize-header newsgroups))))))))) (goto-char (point-min)) (insert "Followup-To: " to "\n")) *************** *** 2054,2060 **** (and subject (not (string-match "\\`[ \t]*\\'" subject))) (ignore ! (message "The subject field is empty or missing. Posting is denied."))))) ;; Check the Newsgroups & Followup-To headers. (message-check 'existing-newsgroups --- 2086,2092 ---- (and subject (not (string-match "\\`[ \t]*\\'" subject))) (ignore ! (message "The subject field is empty or missing. Posting is denied."))))) ;; Check the Newsgroups & Followup-To headers. (message-check 'existing-newsgroups *************** *** 2094,2105 **** (while (and headers (not error)) (when (setq header (mail-fetch-field (car headers))) (if (or ! (not (string-match "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" header)) ! (memq ! nil (mapcar (lambda (g) (not (string-match "\\.\\'\\|\\.\\." g))) (message-tokenize-header header ",")))) --- 2126,2137 ---- (while (and headers (not error)) (when (setq header (mail-fetch-field (car headers))) (if (or ! (not (string-match "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" header)) ! (memq ! nil (mapcar (lambda (g) (not (string-match "\\.\\'\\|\\.\\." g))) (message-tokenize-header header ",")))) *************** *** 2162,2168 **** ;; Check for control characters. (message-check 'control-chars (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) ! (y-or-n-p "The article contains control characters. Really post? ") t)) ;; Check excessive size. --- 2194,2200 ---- ;; Check for control characters. (message-check 'control-chars (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) ! (y-or-n-p "The article contains control characters. Really post? ") t)) ;; Check excessive size. *************** *** 2243,2249 **** (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) (rmail-output file 1 t t)))))) ! (kill-buffer (current-buffer))))) (defun message-output (filename) --- 2275,2281 ---- (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) (rmail-output file 1 t t)))))) ! (kill-buffer (current-buffer))))) (defun message-output (filename) *************** *** 2287,2305 **** (defun message-make-date () "Make a valid data header." (let ((now (current-time))) ! (timezone-make-date-arpa-standard (current-time-string now) (current-time-zone now)))) (defun message-make-message-id () "Make a unique Message-ID." ! (concat "<" (message-unique-id) (let ((psubject (save-excursion (message-fetch-field "subject")))) (if (and message-reply-headers (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) psubject (mail-header-subject message-reply-headers) ! (not (string= (message-strip-subject-re (mail-header-subject message-reply-headers)) (message-strip-subject-re psubject)))) --- 2319,2337 ---- (defun message-make-date () "Make a valid data header." (let ((now (current-time))) ! (timezone-make-date-arpa-standard (current-time-string now) (current-time-zone now)))) (defun message-make-message-id () "Make a unique Message-ID." ! (concat "<" (message-unique-id) (let ((psubject (save-excursion (message-fetch-field "subject")))) (if (and message-reply-headers (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) psubject (mail-header-subject message-reply-headers) ! (not (string= (message-strip-subject-re (mail-header-subject message-reply-headers)) (message-strip-subject-re psubject)))) *************** *** 2328,2334 **** (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) ! (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) --- 2360,2366 ---- (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) ! (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) *************** *** 2348,2354 **** (defun message-make-organization () "Make an Organization header." ! (let* ((organization (or (getenv "ORGANIZATION") (when message-user-organization (if (message-functionp message-user-organization) --- 2380,2386 ---- (defun message-make-organization () "Make an Organization header." ! (let* ((organization (or (getenv "ORGANIZATION") (when message-user-organization (if (message-functionp message-user-organization) *************** *** 2374,2380 **** (save-restriction (widen) (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (int-to-string (count-lines (point) (point-max)))))) --- 2406,2412 ---- (save-restriction (widen) (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (int-to-string (count-lines (point) (point-max)))))) *************** *** 2385,2394 **** (let ((from (mail-header-from message-reply-headers)) (date (mail-header-date message-reply-headers))) (when from ! (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) ! "'s message of " (if (or (not date) (string= date "")) "(unknown date)" date))))))) --- 2417,2426 ---- (let ((from (mail-header-from message-reply-headers)) (date (mail-header-date message-reply-headers))) (when from ! (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) ! "'s message of " (if (or (not date) (string= date "")) "(unknown date)" date))))))) *************** *** 2407,2413 **** (setcar current (+ (car current) (round (/ future (expt 2 16))))) (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) ;; Return the date in the future in UT. ! (timezone-make-date-arpa-standard (current-time-string current) (current-time-zone current) '(0 "UT")))) (defun message-make-path () --- 2439,2445 ---- (setcar current (+ (car current) (round (/ future (expt 2 16))))) (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) ;; Return the date in the future in UT. ! (timezone-make-date-arpa-standard (current-time-string current) (current-time-zone current) '(0 "UT")))) (defun message-make-path () *************** *** 2423,2429 **** (defun message-make-from () "Make a From header." (let* ((login (message-make-address)) ! (fullname (or (and (boundp 'user-full-name) user-full-name) (user-full-name)))) --- 2455,2461 ---- (defun message-make-from () "Make a From header." (let* ((login (message-make-address)) ! (fullname (or (and (boundp 'user-full-name) user-full-name) (user-full-name)))) *************** *** 2431,2437 **** (setq fullname (user-login-name))) (save-excursion (message-set-work-buffer) ! (cond ((or (null message-from-style) (equal fullname "")) (insert login)) --- 2463,2469 ---- (setq fullname (user-login-name))) (save-excursion (message-set-work-buffer) ! (cond ((or (null message-from-style) (equal fullname "")) (insert login)) *************** *** 2470,2476 **** ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) ! (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" nil 1) (replace-match "\\1(\\3)" t) --- 2502,2508 ---- ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) ! (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" nil 1) (replace-match "\\1(\\3)" t) *************** *** 2480,2486 **** (defun message-make-sender () "Return the \"real\" user address. ! This function tries to ignore all user modifications, and give as trustworthy answer as possible." (concat (user-login-name) "@" (system-name))) --- 2512,2518 ---- (defun message-make-sender () "Return the \"real\" user address. ! This function tries to ignore all user modifications, and give as trustworthy answer as possible." (concat (user-login-name) "@" (system-name))) *************** *** 2500,2506 **** "Return user's fully qualified domain name." (let ((system-name (system-name)) (user-mail (message-user-mail-address))) ! (cond ((string-match "[^.]\\.[^.]" system-name) ;; `system-name' returned the right result. system-name) --- 2532,2538 ---- "Return user's fully qualified domain name." (let ((system-name (system-name)) (user-mail (message-user-mail-address))) ! (cond ((string-match "[^.]\\.[^.]" system-name) ;; `system-name' returned the right result. system-name) *************** *** 2554,2560 **** (let ((headers message-deletable-headers)) (while headers (goto-char (point-min)) ! (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (get-text-property (1+ (match-beginning 0)) 'message-deletable) (message-delete-line)) --- 2586,2592 ---- (let ((headers message-deletable-headers)) (while headers (goto-char (point-min)) ! (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (get-text-property (1+ (match-beginning 0)) 'message-deletable) (message-delete-line)) *************** *** 2562,2568 **** ;; Go through all the required headers and see if they are in the ;; articles already. If they are not, or are empty, they are ;; inserted automatically - except for Subject, Newsgroups and ! ;; Distribution. (while headers (goto-char (point-min)) (setq elem (pop headers)) --- 2594,2600 ---- ;; Go through all the required headers and see if they are in the ;; articles already. If they are not, or are empty, they are ;; inserted automatically - except for Subject, Newsgroups and ! ;; Distribution. (while headers (goto-char (point-min)) (setq elem (pop headers)) *************** *** 2571,2578 **** (setq header (cdr elem)) (setq header (car elem))) (setq header elem)) ! (when (or (not (re-search-forward ! (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn ;; The header was found. We insert a space after the --- 2603,2610 ---- (setq header (cdr elem)) (setq header (car elem))) (setq header elem)) ! (when (or (not (re-search-forward ! (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn ;; The header was found. We insert a space after the *************** *** 2582,2588 **** (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. (setq value ! (cond ((and (consp elem) (eq (car elem) 'optional)) ;; This is an optional header. If the cdr of this ;; is something that is nil, then we do not insert --- 2614,2620 ---- (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. (setq value ! (cond ((and (consp elem) (eq (car elem) 'optional)) ;; This is an optional header. If the cdr of this ;; is something that is nil, then we do not insert *************** *** 2607,2613 **** (read-from-minibuffer (format "Empty header for %s; enter value: " header))))) ;; Finally insert the header. ! (when (and value (not (equal value ""))) (save-excursion (if (bolp) --- 2639,2645 ---- (read-from-minibuffer (format "Empty header for %s; enter value: " header))))) ;; Finally insert the header. ! (when (and value (not (equal value ""))) (save-excursion (if (bolp) *************** *** 2623,2648 **** ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) ! (add-text-properties (point) (match-end 0) '(message-deletable t face italic) (current-buffer))))))) ! ;; Insert new Sender if the From is strange. (let ((from (message-fetch-field "from")) (sender (message-fetch-field "sender")) (secure-sender (message-make-sender))) ! (when (and from (not (message-check-element 'sender)) (not (string= (downcase (cadr (mail-extract-address-components from))) (downcase secure-sender))) (or (null sender) ! (not (string= (downcase (cadr (mail-extract-address-components sender))) (downcase secure-sender))))) ! (goto-char (point-min)) ;; Rename any old Sender headers to Original-Sender. (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) (beginning-of-line) --- 2655,2680 ---- ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) ! (add-text-properties (point) (match-end 0) '(message-deletable t face italic) (current-buffer))))))) ! ;; Insert new Sender if the From is strange. (let ((from (message-fetch-field "from")) (sender (message-fetch-field "sender")) (secure-sender (message-make-sender))) ! (when (and from (not (message-check-element 'sender)) (not (string= (downcase (cadr (mail-extract-address-components from))) (downcase secure-sender))) (or (null sender) ! (not (string= (downcase (cadr (mail-extract-address-components sender))) (downcase secure-sender))))) ! (goto-char (point-min)) ;; Rename any old Sender headers to Original-Sender. (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) (beginning-of-line) *************** *** 2666,2672 **** (insert (format message-courtesy-message newsgroups))) (t (insert message-courtesy-message))))))) ! ;;; ;;; Setting up a message buffer ;;; --- 2698,2704 ---- (insert (format message-courtesy-message newsgroups))) (t (insert message-courtesy-message))))))) ! ;;; ;;; Setting up a message buffer ;;; *************** *** 2725,2731 **** (defun message-position-point () "Move point to where the user probably wants to find it." (message-narrow-to-headers) ! (cond ((re-search-forward "^[^:]+:[ \t]*$" nil t) (search-backward ":" ) (widen) --- 2757,2763 ---- (defun message-position-point () "Move point to where the user probably wants to find it." (message-narrow-to-headers) ! (cond ((re-search-forward "^[^:]+:[ \t]*$" nil t) (search-backward ":" ) (widen) *************** *** 2744,2750 **** (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." (cond ! ;; Check whether `message-generate-new-buffers' is a function, ;; and if so, call it. ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) --- 2776,2782 ---- (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." (cond ! ;; Check whether `message-generate-new-buffers' is a function, ;; and if so, call it. ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) *************** *** 2795,2805 **** (if message-send-rename-function (funcall message-send-rename-function) (when (string-match "\\`\\*" (buffer-name)) ! (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. (when message-max-buffers ! (setq message-buffer-list (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) --- 2827,2837 ---- (if message-send-rename-function (funcall message-send-rename-function) (when (string-match "\\`\\*" (buffer-name)) ! (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. (when message-max-buffers ! (setq message-buffer-list (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) *************** *** 2814,2820 **** (setq message-reply-buffer replybuffer) (goto-char (point-min)) ;; Insert all the headers. ! (mail-header-format (let ((h headers) (alist message-header-format-alist)) (while h --- 2846,2852 ---- (setq message-reply-buffer replybuffer) (goto-char (point-min)) ;; Insert all the headers. ! (mail-header-format (let ((h headers) (alist message-header-format-alist)) (while h *************** *** 2892,2898 **** (interactive) (let ((message-this-is-mail t)) (message-pop-to-buffer (message-buffer-name "mail" to)) ! (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) (when other-headers other-headers))))) --- 2924,2930 ---- (interactive) (let ((message-this-is-mail t)) (message-pop-to-buffer (message-buffer-name "mail" to)) ! (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) (when other-headers other-headers))))) *************** *** 2903,2909 **** (interactive) (let ((message-this-is-news t)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) ;;;###autoload --- 2935,2941 ---- (interactive) (let ((message-this-is-news t)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) ;;;###autoload *************** *** 2912,2918 **** (interactive) (let ((cur (current-buffer)) from subject date reply-to to cc ! references message-id follow-to (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction --- 2944,2950 ---- (interactive) (let ((cur (current-buffer)) from subject date reply-to to cc ! references message-id follow-to (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction *************** *** 2929,2935 **** (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. (setq from (message-fetch-field "from") ! date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") to (message-fetch-field "to") cc (message-fetch-field "cc") --- 2961,2967 ---- (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. (setq from (message-fetch-field "from") ! date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") to (message-fetch-field "to") cc (message-fetch-field "cc") *************** *** 2946,2952 **** (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ! ;; Handle special values of Mail-Copies-To. (when mct (cond ((equal (downcase mct) "never") --- 2978,2984 ---- (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ! ;; Handle special values of Mail-Copies-To. (when mct (cond ((equal (downcase mct) "never") *************** *** 2967,2973 **** (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) ! ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) (goto-char (point-min)) --- 2999,3005 ---- (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) ! ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) (goto-char (point-min)) *************** *** 2984,2990 **** (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) (setq follow-to (list (cons 'To (cdr (pop ccalist))))) (when ccalist ! (let ((ccs (cons 'Cc (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")))) (when (string-match "^ +" (cdr ccs)) (setcdr ccs (substring (cdr ccs) (match-end 0)))) --- 3016,3022 ---- (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) (setq follow-to (list (cons 'To (cdr (pop ccalist))))) (when ccalist ! (let ((ccs (cons 'Cc (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")))) (when (string-match "^ +" (cdr ccs)) (setcdr ccs (substring (cdr ccs) (match-end 0)))) *************** *** 3000,3006 **** (message-setup `((Subject . ,subject) ! ,@follow-to ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") (or message-id "")))) --- 3032,3038 ---- (message-setup `((Subject . ,subject) ! ,@follow-to ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") (or message-id "")))) *************** *** 3020,3026 **** (interactive) (let ((cur (current-buffer)) from subject date reply-to mct ! references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) --- 3052,3058 ---- (interactive) (let ((cur (current-buffer)) from subject date reply-to mct ! references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) *************** *** 3034,3040 **** (setq follow-to (funcall message-followup-to-function))) (setq from (message-fetch-field "from") ! date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") references (message-fetch-field "references") message-id (message-fetch-field "message-id" t) --- 3066,3072 ---- (setq follow-to (funcall message-followup-to-function))) (setq from (message-fetch-field "from") ! date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") references (message-fetch-field "references") message-id (message-fetch-field "message-id" t) *************** *** 3063,3075 **** (message-setup `((Subject . ,subject) ! ,@(cond (to-newsgroups (list (cons 'Newsgroups to-newsgroups))) (follow-to follow-to) ((and followup-to message-use-followup-to) (list ! (cond ((equal (downcase followup-to) "poster") (if (or (eq message-use-followup-to 'use) (message-y-or-n-p "Obey Followup-To: poster? " t "\ --- 3095,3107 ---- (message-setup `((Subject . ,subject) ! ,@(cond (to-newsgroups (list (cons 'Newsgroups to-newsgroups))) (follow-to follow-to) ((and followup-to message-use-followup-to) (list ! (cond ((equal (downcase followup-to) "poster") (if (or (eq message-use-followup-to 'use) (message-y-or-n-p "Obey Followup-To: poster? " t "\ *************** *** 3171,3177 **** header line with the old Message-ID." (interactive) (let ((cur (current-buffer))) ! ;; Check whether the user owns the article that is to be superseded. (unless (string-equal (downcase (cadr (mail-extract-address-components (message-fetch-field "from")))) --- 3203,3209 ---- header line with the old Message-ID." (interactive) (let ((cur (current-buffer))) ! ;; Check whether the user owns the article that is to be superseded. (unless (string-equal (downcase (cadr (mail-extract-address-components (message-fetch-field "from")))) *************** *** 3219,3232 **** (save-restriction (current-buffer) (message-narrow-to-head) ! (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) "(nowhere)") "] " (or (message-fetch-field "Subject") ""))))) ;;;###autoload (defun message-forward (&optional news) ! "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") (let ((cur (current-buffer)) --- 3251,3264 ---- (save-restriction (current-buffer) (message-narrow-to-head) ! (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) "(nowhere)") "] " (or (message-fetch-field "Subject") ""))))) ;;;###autoload (defun message-forward (&optional news) ! "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") (let ((cur (current-buffer)) *************** *** 3234,3240 **** art-beg) (if news (message-news nil subject) (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ! ;; message. (if message-signature-before-forwarded-message (goto-char (point-max)) (message-goto-body)) --- 3266,3272 ---- art-beg) (if news (message-news nil subject) (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ! ;; message. (if message-signature-before-forwarded-message (goto-char (point-max)) (message-goto-body)) *************** *** 3337,3343 **** (and (search-forward "\n\n" nil t) (re-search-forward "^Return-Path:.*\n" nil t))) ;; We remove everything before the bounced mail. ! (delete-region (point-min) (if (re-search-forward "^[^ \n\t]+:" nil t) (match-beginning 0) --- 3369,3375 ---- (and (search-forward "\n\n" nil t) (re-search-forward "^Return-Path:.*\n" nil t))) ;; We remove everything before the bounced mail. ! (delete-region (point-min) (if (re-search-forward "^[^ \n\t]+:" nil t) (match-beginning 0) *************** *** 3387,3393 **** (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;;###autoload --- 3419,3425 ---- (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;;###autoload *************** *** 3400,3411 **** (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;; underline.el ! ;; This code should be moved to underline.el (from which it is stolen). ;;;###autoload (defun bold-region (start end) --- 3432,3443 ---- (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) ! (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;; underline.el ! ;; This code should be moved to underline.el (from which it is stolen). ;;;###autoload (defun bold-region (start end) *************** *** 3432,3438 **** (save-excursion (let ((end1 (make-marker))) (move-marker end1 (max start end)) ! (goto-char (min start end)) (while (re-search-forward "\b" end1 t) (if (eq (following-char) (char-after (- (point) 2))) (delete-char -2)))))) --- 3464,3470 ---- (save-excursion (let ((end1 (make-marker))) (move-marker end1 (max start end)) ! (goto-char (min start end)) (while (re-search-forward "\b" end1 t) (if (eq (following-char) (char-after (- (point) 2))) (delete-char -2)))))) *************** *** 3460,3468 **** (defvar gnus-active-hashtb) (defun message-expand-group () ! (let* ((b (save-excursion (save-restriction ! (narrow-to-region (save-excursion (beginning-of-line) (skip-chars-forward "^:") --- 3492,3500 ---- (defvar gnus-active-hashtb) (defun message-expand-group () ! (let* ((b (save-excursion (save-restriction ! (narrow-to-region (save-excursion (beginning-of-line) (skip-chars-forward "^:") *************** *** 3476,3482 **** (cur (current-buffer)) comp) (delete-region b (point)) ! (cond ((= (length completions) 1) (if (string= (car completions) string) (progn --- 3508,3514 ---- (cur (current-buffer)) comp) (delete-region b (point)) ! (cond ((= (length completions) 1) (if (string= (car completions) string) (progn *************** *** 3502,3508 **** ;;; Help stuff. (defun message-talkative-question (ask question show &rest text) ! "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. The following arguments may contain lists of values." (if (and show (setq text (message-flatten-list text))) --- 3534,3540 ---- ;;; Help stuff. (defun message-talkative-question (ask question show &rest text) ! "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. The following arguments may contain lists of values." (if (and show (setq text (message-flatten-list text))) *************** *** 3520,3526 **** \(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) => (1 2 3 4 5 6 7)" ! (cond ((consp list) (apply 'append (mapcar 'message-flatten-list list))) (list (list list)))) --- 3552,3558 ---- \(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) => (1 2 3 4 5 6 7)" ! (cond ((consp list) (apply 'append (mapcar 'message-flatten-list list))) (list (list list)))) *** pub/rgnus/lisp/messagexmas.el Sun Feb 16 18:16:40 1997 --- rgnus/lisp/messagexmas.el Fri Mar 7 23:51:28 1997 *************** *** 43,49 **** `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") ! (defvar message-toolbar '([message-spell ispell-message t "Spell"] [message-help (Info-goto-node "(Message)Top") t "Message help"]) "The message buffer toolbar.") --- 43,49 ---- `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") ! (defvar message-toolbar '([message-spell ispell-message t "Spell"] [message-help (Info-goto-node "(Message)Top") t "Message help"]) "The message buffer toolbar.") *************** *** 99,105 **** (defun message-xmas-make-caesar-translation-table (n) "Create a rot table with offset N." ! (let ((i -1) (table (make-string 256 0)) (a (char-int ?a)) (A (char-int ?A))) --- 99,105 ---- (defun message-xmas-make-caesar-translation-table (n) "Create a rot table with offset N." ! (let ((i -1) (table (make-string 256 0)) (a (char-int ?a)) (A (char-int ?A))) *** pub/rgnus/lisp/messcompat.el Thu Jan 9 11:59:34 1997 --- rgnus/lisp/messcompat.el Fri Mar 7 23:51:28 1997 *************** *** 24,30 **** ;;; Commentary: ;; This file tries to provide backward compatability with sendmail.el ! ;; for Message mode. It should be used by simply adding ;; ;; (require 'messcompat) ;; --- 24,30 ---- ;;; Commentary: ;; This file tries to provide backward compatability with sendmail.el ! ;; for Message mode. It should be used by simply adding ;; ;; (require 'messcompat) ;; *************** *** 59,65 **** (defvar message-mode-hook mail-mode-hook "Hook run in message mode buffers.") ! (defvar message-indentation-spaces mail-indentation-spaces "*Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'.") --- 59,65 ---- (defvar message-mode-hook mail-mode-hook "Hook run in message mode buffers.") ! (defvar message-indentation-spaces mail-indentation-spaces "*Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'.") *** pub/rgnus/lisp/nnbabyl.el Fri Mar 7 07:37:02 1997 --- rgnus/lisp/nnbabyl.el Fri Mar 7 23:51:29 1997 *************** *** 25,31 **** ;;; Commentary: ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: --- 25,31 ---- ;;; Commentary: ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: *************** *** 119,125 **** (deffoo nnbabyl-open-server (server &optional defs) (nnoo-change-server 'nnbabyl server defs) (nnbabyl-create-mbox) ! (cond ((not (file-exists-p nnbabyl-mbox-file)) (nnbabyl-close-server) (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) --- 119,125 ---- (deffoo nnbabyl-open-server (server &optional defs) (nnoo-change-server 'nnbabyl server defs) (nnbabyl-create-mbox) ! (cond ((not (file-exists-p nnbabyl-mbox-file)) (nnbabyl-close-server) (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) *************** *** 165,171 **** (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) ! (or (when (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (beginning-of-line) t) --- 165,171 ---- (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) ! (or (when (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (beginning-of-line) t) *************** *** 177,183 **** (insert-buffer-substring nnbabyl-mbox-buffer start stop) (goto-char (point-min)) ;; If there is an EOOH header, then we have to remove some ! ;; duplicated headers. (setq summary-line (looking-at "Summary-line:")) (when (search-forward "\n*** EOOH ***" nil t) (if summary-line --- 177,183 ---- (insert-buffer-substring nnbabyl-mbox-buffer start stop) (goto-char (point-min)) ;; If there is an EOOH header, then we have to remove some ! ;; duplicated headers. (setq summary-line (looking-at "Summary-line:")) (when (search-forward "\n*** EOOH ***" nil t) (if summary-line *************** *** 196,202 **** (deffoo nnbabyl-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnbabyl-group-alist)))) (save-excursion ! (cond ((or (null active) (null (nnbabyl-possibly-change-newsgroup group server))) (nnheader-report 'nnbabyl "No such group: %s" group)) --- 196,202 ---- (deffoo nnbabyl-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnbabyl-group-alist)))) (save-excursion ! (cond ((or (null active) (null (nnbabyl-possibly-change-newsgroup group server))) (nnheader-report 'nnbabyl "No such group: %s" group)) *************** *** 205,219 **** (nnheader-insert "")) (t (nnheader-report 'nnbabyl "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group)))))) (deffoo nnbabyl-request-scan (&optional group server) (nnbabyl-possibly-change-newsgroup group server) (nnbabyl-read-mbox) ! (nnmail-get-new-mail ! 'nnbabyl (lambda () (save-excursion (set-buffer nnbabyl-mbox-buffer) --- 205,219 ---- (nnheader-insert "")) (t (nnheader-report 'nnbabyl "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group)))))) (deffoo nnbabyl-request-scan (&optional group server) (nnbabyl-possibly-change-newsgroup group server) (nnbabyl-read-mbox) ! (nnmail-get-new-mail ! 'nnbabyl (lambda () (save-excursion (set-buffer nnbabyl-mbox-buffer) *************** *** 263,269 **** rest) (nnmail-activate 'nnbabyl) ! (save-excursion (set-buffer nnbabyl-mbox-buffer) (gnus-set-text-properties (point-min) (point-max) nil) (while (and articles is-old) --- 263,269 ---- rest) (nnmail-activate 'nnbabyl) ! (save-excursion (set-buffer nnbabyl-mbox-buffer) (gnus-set-text-properties (point-min) (point-max) nil) (while (and articles is-old) *************** *** 272,281 **** (if (setq is-old (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) (push (car articles) rest))) --- 272,281 ---- (if (setq is-old (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) (push (car articles) rest))) *************** *** 292,309 **** (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (nconc rest articles)))) ! (deffoo nnbabyl-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnbabyl move*")) result) ! (and (nnbabyl-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward ! "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) --- 292,309 ---- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (nconc rest articles)))) ! (deffoo nnbabyl-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnbabyl move*")) result) ! (and (nnbabyl-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward ! "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) *************** *** 324,330 **** (nnmail-check-syntax) (let ((buf (current-buffer)) result beg) ! (and (nnmail-activate 'nnbabyl) (save-excursion (goto-char (point-min)) --- 324,330 ---- (nnmail-check-syntax) (let ((buf (current-buffer)) result beg) ! (and (nnmail-activate 'nnbabyl) (save-excursion (goto-char (point-min)) *************** *** 333,340 **** (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) ! (when nnmail-cache-message-id-when-accepting ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) --- 333,339 ---- (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) ! (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) *************** *** 379,385 **** (when found (save-buffer))))) ;; Remove the group from all structures. ! (setq nnbabyl-group-alist (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) nnbabyl-current-group nil) ;; Save the active file. --- 378,384 ---- (when found (save-buffer))))) ;; Remove the group from all structures. ! (setq nnbabyl-group-alist (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) nnbabyl-current-group nil) ;; Save the active file. *************** *** 441,447 **** (delete-region (point-min) (point-max)))))) (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server (not (nnbabyl-server-opened server))) (nnbabyl-open-server server)) (when (or (not nnbabyl-mbox-buffer) --- 440,446 ---- (delete-region (point-min) (point-max)))))) (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server (not (nnbabyl-server-opened server))) (nnbabyl-open-server server)) (when (or (not nnbabyl-mbox-buffer) *************** *** 457,463 **** (defun nnbabyl-article-string (article) (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) --- 456,462 ---- (defun nnbabyl-article-string (article) (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) *************** *** 481,487 **** (search-forward "\n\n" nil t)) (setq chars (- (point-max) (point)) lines (max (- (count-lines (point) (point-max)) 1) 0)) ! ;; Move back to the end of the headers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-char -1) --- 480,486 ---- (search-forward "\n\n" nil t)) (setq chars (- (point-max) (point)) lines (max (- (count-lines (point) (point-max)) 1) 0)) ! ;; Move back to the end of the headers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-char -1) *************** *** 516,522 **** (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art ! (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) --- 515,521 ---- (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art ! (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) *************** *** 559,569 **** (let ((delim (concat "^" nnbabyl-mail-delimiter)) (alist nnbabyl-group-alist) start end number) ! (set-buffer (setq nnbabyl-mbox-buffer ! (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) ;; Save previous buffer mode. ! (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) major-mode)) --- 558,568 ---- (let ((delim (concat "^" nnbabyl-mail-delimiter)) (alist nnbabyl-group-alist) start end number) ! (set-buffer (setq nnbabyl-mbox-buffer ! (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) ;; Save previous buffer mode. ! (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) major-mode)) *************** *** 581,594 **** (caar alist)) nil t) (> (setq number ! (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) number)) (setq alist (cdr alist))) ! ! ;; We go through the mbox and make sure that each and ;; every mail belongs to some group or other. (goto-char (point-min)) (if (looking-at "\^L") --- 580,593 ---- (caar alist)) nil t) (> (setq number ! (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) number)) (setq alist (cdr alist))) ! ! ;; We go through the mbox and make sure that each and ;; every mail belongs to some group or other. (goto-char (point-min)) (if (looking-at "\^L") *************** *** 602,608 **** (save-excursion (save-restriction (narrow-to-region (goto-char start) end) ! (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number)) (setq end (point-max))))) (goto-char (setq start end))) --- 601,607 ---- (save-excursion (save-restriction (narrow-to-region (goto-char start) end) ! (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number)) (setq end (point-max))))) (goto-char (setq start end))) *** pub/rgnus/lisp/nndb.el Thu Jan 9 11:59:34 1997 --- rgnus/lisp/nndb.el Fri Mar 7 23:51:29 1997 *************** *** 179,185 **** server t)) result)) ! (deffoo nndb-request-accept-article (group server &optional last) "The article in the current buffer is put into GROUP." (nntp-possibly-change-group group server) ;;- --- 179,185 ---- server t)) result)) ! (deffoo nndb-request-accept-article (group server &optional last) "The article in the current buffer is put into GROUP." (nntp-possibly-change-group group server) ;;- *************** *** 198,204 **** (list art)))) (deffoo nndb-request-replace-article (article group buffer) ! "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) (let (art statmsg) --- 198,204 ---- (list art)))) (deffoo nndb-request-replace-article (article group buffer) ! "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) (let (art statmsg) *** pub/rgnus/lisp/nndir.el Sun Mar 2 04:47:18 1997 --- rgnus/lisp/nndir.el Fri Mar 7 23:51:29 1997 *************** *** 73,84 **** defs) (nnoo-change-server 'nndir server defs) (let (err) ! (cond ((not (condition-case arg (file-exists-p nndir-directory) (ftp-error (setq err (format "%s" arg))))) (nndir-close-server) ! (nnheader-report 'nndir (or err "No such file or directory: %s" nndir-directory))) ((not (file-directory-p (file-truename nndir-directory))) (nndir-close-server) --- 73,84 ---- defs) (nnoo-change-server 'nndir server defs) (let (err) ! (cond ((not (condition-case arg (file-exists-p nndir-directory) (ftp-error (setq err (format "%s" arg))))) (nndir-close-server) ! (nnheader-report 'nndir (or err "No such file or directory: %s" nndir-directory))) ((not (file-directory-p (file-truename nndir-directory))) (nndir-close-server) *** pub/rgnus/lisp/nndoc.el Sun Mar 2 04:47:18 1997 --- rgnus/lisp/nndoc.el Fri Mar 7 23:51:29 1997 *************** *** 43,50 **** (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") ! (defvar nndoc-type-alist ! `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) (news --- 43,50 ---- (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") ! (defvar nndoc-type-alist ! `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) (news *************** *** 52,61 **** (rnews (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") (body-end-function . nndoc-rnews-body-end)) ! (mbox (article-begin-function . nndoc-mbox-article-begin) (body-end-function . nndoc-mbox-body-end)) ! (babyl (article-begin . "\^_\^L *\n") (body-end . "\^_") (body-begin-function . nndoc-babyl-body-begin) --- 52,61 ---- (rnews (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") (body-end-function . nndoc-rnews-body-end)) ! (mbox (article-begin-function . nndoc-mbox-article-begin) (body-end-function . nndoc-mbox-body-end)) ! (babyl (article-begin . "\^_\^L *\n") (body-end . "\^_") (body-begin-function . nndoc-babyl-body-begin) *************** *** 108,114 **** (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) ! (guess (guess . t) (subtype nil)) (digest --- 108,114 ---- (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) ! (guess (guess . t) (subtype nil)) (digest *************** *** 190,200 **** (when entry (if (stringp article) nil ! (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry)) (insert "\n") (setq beg (point)) ! (insert-buffer-substring nndoc-current-buffer (nth 2 entry) (nth 3 entry)) (goto-char beg) (when nndoc-prepare-body-function --- 190,200 ---- (when entry (if (stringp article) nil ! (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry)) (insert "\n") (setq beg (point)) ! (insert-buffer-substring nndoc-current-buffer (nth 2 entry) (nth 3 entry)) (goto-char beg) (when nndoc-prepare-body-function *************** *** 206,212 **** (deffoo nndoc-request-group (group &optional server dont-check) "Select news GROUP." (let (number) ! (cond ((not (nndoc-possibly-change-buffer group server)) (nnheader-report 'nndoc "No such file or buffer: %s" nndoc-address)) --- 206,212 ---- (deffoo nndoc-request-group (group &optional server dont-check) "Select news GROUP." (let (number) ! (cond ((not (nndoc-possibly-change-buffer group server)) (nnheader-report 'nndoc "No such file or buffer: %s" nndoc-address)) *************** *** 250,273 **** (defun nndoc-possibly-change-buffer (group source) (let (buf) ! (cond ;; The current buffer is this group's buffer. ((and nndoc-current-buffer (buffer-name nndoc-current-buffer) ! (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) ;; We change buffers by taking an old from the group alist. ! ;; `source' is either a string (a file name) or a buffer object. (buf (setq nndoc-current-buffer buf)) ! ;; It's a totally new group. ((or (and (bufferp nndoc-address) (buffer-name nndoc-address)) (and (stringp nndoc-address) (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) ! (push (cons group (setq nndoc-current-buffer ! (get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist) (setq nndoc-dissection-alist nil) --- 250,273 ---- (defun nndoc-possibly-change-buffer (group source) (let (buf) ! (cond ;; The current buffer is this group's buffer. ((and nndoc-current-buffer (buffer-name nndoc-current-buffer) ! (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) ;; We change buffers by taking an old from the group alist. ! ;; `source' is either a string (a file name) or a buffer object. (buf (setq nndoc-current-buffer buf)) ! ;; It's a totally new group. ((or (and (bufferp nndoc-address) (buffer-name nndoc-address)) (and (stringp nndoc-address) (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) ! (push (cons group (setq nndoc-current-buffer ! (get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist) (setq nndoc-dissection-alist nil) *************** *** 296,303 **** (defun nndoc-set-delims () "Set the nndoc delimiter variables according to the type of the document." ! (let ((vars '(nndoc-file-begin ! nndoc-first-article nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end --- 296,303 ---- (defun nndoc-set-delims () "Set the nndoc delimiter variables according to the type of the document." ! (let ((vars '(nndoc-file-begin ! nndoc-first-article nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end *************** *** 308,314 **** (set (pop vars) nil))) (let (defs) ;; Guess away until we find the real file type. ! (while (assq 'guess (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)))) (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) ;; Set the nndoc variables. --- 308,314 ---- (set (pop vars) nil))) (let (defs) ;; Guess away until we find the real file type. ! (while (assq 'guess (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)))) (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) ;; Set the nndoc variables. *************** *** 324,330 **** (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) (goto-char (point-min)) (when (numberp (setq result (funcall (intern ! (format "nndoc-%s-type-p" (car entry)))))) (push (cons result entry) results) (setq result nil)))) --- 324,330 ---- (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) (goto-char (point-min)) (when (numberp (setq result (funcall (intern ! (format "nndoc-%s-type-p" (car entry)))))) (push (cons result entry) results) (setq result nil)))) *************** *** 334,340 **** (car entry) (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2)))))))) ! ;;; ;;; Built-in type predicates and functions ;;; --- 334,340 ---- (car entry) (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2)))))))) ! ;;; ;;; Built-in type predicates and functions ;;; *************** *** 351,357 **** len end) (when (save-excursion ! (and (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq end (point)) (search-forward "\n\n" beg t) --- 351,357 ---- len end) (when (save-excursion ! (and (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq end (point)) (search-forward "\n\n" beg t) *************** *** 472,478 **** (defun nndoc-standard-digest-type-p () (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) ! (re-search-forward (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) t)) --- 472,478 ---- (defun nndoc-standard-digest-type-p () (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) ! (re-search-forward (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) t)) *************** *** 495,501 **** ;; (when (re-search-backward "^\\\\\\\\$" nil t) ;; (replace-match "" t t)) ) ! (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) (e-mail "no address given") --- 495,501 ---- ;; (when (re-search-backward "^\\\\\\\\$" nil t) ;; (replace-match "" t t)) ) ! (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) (e-mail "no address given") *************** *** 518,524 **** (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") "\nSubject: " (or subject "(no subject)") "\n"))) ! ;;; --- 518,524 ---- (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") "\nSubject: " (or subject "(no subject)") "\n"))) ! ;;; *************** *** 549,555 **** (setq first nil) (cond (nndoc-head-begin-function (funcall nndoc-head-begin-function)) ! (nndoc-head-begin (nndoc-search nndoc-head-begin))) (if (or (>= (point) (point-max)) (and nndoc-file-end --- 549,555 ---- (setq first nil) (cond (nndoc-head-begin-function (funcall nndoc-head-begin-function)) ! (nndoc-head-begin (nndoc-search nndoc-head-begin))) (if (or (>= (point) (point-max)) (and nndoc-file-end *** pub/rgnus/lisp/nndraft.el Thu Jan 9 11:59:34 1997 --- rgnus/lisp/nndraft.el Fri Mar 7 23:51:30 1997 *************** *** 63,69 **** 'headers (while articles (set-buffer buf) ! (when (nndraft-request-article (setq article (pop articles)) group server (current-buffer)) (goto-char (point-min)) (if (search-forward "\n\n" nil t) --- 63,69 ---- 'headers (while articles (set-buffer buf) ! (when (nndraft-request-article (setq article (pop articles)) group server (current-buffer)) (goto-char (point-min)) (if (search-forward "\n\n" nil t) *************** *** 83,89 **** (nnoo-change-server 'nndraft server defs) (unless (assq 'nndraft-directory defs) (setq nndraft-directory server)) ! (cond ((not (file-exists-p nndraft-directory)) (nndraft-close-server) (nnheader-report 'nndraft "No such file or directory: %s" --- 83,89 ---- (nnoo-change-server 'nndraft server defs) (unless (assq 'nndraft-directory defs) (setq nndraft-directory server)) ! (cond ((not (file-exists-p nndraft-directory)) (nndraft-close-server) (nnheader-report 'nndraft "No such file or directory: %s" *************** *** 98,104 **** (deffoo nndraft-request-article (id &optional group server buffer) (when (numberp id) ! ;; We get the newest file of the auto-saved file and the ;; "real" file. (let* ((file (nndraft-article-filename id)) (auto (nndraft-auto-save-file-name file)) --- 98,104 ---- (deffoo nndraft-request-article (id &optional group server buffer) (when (numberp id) ! ;; We get the newest file of the auto-saved file and the ;; "real" file. (let* ((file (nndraft-article-filename id)) (auto (nndraft-auto-save-file-name file)) *************** *** 106,115 **** (nntp-server-buffer (or buffer nntp-server-buffer))) (when (and (file-exists-p newest) (nnmail-find-file newest)) ! (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! ;; If there's a mail header separator in this file, ;; we remove it. (when (re-search-forward (concat "^" mail-header-separator "$") nil t) --- 106,115 ---- (nntp-server-buffer (or buffer nntp-server-buffer))) (when (and (file-exists-p newest) (nnmail-find-file newest)) ! (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! ;; If there's a mail header separator in this file, ;; we remove it. (when (re-search-forward (concat "^" mail-header-separator "$") nil t) *************** *** 163,169 **** (nndraft-execute-nnmh-command `(nnmh-request-newgroups ,date ,server))) ! (deffoo nndraft-request-expire-articles (articles group &optional server force) (let ((res (nndraft-execute-nnmh-command `(nnmh-request-expire-articles --- 163,169 ---- (nndraft-execute-nnmh-command `(nnmh-request-newgroups ,date ,server))) ! (deffoo nndraft-request-expire-articles (articles group &optional server force) (let ((res (nndraft-execute-nnmh-command `(nnmh-request-expire-articles *** pub/rgnus/lisp/nneething.el Thu Jan 9 11:59:34 1997 --- rgnus/lisp/nneething.el Fri Mar 7 23:51:30 1997 *************** *** 26,32 **** ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: --- 26,32 ---- ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: *************** *** 50,56 **** ! ;;; Internal variables. (defconst nneething-version "nneething 1.0" "nneething version.") --- 50,56 ---- ! ;;; Internal variables. (defconst nneething-version "nneething 1.0" "nneething version.") *************** *** 137,143 **** (if (> (car nneething-active) (cdr nneething-active)) (nnheader-insert "211 0 1 0 %s\n" group) (nnheader-insert ! "211 %d %d %d %s\n" (- (1+ (cdr nneething-active)) (car nneething-active)) (car nneething-active) (cdr nneething-active) group))) --- 137,143 ---- (if (> (car nneething-active) (cdr nneething-active)) (nnheader-insert "211 0 1 0 %s\n" group) (nnheader-insert ! "211 %d %d %d %s\n" (- (1+ (cdr nneething-active)) (car nneething-active)) (car nneething-active) (cdr nneething-active) group))) *************** *** 180,186 **** nneething-group-alist)))))) (defun nneething-map-file () ! ;; We make sure that the .nneething directory exists. (gnus-make-directory nneething-map-file-directory) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) --- 180,186 ---- nneething-group-alist)))))) (defun nneething-map-file () ! ;; We make sure that the .nneething directory exists. (gnus-make-directory nneething-map-file-directory) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) *************** *** 202,208 **** (setq nneething-map (mapcar (lambda (n) (list (cdr n) (car n) ! (nth 5 (file-attributes (nneething-file-name (car n)))))) nneething-map))) ;; Remove files matching the exclusion regexp. --- 202,208 ---- (setq nneething-map (mapcar (lambda (n) (list (cdr n) (car n) ! (nth 5 (file-attributes (nneething-file-name (car n)))))) nneething-map))) ;; Remove files matching the exclusion regexp. *************** *** 243,249 **** (nneething-file-name (car files))))) nneething-map)) (setq files (cdr files))) ! (when (and touched (not nneething-read-only)) (nnheader-temp-write map-file (insert "(setq nneething-map '") --- 243,249 ---- (nneething-file-name (car files))))) nneething-map)) (setq files (cdr files))) ! (when (and touched (not nneething-read-only)) (nnheader-temp-write map-file (insert "(setq nneething-map '") *************** *** 261,275 **** (defun nneething-make-head (file &optional buffer) "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) ! (insert "Subject: " (file-name-nondirectory file) "\n" ! "Message-ID: \n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) (or (when buffer ! (save-excursion (set-buffer buffer) (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) (concat "From: " (match-string 0) "\n")))) --- 261,275 ---- (defun nneething-make-head (file &optional buffer) "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) ! (insert "Subject: " (file-name-nondirectory file) "\n" ! "Message-ID: \n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) (or (when buffer ! (save-excursion (set-buffer buffer) (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) (concat "From: " (match-string 0) "\n")))) *************** *** 277,286 **** (if (> (string-to-int (int-to-string (nth 7 atts))) 0) (concat "Chars: " (int-to-string (nth 7 atts)) "\n") "") ! (if buffer (save-excursion (set-buffer buffer) ! (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) "") --- 277,286 ---- (if (> (string-to-int (int-to-string (nth 7 atts))) 0) (concat "Chars: " (int-to-string (nth 7 atts)) "\n") "") ! (if buffer (save-excursion (set-buffer buffer) ! (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) "") *************** *** 288,307 **** (defun nneething-from-line (uid &optional file) "Return a From header based of UID." ! (let* ((login (condition-case nil (user-login-name uid) ! (error (cond ((= uid (user-uid)) (user-login-name)) ((zerop uid) "root") (t (int-to-string uid)))))) ! (name (condition-case nil (user-full-name uid) ! (error (cond ((= uid (user-uid)) (user-full-name)) ((zerop uid) "Ms. Root"))))) (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) (prog1 ! (substring file (match-beginning 1) (match-end 1)) (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) --- 288,307 ---- (defun nneething-from-line (uid &optional file) "Return a From header based of UID." ! (let* ((login (condition-case nil (user-login-name uid) ! (error (cond ((= uid (user-uid)) (user-login-name)) ((zerop uid) "root") (t (int-to-string uid)))))) ! (name (condition-case nil (user-full-name uid) ! (error (cond ((= uid (user-uid)) (user-full-name)) ((zerop uid) "Ms. Root"))))) (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) (prog1 ! (substring file (match-beginning 1) (match-end 1)) (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) *************** *** 310,316 **** (match-end 2)) name nil))) (system-name)))) ! (concat "From: " login "@" host (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) --- 310,316 ---- (match-end 2)) name nil))) (system-name)))) ! (concat "From: " login "@" host (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) *************** *** 320,338 **** (setq case-fold-search nil) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (cond ((not (file-exists-p file)) ! ;; The file do not exist. nil) ((or (file-directory-p file) (file-symlink-p file)) ;; It's a dir, so we fudge a head. (nneething-make-head file) t) ! (t ;; We examine the file. (nnheader-insert-head file) (if (nnheader-article-p) ! (delete-region (progn (goto-char (point-min)) (or (and (search-forward "\n\n" nil t) --- 320,338 ---- (setq case-fold-search nil) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (cond ((not (file-exists-p file)) ! ;; The file do not exist. nil) ((or (file-directory-p file) (file-symlink-p file)) ;; It's a dir, so we fudge a head. (nneething-make-head file) t) ! (t ;; We examine the file. (nnheader-insert-head file) (if (nnheader-article-p) ! (delete-region (progn (goto-char (point-min)) (or (and (search-forward "\n\n" nil t) *** pub/rgnus/lisp/nnfolder.el Fri Mar 7 07:37:03 1997 --- rgnus/lisp/nnfolder.el Fri Mar 7 23:51:30 1997 *************** *** 39,45 **** (defvoo nnfolder-directory (expand-file-name message-directory) "The name of the nnfolder directory.") ! (defvoo nnfolder-active-file (nnheader-concat nnfolder-directory "active") "The name of the active file.") --- 39,45 ---- (defvoo nnfolder-directory (expand-file-name message-directory) "The name of the nnfolder directory.") ! (defvoo nnfolder-active-file (nnheader-concat nnfolder-directory "active") "The name of the active file.") *************** *** 49,55 **** (defvoo nnfolder-ignore-active-file nil "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. Note that the active file is still ! saved, but it's values are not used. This costs some extra time when scanning an mbox when opening it.") (defvoo nnfolder-distrust-mbox nil --- 49,55 ---- (defvoo nnfolder-ignore-active-file nil "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. Note that the active file is still ! saved, but it's values are not used. This costs some extra time when scanning an mbox when opening it.") (defvoo nnfolder-distrust-mbox nil *************** *** 59,65 **** When nil, scans occur forward from the last marked message, a huge time saver for large mailboxes.") ! (defvoo nnfolder-newsgroups-file (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") --- 59,65 ---- When nil, scans occur forward from the last marked message, a huge time saver for large mailboxes.") ! (defvoo nnfolder-newsgroups-file (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") *************** *** 137,143 **** (nnoo-change-server 'nnfolder server defs) (nnmail-activate 'nnfolder t) (gnus-make-directory nnfolder-directory) ! (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) (nnheader-report 'nnfolder "Couldn't create directory: %s" --- 137,143 ---- (nnoo-change-server 'nnfolder server defs) (nnmail-activate 'nnfolder t) (gnus-make-directory nnfolder-directory) ! (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) (nnheader-report 'nnfolder "Couldn't create directory: %s" *************** *** 188,195 **** (goto-char (point-min)) (search-forward (concat "\n" nnfolder-article-marker)) (cons nnfolder-current-group ! (string-to-int ! (buffer-substring (point) (progn (end-of-line) (point))))))))))) (deffoo nnfolder-request-group (group &optional server dont-check) --- 188,195 ---- (goto-char (point-min)) (search-forward (concat "\n" nnfolder-article-marker)) (cons nnfolder-current-group ! (string-to-int ! (buffer-substring (point) (progn (end-of-line) (point))))))))))) (deffoo nnfolder-request-group (group &optional server dont-check) *************** *** 199,231 **** (if (not (assoc group nnfolder-group-alist)) (nnheader-report 'nnfolder "No such group: %s" group) (if dont-check ! (progn (nnheader-report 'nnfolder "Selected group %s" group) t) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (cadr active))) ! (cond ((null active) (nnheader-report 'nnfolder "No such group: %s" group)) ((null nnfolder-current-group) (nnheader-report 'nnfolder "Empty group: %s" group)) (t (nnheader-report 'nnfolder "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr range) (car range))) (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group group server t) (nnmail-get-new-mail ! 'nnfolder (lambda () (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) (nnfolder-save-buffer) --- 199,231 ---- (if (not (assoc group nnfolder-group-alist)) (nnheader-report 'nnfolder "No such group: %s" group) (if dont-check ! (progn (nnheader-report 'nnfolder "Selected group %s" group) t) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (cadr active))) ! (cond ((null active) (nnheader-report 'nnfolder "No such group: %s" group)) ((null nnfolder-current-group) (nnheader-report 'nnfolder "Empty group: %s" group)) (t (nnheader-report 'nnfolder "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr range) (car range))) (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group group server t) (nnmail-get-new-mail ! 'nnfolder (lambda () (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) (nnfolder-save-buffer) *************** *** 271,277 **** (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) ! (when group (unless (assoc group nnfolder-group-alist) (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) --- 271,277 ---- (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) ! (when group (unless (assoc group nnfolder-group-alist) (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) *************** *** 293,318 **** (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) ! (deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) (nnfolder-possibly-change-group newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnfolder) ! (save-excursion (set-buffer nnfolder-current-buffer) (while (and articles is-old) (goto-char (point-min)) (when (search-forward (nnfolder-article-string (car articles)) nil t) (if (setq is-old ! (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) (progn ! (nnheader-message 5 "Deleting article %d..." (car articles) newsgroup) (nnfolder-delete-mail)) (push (car articles) rest))) --- 293,318 ---- (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) ! (deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) (nnfolder-possibly-change-group newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnfolder) ! (save-excursion (set-buffer nnfolder-current-buffer) (while (and articles is-old) (goto-char (point-min)) (when (search-forward (nnfolder-article-string (car articles)) nil t) (if (setq is-old ! (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) (progn ! (nnheader-message 5 "Deleting article %d..." (car articles) newsgroup) (nnfolder-delete-mail)) (push (car articles) rest))) *************** *** 340,346 **** (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnfolder move*")) result) ! (and (nnfolder-request-article article group server) (save-excursion (set-buffer buf) --- 340,346 ---- (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnfolder move*")) result) ! (and (nnfolder-request-article article group server) (save-excursion (set-buffer buf) *************** *** 348,354 **** (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward (concat "^" nnfolder-article-marker) (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) --- 348,354 ---- (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward (concat "^" nnfolder-article-marker) (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) *************** *** 373,379 **** (goto-char (point-min)) (when (looking-at "X-From-Line: ") (replace-match "From ")) ! (and (nnfolder-request-list) (save-excursion (set-buffer buf) --- 373,379 ---- (goto-char (point-min)) (when (looking-at "X-From-Line: ") (replace-match "From ")) ! (and (nnfolder-request-list) (save-excursion (set-buffer buf) *************** *** 382,389 **** (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) ! (when nnmail-cache-message-id-when-accepting ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (car (nnfolder-save-mail (if (stringp group) --- 382,388 ---- (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) ! (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnfolder-save-mail (if (stringp group) *************** *** 421,427 **** (ignore-errors (delete-file (nnfolder-group-pathname group)))) ;; Remove the group from all structures. ! (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) nnfolder-current-group nil nnfolder-current-buffer nil) --- 420,426 ---- (ignore-errors (delete-file (nnfolder-group-pathname group)))) ;; Remove the group from all structures. ! (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) nnfolder-current-group nil nnfolder-current-buffer nil) *************** *** 435,441 **** (set-buffer nnfolder-current-buffer) (and (file-writable-p buffer-file-name) (ignore-errors ! (rename-file buffer-file-name (nnfolder-group-pathname new-name)) t) --- 434,440 ---- (set-buffer nnfolder-current-buffer) (and (file-writable-p buffer-file-name) (ignore-errors ! (rename-file buffer-file-name (nnfolder-group-pathname new-name)) t) *************** *** 489,495 **** ;; The group doesn't exist, so we create a new entry for it. (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) ! (let (inf file) ;; If we have to change groups, see if we don't already have the ;; folder in memory. If we do, verify the modtime and destroy --- 488,494 ---- ;; The group doesn't exist, so we create a new entry for it. (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) ! (let (inf file) ;; If we have to change groups, see if we don't already have the ;; folder in memory. If we do, verify the modtime and destroy *************** *** 506,512 **** nnfolder-current-buffer nil)) (setq nnfolder-current-group group) ! (when (or (not nnfolder-current-buffer) (not (verify-visited-file-modtime nnfolder-current-buffer))) (save-excursion --- 505,511 ---- nnfolder-current-buffer nil)) (setq nnfolder-current-group group) ! (when (or (not nnfolder-current-buffer) (not (verify-visited-file-modtime nnfolder-current-buffer))) (save-excursion *************** *** 527,533 **** ;; The From line may have been quoted by movemail. (when (looking-at (concat ">" message-unix-mail-delimiter)) (delete-char 1)) ! ;; This might come from somewhere else. (unless (looking-at message-unix-mail-delimiter) (insert "From nobody " (current-time-string) "\n") (goto-char (point-min))) --- 526,532 ---- ;; The From line may have been quoted by movemail. (when (looking-at (concat ">" message-unix-mail-delimiter)) (delete-char 1)) ! ;; This might come from somewhere else. (unless (looking-at message-unix-mail-delimiter) (insert "From nobody " (current-time-string) "\n") (goto-char (point-min))) *************** *** 678,684 **** (setq start (marker-position end)) (goto-char end) ;; There may be more than one "From " line, so we skip past ! ;; them. (while (looking-at delim) (forward-line 1)) (set-marker end (if (nnmail-search-unix-mail-delim) --- 677,683 ---- (setq start (marker-position end)) (goto-char end) ;; There may be more than one "From " line, so we skip past ! ;; them. (while (looking-at delim) (forward-line 1)) (set-marker end (if (nnmail-search-unix-mail-delim) *************** *** 724,730 **** "Make pathname for GROUP." (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. ! (if (or nnmail-use-long-file-names (file-exists-p (concat dir group))) (concat dir group) ;; If not, we translate dots into slashes. --- 723,729 ---- "Make pathname for GROUP." (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. ! (if (or nnmail-use-long-file-names (file-exists-p (concat dir group))) (concat dir group) ;; If not, we translate dots into slashes. *** pub/rgnus/lisp/nngateway.el Thu Jan 9 11:59:34 1997 --- rgnus/lisp/nngateway.el Fri Mar 7 23:51:30 1997 *************** *** 74,80 **** "@" gateway "\n"))) (nnoo-define-skeleton nngateway) ! (provide 'nngateway) ;;; nngateway.el ends here --- 74,80 ---- "@" gateway "\n"))) (nnoo-define-skeleton nngateway) ! (provide 'nngateway) ;;; nngateway.el ends here *** pub/rgnus/lisp/nnheader.el Fri Mar 7 07:37:03 1997 --- rgnus/lisp/nnheader.el Fri Mar 7 23:51:31 1997 *************** *** 144,150 **** references chars lines xref) "Create a new mail header structure initialized with the parameters given." (vector number subject from date id references chars lines xref)) ! ;; fake message-ids: generation and detection (defvar nnheader-fake-message-id 1) --- 144,150 ---- references chars lines xref) "Create a new mail header structure initialized with the parameters given." (vector number subject from date id references chars lines xref)) ! ;; fake message-ids: generation and detection (defvar nnheader-fake-message-id 1) *************** *** 283,289 **** (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) ! (insert "\t" (or (mail-header-subject header) "(none)") "\t" (or (mail-header-from header) "(nobody)") "\t" --- 283,289 ---- (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) ! (insert "\t" (or (mail-header-subject header) "(none)") "\t" (or (mail-header-from header) "(nobody)") "\t" *************** *** 315,321 **** ;; First we find the first wanted line. (nnheader-find-nov-line beg) (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. (when (nnheader-find-nov-line end) (forward-line 1)) (delete-region (point) (point-max))) --- 315,321 ---- ;; First we find the first wanted line. (nnheader-find-nov-line beg) (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. (when (nnheader-find-nov-line end) (forward-line 1)) (delete-region (point) (point-max))) *************** *** 531,537 **** (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) ! (concat "\\([0-9]+\\)\\(" (mapconcat (lambda (i) (aref i 0)) jka-compr-compression-info-list "\\|") "\\)?") --- 531,537 ---- (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) ! (concat "\\([0-9]+\\)\\(" (mapconcat (lambda (i) (aref i 0)) jka-compr-compression-info-list "\\|") "\\)?") *************** *** 554,560 **** (defun nnheader-directory-files-safe (&rest args) ;; It has been reported numerous times that `directory-files' ;; fails with an alarming frequency on NFS mounted file systems. ! ;; This function executes that function twice and returns ;; the longest result. (let ((first (apply 'directory-files args)) (second (apply 'directory-files args))) --- 554,560 ---- (defun nnheader-directory-files-safe (&rest args) ;; It has been reported numerous times that `directory-files' ;; fails with an alarming frequency on NFS mounted file systems. ! ;; This function executes that function twice and returns ;; the longest result. (let ((first (apply 'directory-files args)) (second (apply 'directory-files args))) *************** *** 581,587 **** (defun nnheader-translate-file-chars (file) (if (null nnheader-file-name-translation-alist) ;; No translation is necessary. ! file ;; We translate -- but only the file name. We leave the directory ;; alone. (let* ((i 0) --- 581,587 ---- (defun nnheader-translate-file-chars (file) (if (null nnheader-file-name-translation-alist) ;; No translation is necessary. ! file ;; We translate -- but only the file name. We leave the directory ;; alone. (let* ((i 0) *************** *** 643,654 **** (defun nnheader-file-to-group (file &optional top) "Return a group name based on FILE and TOP." ! (nnheader-replace-chars-in-string (if (not top) file (condition-case () (substring (expand-file-name file) ! (length (expand-file-name (file-name-as-directory top)))) (error ""))) --- 643,654 ---- (defun nnheader-file-to-group (file &optional top) "Return a group name based on FILE and TOP." ! (nnheader-replace-chars-in-string (if (not top) file (condition-case () (substring (expand-file-name file) ! (length (expand-file-name (file-name-as-directory top)))) (error ""))) *************** *** 712,718 **** (setq dir (concat (file-name-directory (directory-file-name (car path))) ! "etc/" package (if file "" "/")))) (or file (file-directory-p dir))) (setq result dir --- 712,718 ---- (setq dir (concat (file-name-directory (directory-file-name (car path))) ! "etc/" package (if file "" "/")))) (or file (file-directory-p dir))) (setq result dir *************** *** 781,793 **** (goto-char (point-min)) (while (,(if regexp 're-search-forward 'search-forward) ,from nil t) ! (insert-buffer-substring cur start (prog1 (match-beginning 0) (set-buffer new))) (goto-char (point-max)) ,(when to `(insert ,to)) (set-buffer cur) (setq start (point))) ! (insert-buffer-substring cur start (prog1 (point-max) (set-buffer new))) (copy-to-buffer cur (point-min) (point-max)) (kill-buffer (current-buffer)) --- 781,793 ---- (goto-char (point-min)) (while (,(if regexp 're-search-forward 'search-forward) ,from nil t) ! (insert-buffer-substring cur start (prog1 (match-beginning 0) (set-buffer new))) (goto-char (point-max)) ,(when to `(insert ,to)) (set-buffer cur) (setq start (point))) ! (insert-buffer-substring cur start (prog1 (point-max) (set-buffer new))) (copy-to-buffer cur (point-min) (point-max)) (kill-buffer (current-buffer)) *** pub/rgnus/lisp/nnkiboze.el Tue Feb 18 23:29:04 1997 --- rgnus/lisp/nnkiboze.el Fri Mar 7 23:51:31 1997 *************** *** 193,199 **** (while (setq info (pop newsrc)) (when (string-match "nnkiboze" (gnus-info-group info)) ;; For each kiboze group, we call this function to generate ! ;; it. (nnkiboze-generate-group (gnus-info-group info)))))) (defun nnkiboze-score-file (group) --- 193,199 ---- (while (setq info (pop newsrc)) (when (string-match "nnkiboze" (gnus-info-group info)) ;; For each kiboze group, we call this function to generate ! ;; it. (nnkiboze-generate-group (gnus-info-group info)))))) (defun nnkiboze-score-file (group) *************** *** 214,221 **** (gnus-large-newsgroup nil) (gnus-score-find-score-files-function 'nnkiboze-score-file) (gnus-verbose (min gnus-verbose 3)) ! gnus-select-group-hook gnus-summary-prepare-hook ! gnus-thread-sort-functions gnus-show-threads gnus-visual gnus-suppress-duplicates) (unless info (error "No such group: %s" group)) --- 214,221 ---- (gnus-large-newsgroup nil) (gnus-score-find-score-files-function 'nnkiboze-score-file) (gnus-verbose (min gnus-verbose 3)) ! gnus-select-group-hook gnus-summary-prepare-hook ! gnus-thread-sort-functions gnus-show-threads gnus-visual gnus-suppress-duplicates) (unless info (error "No such group: %s" group)) *************** *** 226,232 **** (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) ! ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. (mapatoms (lambda (group) --- 226,232 ---- (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) ! ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. (mapatoms (lambda (group) *************** *** 248,260 **** ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc ! (if (not (setq active (gnus-gethash (caar newsrc) gnus-active-hashtb))) ;; This group isn't active after all, so we remove it from ;; the list of component groups. (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) (setq lowest (cdar newsrc)) ! ;; Ok, we have a valid component group, so we jump to it. (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group (caar newsrc)) (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) --- 248,260 ---- ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc ! (if (not (setq active (gnus-gethash (caar newsrc) gnus-active-hashtb))) ;; This group isn't active after all, so we remove it from ;; the list of component groups. (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) (setq lowest (cdar newsrc)) ! ;; Ok, we have a valid component group, so we jump to it. (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group (caar newsrc)) (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) *************** *** 268,286 **** (when (nth 3 ginfo) (setcar (nthcdr 3 ginfo) nil)) ;; We set the list of read articles to be what we expect for ! ;; this kiboze group -- either nil or `(1 . LOWEST)'. (when ginfo (setcar (nthcdr 2 ginfo) (and (not (= lowest 1)) (cons 1 lowest)))) (when (and (or (not ginfo) ! (> (length (gnus-list-of-unread-articles (car ginfo))) 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode))) ;; We are now in the group where we want to be. ! (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (when (eq method gnus-select-method) (setq method nil)) --- 268,286 ---- (when (nth 3 ginfo) (setcar (nthcdr 3 ginfo) nil)) ;; We set the list of read articles to be what we expect for ! ;; this kiboze group -- either nil or `(1 . LOWEST)'. (when ginfo (setcar (nthcdr 2 ginfo) (and (not (= lowest 1)) (cons 1 lowest)))) (when (and (or (not ginfo) ! (> (length (gnus-list-of-unread-articles (car ginfo))) 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode))) ;; We are now in the group where we want to be. ! (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (when (eq method gnus-select-method) (setq method nil)) *************** *** 289,297 **** (when (> (caar gnus-newsgroup-scored) lowest) ;; If it has a good score, then we enter this article ;; into the kiboze group. ! (nnkiboze-enter-nov nov-buffer ! (gnus-summary-article-header (caar gnus-newsgroup-scored)) gnus-newsgroup-name)) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) --- 289,297 ---- (when (> (caar gnus-newsgroup-scored) lowest) ;; If it has a good score, then we enter this article ;; into the kiboze group. ! (nnkiboze-enter-nov nov-buffer ! (gnus-summary-article-header (caar gnus-newsgroup-scored)) gnus-newsgroup-name)) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) *************** *** 309,315 **** (gnus-prin1 nnkiboze-newsrc) (insert ")\n")) t)) ! (defun nnkiboze-enter-nov (buffer header group) (save-excursion (set-buffer buffer) --- 309,315 ---- (gnus-prin1 nnkiboze-newsrc) (insert ")\n")) t)) ! (defun nnkiboze-enter-nov (buffer header group) (save-excursion (set-buffer buffer) *************** *** 333,339 **** ;; The first Xref has to be the group this article ;; really came for - this is the article nnkiboze ;; will request when it is asked for the article. ! (insert group ":" (int-to-string (mail-header-number header)) " ") (while (re-search-forward " [^ ]+:[0-9]+" nil t) (goto-char (1+ (match-beginning 0))) --- 333,339 ---- ;; The first Xref has to be the group this article ;; really came for - this is the article nnkiboze ;; will request when it is asked for the article. ! (insert group ":" (int-to-string (mail-header-number header)) " ") (while (re-search-forward " [^ ]+:[0-9]+" nil t) (goto-char (1+ (match-beginning 0))) *** pub/rgnus/lisp/nnmail.el Fri Mar 7 07:37:03 1997 --- rgnus/lisp/nnmail.el Fri Mar 7 23:51:32 1997 *************** *** 112,118 **** ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil ! "If non-nil, nnmail will never delete the last expired article in a directory. You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired." :group 'nnmail-procmail --- 112,118 ---- ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil ! "If non-nil, nnmail will never delete the last expired article in a directory. You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired." :group 'nnmail-procmail *************** *** 160,166 **** :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) ! (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) "Where the mail backends will look for incoming mail. --- 160,166 ---- :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) ! (defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) "Where the mail backends will look for incoming mail. *************** *** 233,239 **** :group 'nnmail-retrieve :type 'boolean) ! (defcustom nnmail-read-incoming-hook (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) --- 233,239 ---- :group 'nnmail-retrieve :type 'boolean) ! (defcustom nnmail-read-incoming-hook (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) *************** *** 246,258 **** Eg. ! \(add-hook 'nnmail-read-incoming-hook (lambda () ! (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\"))) If you have xwatch running, this will alert it that mail has been ! read. If you use `display-time', you could use something like this: --- 246,258 ---- Eg. ! \(add-hook 'nnmail-read-incoming-hook (lambda () ! (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\"))) If you have xwatch running, this will alert it that mail has been ! read. If you use `display-time', you could use something like this: *************** *** 333,346 **** The format is this variable is SPLIT, where SPLIT can be one of the following: ! GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail ! message to be stored in one or more groups. \(& SPLIT...): Process each SPLIT expression. --- 333,346 ---- The format is this variable is SPLIT, where SPLIT can be one of the following: ! GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail ! message to be stored in one or more groups. \(& SPLIT...): Process each SPLIT expression. *************** *** 425,435 **** (const warn) (const delete))) - (defvar nnmail-cache-message-id-when-accepting nil - "If non-nil put the Message-ID: of incoming messages in the message ID cache. - Not doing so is dangerous, but it is how Gnus used to work for a long - time.") - ;;; Internal variables. (defvar nnmail-split-history nil --- 425,430 ---- *************** *** 479,485 **** (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. ! (if (or nnmail-use-long-file-names (file-directory-p (concat dir group))) (concat dir group "/") ;; If not, we translate dots into slashes. --- 474,480 ---- (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. ! (if (or nnmail-use-long-file-names (file-directory-p (concat dir group))) (concat dir group "/") ;; If not, we translate dots into slashes. *************** *** 571,577 **** (message "Getting mail from %s..." inbox))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file INBOX to TOFILE if and as appropriate. ! (cond ((file-exists-p tofile) ;; The crash box exists already. t) --- 566,572 ---- (message "Getting mail from %s..." inbox))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file INBOX to TOFILE if and as appropriate. ! (cond ((file-exists-p tofile) ;; The crash box exists already. t) *************** *** 599,609 **** (insert (prin1-to-string err)) (setq result 255)))) (setq result ! (apply 'call-process (append (list ! (expand-file-name nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password --- 594,604 ---- (insert (prin1-to-string err)) (setq result 255)))) (setq result ! (apply 'call-process (append (list ! (expand-file-name nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password *************** *** 653,659 **** (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) ;; We create an alist with `(GROUP (LOW . HIGH))' elements. (push (list (match-string 1) --- 648,654 ---- (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) ;; We create an alist with `(GROUP (LOW . HIGH))' elements. (push (list (match-string 1) *************** *** 692,698 **** (let ((procmail-group (substring (expand-file-name file) (match-beginning 1) (match-end 1)))) ! (if group (if (string-equal group procmail-group) group nil) --- 687,693 ---- (let ((procmail-group (substring (expand-file-name file) (match-beginning 1) (match-end 1)))) ! (if group (if (string-equal group procmail-group) group nil) *************** *** 739,748 **** "\n"))) ;; Look for a Content-Length header. (if (not (save-excursion ! (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) (setq content-length (string-to-int ! (buffer-substring (match-beginning 1) (match-end 1)))) ;; We destroy the header, since none of --- 734,743 ---- "\n"))) ;; Look for a Content-Length header. (if (not (save-excursion ! (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) (setq content-length (string-to-int ! (buffer-substring (match-beginning 1) (match-end 1)))) ;; We destroy the header, since none of *************** *** 762,768 **** (setq do-search t))) (widen) ;; Go to the beginning of the next article - or to the end ! ;; of the buffer. (when do-search (if (re-search-forward "^" nil t) (goto-char (match-beginning 0)) --- 757,763 ---- (setq do-search t))) (widen) ;; Go to the beginning of the next article - or to the end ! ;; of the buffer. (when do-search (if (re-search-forward "^" nil t) (goto-char (match-beginning 0)) *************** *** 848,854 **** end nil) ;; Find the end of the head. (narrow-to-region ! start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- --- 843,849 ---- end nil) ;; Find the end of the head. (narrow-to-region ! start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- *************** *** 874,880 **** "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) (setq content-length (string-to-int (match-string 1))) ! ;; We destroy the header, since none of the backends ever ;; use it, and we do not want to confuse other mailers by ;; having a (possibly) faulty header. (beginning-of-line) --- 869,875 ---- "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) (setq content-length (string-to-int (match-string 1))) ! ;; We destroy the header, since none of the backends ever ;; use it, and we do not want to confuse other mailers by ;; having a (possibly) faulty header. (beginning-of-line) *************** *** 904,910 **** (t (setq end nil)))) (if end (goto-char end) ! ;; No Content-Length, so we find the beginning of the next ;; article or the end of the buffer. (goto-char head-end) (or (nnmail-search-unix-mail-delim) --- 899,905 ---- (t (setq end nil)))) (if end (goto-char end) ! ;; No Content-Length, so we find the beginning of the next ;; article or the end of the buffer. (goto-char head-end) (or (nnmail-search-unix-mail-delim) *************** *** 932,938 **** (setq start (point)) ;; Find the end of the head. (narrow-to-region ! start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- --- 927,933 ---- (setq start (point)) ;; Find the end of the head. (narrow-to-region ! start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- *************** *** 1004,1010 **** (funcall exit-func)) (kill-buffer (current-buffer))))) ! ;; Mail crossposts suggested by Brian Edmonds . (defun nnmail-article-group (func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." --- 999,1005 ---- (funcall exit-func)) (kill-buffer (current-buffer))))) ! ;; Mail crossposts suggested by Brian Edmonds . (defun nnmail-article-group (func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." *************** *** 1039,1050 **** (or (funcall nnmail-split-methods) '("bogus")) (error ! (message "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (unless (equal split '(junk)) ! ;; `nnmail-split-methods' is a function, so we just call ;; this function here and use the result. (setq group-art (mapcar --- 1034,1045 ---- (or (funcall nnmail-split-methods) '("bogus")) (error ! (message "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (unless (equal split '(junk)) ! ;; `nnmail-split-methods' is a function, so we just call ;; this function here and use the result. (setq group-art (mapcar *************** *** 1062,1076 **** (re-search-backward (cadr method) nil t) ;; Function to say whether this is a match. (funcall (nth 1 method) (car method)))) ! ;; Don't enter the article into the same ;; group twice. (not (assoc (car method) group-art))) (push (cons (car method) (funcall func (car method))) group-art)) ! ;; This is the final group, which is used as a ;; catch-all. (unless group-art ! (setq group-art (list (cons (car method) (funcall func (car method))))))))) ;; See whether the split methods returned `junk'. --- 1057,1071 ---- (re-search-backward (cadr method) nil t) ;; Function to say whether this is a match. (funcall (nth 1 method) (car method)))) ! ;; Don't enter the article into the same ;; group twice. (not (assoc (car method) group-art))) (push (cons (car method) (funcall func (car method))) group-art)) ! ;; This is the final group, which is used as a ;; catch-all. (unless group-art ! (setq group-art (list (cons (car method) (funcall func (car method))))))))) ;; See whether the split methods returned `junk'. *************** *** 1275,1288 **** (if (null nnmail-spool-file) ;; No spool file whatsoever. nil ! (let* ((procmails ;; If procmail is used to get incoming mail, the files ;; are stored in this directory. (and (file-exists-p nnmail-procmail-directory) (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) ! (directory-files ! nnmail-procmail-directory t (concat (if group (concat "^" group) "") nnmail-procmail-suffix "$")))) (p procmails) --- 1270,1283 ---- (if (null nnmail-spool-file) ;; No spool file whatsoever. nil ! (let* ((procmails ;; If procmail is used to get incoming mail, the files ;; are stored in this directory. (and (file-exists-p nnmail-procmail-directory) (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) ! (directory-files ! nnmail-procmail-directory t (concat (if group (concat "^" group) "") nnmail-procmail-suffix "$")))) (p procmails) *************** *** 1292,1304 **** 0)) (list nnmail-crash-box)))) ;; Remove any directories that inadvertently match the procmail ! ;; suffix, which might happen if the suffix is "". (while p (when (file-directory-p (car p)) (setq procmails (delete (car p) procmails))) (setq p (cdr p))) ;; Return the list of spools. ! (append crash (cond ((and group (or (eq nnmail-spool-file 'procmail) --- 1287,1299 ---- 0)) (list nnmail-crash-box)))) ;; Remove any directories that inadvertently match the procmail ! ;; suffix, which might happen if the suffix is "". (while p (when (file-directory-p (car p)) (setq procmails (delete (car p) procmails))) (setq p (cdr p))) ;; Return the list of spools. ! (append crash (cond ((and group (or (eq nnmail-spool-file 'procmail) *************** *** 1310,1318 **** nil) ((listp nnmail-spool-file) (nconc ! (apply 'nconc ! (mapcar (lambda (file) (if (and (not (string-match "^po:" file)) (file-directory-p file)) --- 1305,1313 ---- nil) ((listp nnmail-spool-file) (nconc ! (apply 'nconc ! (mapcar (lambda (file) (if (and (not (string-match "^po:" file)) (file-directory-p file)) *************** *** 1323,1329 **** ((stringp nnmail-spool-file) (if (and (not (string-match "^po:" nnmail-spool-file)) (file-directory-p nnmail-spool-file)) ! (nconc (nnheader-directory-regular-files nnmail-spool-file) procmails) (cons nnmail-spool-file procmails))) --- 1318,1324 ---- ((stringp nnmail-spool-file) (if (and (not (string-match "^po:" nnmail-spool-file)) (file-directory-p nnmail-spool-file)) ! (nconc (nnheader-directory-regular-files nnmail-spool-file) procmails) (cons nnmail-spool-file procmails))) *************** *** 1332,1353 **** (t procmails)))))) ! ;; Activate a backend only if it isn't already activated. ! ;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force (and (setq file (ignore-errors ! (symbol-value (intern (format "%s-active-file" backend))))) (setq file-time (nth 5 (file-attributes file))) (or (not (setq timestamp (condition-case () (symbol-value (intern ! (format "%s-active-timestamp" backend))) (error 'none)))) (not (consp timestamp)) --- 1327,1348 ---- (t procmails)))))) ! ;; Activate a backend only if it isn't already activated. ! ;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force (and (setq file (ignore-errors ! (symbol-value (intern (format "%s-active-file" backend))))) (setq file-time (nth 5 (file-attributes file))) (or (not (setq timestamp (condition-case () (symbol-value (intern ! (format "%s-active-timestamp" backend))) (error 'none)))) (not (consp timestamp)) *************** *** 1357,1363 **** (> (nth 1 file-time) (nth 1 timestamp)))))) (save-excursion (or (eq timestamp 'none) ! (set (intern (format "%s-active-timestamp" backend)) file-time)) (funcall (intern (format "%s-request-list" backend))))) t)) --- 1352,1358 ---- (> (nth 1 file-time) (nth 1 timestamp)))))) (save-excursion (or (eq timestamp 'none) ! (set (intern (format "%s-active-timestamp" backend)) file-time)) (funcall (intern (format "%s-request-list" backend))))) t)) *************** *** 1377,1384 **** (buffer-name nnmail-cache-buffer))) () ; The buffer is open. (save-excursion ! (set-buffer ! (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) --- 1372,1379 ---- (buffer-name nnmail-cache-buffer))) () ; The buffer is open. (save-excursion ! (set-buffer ! (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) *************** *** 1455,1472 **** (setq group-art nil)) ((eq action 'warn) ;; We insert a warning. ! (let ((case-fold-search t) ! (newid (concat "<" (message-unique-id) ! "@duplicate-message-id>"))) (goto-char (point-min)) ! (when (re-search-forward "^message-id[ \t]*:" nil t) ! (beginning-of-line) ! (insert "Original-")) (beginning-of-line) ! (insert ! "Message-ID: " newid "\n" "Gnus-Warning: This is a duplicate of message " message-id "\n") - (nnmail-cache-insert newid) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))))) (t --- 1450,1461 ---- (setq group-art nil)) ((eq action 'warn) ;; We insert a warning. ! (let ((case-fold-search t)) (goto-char (point-min)) ! (re-search-forward "^message-id[ \t]*:" nil t) (beginning-of-line) ! (insert "Gnus-Warning: This is a duplicate of message " message-id "\n") (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))))) (t *************** *** 1518,1541 **** ;; is supposed to go to some specific group. (setq group (nnmail-get-split-group spool group-in)) ;; We split the mail ! (nnmail-split-incoming nnmail-crash-box (intern (format "%s-save-mail" method)) spool-func group (intern (format "%s-active-number" method))) ! ;; Check whether the inbox is to be moved to the special tmp dir. (setq incoming ! (nnmail-make-complex-temp-name ! (expand-file-name (if nnmail-tmp-directory ! (concat (file-name-as-directory nnmail-tmp-directory) (file-name-nondirectory (concat (file-name-as-directory temp) "Incoming"))) (concat (file-name-as-directory temp) "Incoming"))))) (rename-file nnmail-crash-box incoming t) (push incoming incomings)))) ! ;; If we did indeed read any incoming spools, we save all info. (when incomings ! (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) (when exit-func --- 1507,1530 ---- ;; is supposed to go to some specific group. (setq group (nnmail-get-split-group spool group-in)) ;; We split the mail ! (nnmail-split-incoming nnmail-crash-box (intern (format "%s-save-mail" method)) spool-func group (intern (format "%s-active-number" method))) ! ;; Check whether the inbox is to be moved to the special tmp dir. (setq incoming ! (nnmail-make-complex-temp-name ! (expand-file-name (if nnmail-tmp-directory ! (concat (file-name-as-directory nnmail-tmp-directory) (file-name-nondirectory (concat (file-name-as-directory temp) "Incoming"))) (concat (file-name-as-directory temp) "Incoming"))))) (rename-file nnmail-crash-box incoming t) (push incoming incomings)))) ! ;; If we did indeed read any incoming spools, we save all info. (when incomings ! (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) (when exit-func *************** *** 1700,1706 **** (pop3-movemail crashbox))) (run-hooks 'nnmail-load-hook) ! (provide 'nnmail) ;;; nnmail.el ends here --- 1689,1695 ---- (pop3-movemail crashbox))) (run-hooks 'nnmail-load-hook) ! (provide 'nnmail) ;;; nnmail.el ends here *** pub/rgnus/lisp/nnmbox.el Fri Mar 7 07:37:04 1997 --- rgnus/lisp/nnmbox.el Fri Mar 7 23:51:32 1997 *************** *** 25,31 **** ;;; Commentary: ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: --- 25,31 ---- ;;; Commentary: ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: *************** *** 85,93 **** (when (or (search-forward art-string nil t) (progn (goto-char (point-min)) (search-forward art-string nil t))) ! (setq start (save-excursion ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) --- 85,93 ---- (when (or (search-forward art-string nil t) (progn (goto-char (point-min)) (search-forward art-string nil t))) ! (setq start (save-excursion ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) *************** *** 116,122 **** (deffoo nnmbox-open-server (server &optional defs) (nnoo-change-server 'nnmbox server defs) (nnmbox-create-mbox) ! (cond ((not (file-exists-p nnmbox-mbox-file)) (nnmbox-close-server) (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) --- 116,122 ---- (deffoo nnmbox-open-server (server &optional defs) (nnoo-change-server 'nnmbox server defs) (nnmbox-create-mbox) ! (cond ((not (file-exists-p nnmbox-mbox-file)) (nnmbox-close-server) (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) *************** *** 152,158 **** (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) ! (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) --- 152,158 ---- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) ! (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) *************** *** 172,178 **** (deffoo nnmbox-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnmbox-group-alist)))) ! (cond ((or (null active) (null (nnmbox-possibly-change-newsgroup group server))) (nnheader-report 'nnmbox "No such group: %s" group)) --- 172,178 ---- (deffoo nnmbox-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnmbox-group-alist)))) ! (cond ((or (null active) (null (nnmbox-possibly-change-newsgroup group server))) (nnheader-report 'nnmbox "No such group: %s" group)) *************** *** 181,195 **** (nnheader-insert "")) (t (nnheader-report 'nnmbox "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group))))) (deffoo nnmbox-request-scan (&optional group server) (nnmbox-possibly-change-newsgroup group server) (nnmbox-read-mbox) ! (nnmail-get-new-mail ! 'nnmbox (lambda () (save-excursion (set-buffer nnmbox-mbox-buffer) --- 181,195 ---- (nnheader-insert "")) (t (nnheader-report 'nnmbox "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group))))) (deffoo nnmbox-request-scan (&optional group server) (nnmbox-possibly-change-newsgroup group server) (nnmbox-read-mbox) ! (nnmail-get-new-mail ! 'nnmbox (lambda () (save-excursion (set-buffer nnmbox-mbox-buffer) *************** *** 219,232 **** (deffoo nnmbox-request-list-newsgroups (&optional server) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) ! (deffoo nnmbox-request-expire-articles (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnmbox) ! (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) --- 219,232 ---- (deffoo nnmbox-request-list-newsgroups (&optional server) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) ! (deffoo nnmbox-request-expire-articles (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnmbox) ! (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) *************** *** 234,240 **** (if (setq is-old (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn (nnheader-message 5 "Deleting article %d in %s..." --- 234,240 ---- (if (setq is-old (nnmail-expired-article-p newsgroup ! (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn (nnheader-message 5 "Deleting article %d in %s..." *************** *** 258,264 **** (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmbox move*")) result) ! (and (nnmbox-request-article article group server) (save-excursion (set-buffer buf) --- 258,264 ---- (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmbox move*")) result) ! (and (nnmbox-request-article article group server) (save-excursion (set-buffer buf) *************** *** 266,273 **** (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward ! "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) --- 266,273 ---- (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward ! "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) *************** *** 295,301 **** (if (looking-at "X-From-Line: ") (replace-match "From ") (insert "From nobody " (current-time-string) "\n")) ! (and (nnmail-activate 'nnmbox) (progn (set-buffer buf) --- 295,301 ---- (if (looking-at "X-From-Line: ") (replace-match "From ") (insert "From nobody " (current-time-string) "\n")) ! (and (nnmail-activate 'nnmbox) (progn (set-buffer buf) *************** *** 304,311 **** (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) ! (when nnmail-cache-message-id-when-accepting ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) --- 304,310 ---- (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) ! (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) *************** *** 349,355 **** (when found (save-buffer))))) ;; Remove the group from all structures. ! (setq nnmbox-group-alist (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) nnmbox-current-group nil) ;; Save the active file. --- 348,354 ---- (when found (save-buffer))))) ;; Remove the group from all structures. ! (setq nnmbox-group-alist (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) nnmbox-current-group nil) ;; Save the active file. *************** *** 411,423 **** (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server (not (nnmbox-server-opened server))) (nnmbox-open-server server)) (when (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion ! (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) --- 410,422 ---- (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server (not (nnmbox-server-opened server))) (nnmbox-open-server server)) (when (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion ! (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) *************** *** 430,436 **** (defun nnmbox-article-string (article) (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) --- 429,435 ---- (defun nnmbox-article-string (article) (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) *************** *** 469,475 **** (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art ! (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) --- 468,474 ---- (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art ! (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) *************** *** 504,510 **** (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) start end number) ! (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) --- 503,509 ---- (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) start end number) ! (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) *************** *** 517,534 **** (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " (caar alist)) nil t) (>= (setq number ! (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) (1+ number))) (setq alist (cdr alist))) ! (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) ! (when (not (search-forward "\nX-Gnus-Newsgroup: " ! (save-excursion (setq end (or (and --- 516,533 ---- (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " (caar alist)) nil t) (>= (setq number ! (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) (1+ number))) (setq alist (cdr alist))) ! (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) ! (when (not (search-forward "\nX-Gnus-Newsgroup: " ! (save-excursion (setq end (or (and *************** *** 539,545 **** (save-excursion (save-restriction (narrow-to-region start end) ! (nnmbox-save-mail (nnmail-article-group 'nnmbox-active-number))))) (goto-char end)))))) --- 538,544 ---- (save-excursion (save-restriction (narrow-to-region start end) ! (nnmbox-save-mail (nnmail-article-group 'nnmbox-active-number))))) (goto-char end)))))) *** pub/rgnus/lisp/nnmh.el Fri Mar 7 07:37:04 1997 --- rgnus/lisp/nnmh.el Fri Mar 7 23:51:32 1997 *************** *** 26,32 **** ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: --- 26,32 ---- ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: *************** *** 82,89 **** (if (stringp (car articles)) 'headers (while articles ! (when (and (file-exists-p ! (setq file (concat (file-name-as-directory nnmh-current-directory) (int-to-string (setq article (pop articles)))))) --- 82,89 ---- (if (stringp (car articles)) 'headers (while articles ! (when (and (file-exists-p ! (setq file (concat (file-name-as-directory nnmh-current-directory) (int-to-string (setq article (pop articles)))))) *************** *** 117,123 **** (condition-case () (make-directory nnmh-directory t) (error t))) ! (cond ((not (file-exists-p nnmh-directory)) (nnmh-close-server) (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) --- 117,123 ---- (condition-case () (make-directory nnmh-directory t) (error t))) ! (cond ((not (file-exists-p nnmh-directory)) (nnmh-close-server) (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) *************** *** 144,156 **** (deffoo nnmh-request-group (group &optional server dont-check) (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) ! (cond ((not (file-directory-p pathname)) ! (nnheader-report 'nnmh "Can't select group (no such directory): %s" group)) (t (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail nnmh-be-safe (nnmh-update-gnus-unreads group)) (cond --- 144,156 ---- (deffoo nnmh-request-group (group &optional server dont-check) (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) ! (cond ((not (file-directory-p pathname)) ! (nnheader-report 'nnmh "Can't select group (no such directory): %s" group)) (t (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail nnmh-be-safe (nnmh-update-gnus-unreads group)) (cond *************** *** 160,171 **** (t ;; Re-scan the directory if it's on a foreign system. (nnheader-re-read-dir pathname) ! (setq dir (sort (mapcar (lambda (name) (string-to-int name)) (directory-files pathname nil "^[0-9]+$" t)) '<)) ! (cond (dir (nnheader-report 'nnmh "Selected group %s" group) (nnheader-insert --- 160,171 ---- (t ;; Re-scan the directory if it's on a foreign system. (nnheader-re-read-dir pathname) ! (setq dir (sort (mapcar (lambda (name) (string-to-int name)) (directory-files pathname nil "^[0-9]+$" t)) '<)) ! (cond (dir (nnheader-report 'nnmh "Selected group %s" group) (nnheader-insert *************** *** 210,222 **** (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-max)) ! (insert ! (format ! "%s %d %d y\n" (progn ! (string-match (regexp-quote ! (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) (nnheader-replace-chars-in-string --- 210,222 ---- (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-max)) ! (insert ! (format ! "%s %d %d y\n" (progn ! (string-match (regexp-quote ! (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) (nnheader-replace-chars-in-string *************** *** 231,237 **** (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup server) ! (let* ((active-articles (mapcar (function (lambda (name) --- 231,237 ---- (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup server) ! (let* ((active-articles (mapcar (function (lambda (name) *************** *** 242,255 **** (nnmail-activate 'nnmh) (while (and articles is-old) ! (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnmh-deletable-article-p newsgroup (car articles)) (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (nnheader-message 5 "Deleting article %s in %s..." article newsgroup) (condition-case () (funcall nnmail-delete-file-function article) --- 242,255 ---- (nnmail-activate 'nnmh) (while (and articles is-old) ! (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnmh-deletable-article-p newsgroup (car articles)) (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn ! (nnheader-message 5 "Deleting article %s in %s..." article newsgroup) (condition-case () (funcall nnmail-delete-file-function article) *************** *** 265,275 **** (deffoo nnmh-close-group (group &optional server) t) ! (deffoo nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) ! (and (nnmh-deletable-article-p group article) (nnmh-request-article article group server) (save-excursion --- 265,275 ---- (deffoo nnmh-close-group (group &optional server) t) ! (deffoo nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) ! (and (nnmh-deletable-article-p group article) (nnmh-request-article article group server) (save-excursion *************** *** 290,301 **** (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) ! (when nnmail-cache-message-id-when-accepting ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (if (stringp group) ! (and (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (list (cons group (nnmh-active-number group))) noinsert))) (and --- 290,300 ---- (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) ! (nnmail-cache-insert (nnmail-fetch-field "message-id")) (if (stringp group) ! (and (nnmail-activate 'nnmh) ! (car (nnmh-save-mail (list (cons group (nnmh-active-number group))) noinsert))) (and *************** *** 311,317 **** (set-buffer buffer) (nnmh-possibly-create-directory group) (ignore-errors ! (nnmail-write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) --- 310,316 ---- (set-buffer buffer) (nnmh-possibly-create-directory group) (ignore-errors ! (nnmail-write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) *************** *** 328,334 **** (let ((articles (mapcar (lambda (file) (string-to-int file)) ! (directory-files nnmh-current-directory nil "^[0-9]+$")))) (when articles (setcar active (apply 'min articles)) --- 327,333 ---- (let ((articles (mapcar (lambda (file) (string-to-int file)) ! (directory-files nnmh-current-directory nil "^[0-9]+$")))) (when articles (setcar active (apply 'min articles)) *************** *** 341,347 **** (if (not force) () ; Don't delete the articles. (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) ! (while articles (when (file-writable-p (car articles)) (nnheader-message 5 "Deleting article %s in %s..." (car articles) group) --- 340,346 ---- (if (not force) () ; Don't delete the articles. (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) ! (while articles (when (file-writable-p (car articles)) (nnheader-message 5 "Deleting article %s in %s..." (car articles) group) *************** *** 351,357 **** (ignore-errors (delete-directory nnmh-current-directory))) ;; Remove the group from all structures. ! (setq nnmh-group-alist (delq (assoc group nnmh-group-alist) nnmh-group-alist) nnmh-current-directory nil) t) --- 350,356 ---- (ignore-errors (delete-directory nnmh-current-directory))) ;; Remove the group from all structures. ! (setq nnmh-group-alist (delq (assoc group nnmh-group-alist) nnmh-group-alist) nnmh-current-directory nil) t) *************** *** 368,374 **** ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files ! (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) --- 367,373 ---- ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files ! (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) *************** *** 388,394 **** ;;; Internal functions. (defun nnmh-possibly-change-directory (newsgroup &optional server) ! (when (and server (not (nnmh-server-opened server))) (nnmh-open-server server)) (when newsgroup --- 387,393 ---- ;;; Internal functions. (defun nnmh-possibly-change-directory (newsgroup &optional server) ! (when (and server (not (nnmh-server-opened server))) (nnmh-open-server server)) (when newsgroup *************** *** 408,414 **** (error "Could not create directory %s" (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) ! (defun nnmh-save-mail (group-art &optional noinsert) "Called narrowed to an article." (unless noinsert --- 407,413 ---- (error "Could not create directory %s" (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) ! (defun nnmh-save-mail (group-art &optional noinsert) "Called narrowed to an article." (unless noinsert *************** *** 425,431 **** first) (while ga (nnmh-possibly-create-directory (caar ga)) ! (let ((file (concat (nnmail-group-pathname (caar ga) nnmh-directory) (int-to-string (cdar ga))))) (if first --- 424,430 ---- first) (while ga (nnmh-possibly-create-directory (caar ga)) ! (let ((file (concat (nnmail-group-pathname (caar ga) nnmh-directory) (int-to-string (cdar ga))))) (if first *************** *** 442,448 **** (let ((active (cadr (assoc group nnmh-group-alist)))) (unless active ;; The group wasn't known to nnmh, so we just create an active ! ;; entry for it. (setq active (cons 1 0)) (push (list group active) nnmh-group-alist) ;; Find the highest number in the group. --- 441,447 ---- (let ((active (cadr (assoc group nnmh-group-alist)))) (unless active ;; The group wasn't known to nnmh, so we just create an active ! ;; entry for it. (setq active (cons 1 0)) (push (list group active) nnmh-group-alist) ;; Find the highest number in the group. *************** *** 469,482 **** ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) (files (sort (mapcar (function (lambda (name) (string-to-int name))) ! (directory-files nnmh-current-directory nil "^[0-9]+$" t)) '<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. (when (file-exists-p nnmh-file) ! (setq articles (let (nnmh-newsgroup-articles) (ignore-errors (load nnmh-file nil t t)) nnmh-newsgroup-articles))) --- 468,481 ---- ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) (files (sort (mapcar (function (lambda (name) (string-to-int name))) ! (directory-files nnmh-current-directory nil "^[0-9]+$" t)) '<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. (when (file-exists-p nnmh-file) ! (setq articles (let (nnmh-newsgroup-articles) (ignore-errors (load nnmh-file nil t t)) nnmh-newsgroup-articles))) *************** *** 498,504 **** art) (while (setq art (pop arts)) (when (not (equal ! (nth 5 (file-attributes (concat dir (int-to-string (car art))))) (cdr art))) (setq articles (delq art articles)) --- 497,503 ---- art) (while (setq art (pop arts)) (when (not (equal ! (nth 5 (file-attributes (concat dir (int-to-string (car art))))) (cdr art))) (setq articles (delq art articles)) *************** *** 515,521 **** new))) ;; Make Gnus mark all new articles as unread. (when new ! (gnus-make-articles-unread (gnus-group-prefixed-name group (list 'nnmh "")) (setq new (sort new '<)))) ;; Sort the article list with highest numbers first. --- 514,520 ---- new))) ;; Make Gnus mark all new articles as unread. (when new ! (gnus-make-articles-unread (gnus-group-prefixed-name group (list 'nnmh "")) (setq new (sort new '<)))) ;; Sort the article list with highest numbers first. *************** *** 532,538 **** "Say whether ARTICLE in GROUP can be deleted." (let ((path (concat nnmh-current-directory (int-to-string article)))) ;; Writable. ! (and (file-writable-p path) ;; We can never delete the last article in the group. (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) article))))) --- 531,537 ---- "Say whether ARTICLE in GROUP can be deleted." (let ((path (concat nnmh-current-directory (int-to-string article)))) ;; Writable. ! (and (file-writable-p path) ;; We can never delete the last article in the group. (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) article))))) *** pub/rgnus/lisp/nnml.el Fri Mar 7 07:37:04 1997 --- rgnus/lisp/nnml.el Fri Mar 7 23:51:32 1997 *************** *** 26,32 **** ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: --- 26,32 ---- ;; Based on nnspool.el by Masanobu UMEDA . ;; For an overview of what the interface functions do, please see the ! ;; Gnus sources. ;;; Code: *************** *** 40,50 **** (defvoo nnml-directory message-directory "Mail spool directory.") ! (defvoo nnml-active-file (concat (file-name-as-directory nnml-directory) "active") "Mail active file.") ! (defvoo nnml-newsgroups-file (concat (file-name-as-directory nnml-directory) "newsgroups") "Mail newsgroups description file.") --- 40,50 ---- (defvoo nnml-directory message-directory "Mail spool directory.") ! (defvoo nnml-active-file (concat (file-name-as-directory nnml-directory) "active") "Mail active file.") ! (defvoo nnml-newsgroups-file (concat (file-name-as-directory nnml-directory) "newsgroups") "Mail newsgroups description file.") *************** *** 140,146 **** (condition-case () (make-directory nnml-directory t) (error))) ! (cond ((not (file-exists-p nnml-directory)) (nnml-close-server) (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) --- 140,146 ---- (condition-case () (make-directory nnml-directory t) (error))) ! (cond ((not (file-exists-p nnml-directory)) (nnml-close-server) (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) *************** *** 172,178 **** nnml-directory)))))) (setq path (concat gpath (int-to-string (cdr group-num))))) (setq path (nnml-article-to-file id))) ! (cond ((not path) (nnheader-report 'nnml "No such article: %s" id)) ((not (file-exists-p path)) --- 172,178 ---- nnml-directory)))))) (setq path (concat gpath (int-to-string (cdr group-num))))) (setq path (nnml-article-to-file id))) ! (cond ((not path) (nnheader-report 'nnml "No such article: %s" id)) ((not (file-exists-p path)) *************** *** 188,194 **** (string-to-int (file-name-nondirectory path))))))) (deffoo nnml-request-group (group &optional server dont-check) ! (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) ((not (file-exists-p nnml-current-directory)) --- 188,194 ---- (string-to-int (file-name-nondirectory path))))))) (deffoo nnml-request-group (group &optional server dont-check) ! (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) ((not (file-exists-p nnml-current-directory)) *************** *** 196,202 **** nnml-current-directory)) ((not (file-directory-p nnml-current-directory)) (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) ! (dont-check (nnheader-report 'nnml "Group %s selected" group) t) (t --- 196,202 ---- nnml-current-directory)) ((not (file-directory-p nnml-current-directory)) (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) ! (dont-check (nnheader-report 'nnml "Group %s selected" group) t) (t *************** *** 206,212 **** (if (not active) (nnheader-report 'nnml "No such group: %s" group) (nnheader-report 'nnml "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group)))))) --- 206,212 ---- (if (not active) (nnheader-report 'nnml "No such group: %s" group) (nnheader-report 'nnml "Selected group %s" group) ! (nnheader-insert "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group)))))) *************** *** 250,256 **** (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) ! (let* ((active-articles (nnheader-directory-articles nnml-current-directory)) (is-old t) article rest mod-time number) --- 250,256 ---- (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) ! (let* ((active-articles (nnheader-directory-articles nnml-current-directory)) (is-old t) article rest mod-time number) *************** *** 260,266 **** (when (setq article (nnml-article-to-file (setq number (pop articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnml-deletable-article-p group number) ! (setq is-old (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) (progn --- 260,266 ---- (when (setq article (nnml-article-to-file (setq number (pop articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnml-deletable-article-p group number) ! (setq is-old (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) (progn *************** *** 282,294 **** (nnml-save-nov) (nconc rest articles))) ! (deffoo nnml-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (nnml-possibly-change-directory group server) (nnml-update-file-alist) ! (and (nnml-deletable-article-p group article) (nnml-request-article article group server) (save-excursion --- 282,294 ---- (nnml-save-nov) (nconc rest articles))) ! (deffoo nnml-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (nnml-possibly-change-directory group server) (nnml-update-file-alist) ! (and (nnml-deletable-article-p group article) (nnml-request-article article group server) (save-excursion *************** *** 313,324 **** (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) ! (when nnmail-cache-message-id-when-accepting ! (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (if (stringp group) ! (and (nnmail-activate 'nnml) ! (setq result (car (nnml-save-mail (list (cons group (nnml-active-number group)))))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) --- 313,323 ---- (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) ! (nnmail-cache-insert (nnmail-fetch-field "message-id")) (if (stringp group) ! (and (nnmail-activate 'nnml) ! (setq result (car (nnml-save-mail (list (cons group (nnml-active-number group)))))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) *************** *** 343,349 **** headers) (when (condition-case () (progn ! (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) (concat nnml-current-directory --- 342,348 ---- headers) (when (condition-case () (progn ! (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) (concat nnml-current-directory *************** *** 353,359 **** (error nil)) (setq headers (nnml-parse-head chars article)) ;; Replace the NOV line in the NOV file. ! (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) (if (or (looking-at art) --- 352,358 ---- (error nil)) (setq headers (nnml-parse-head chars article)) ;; Replace the NOV line in the NOV file. ! (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) (if (or (looking-at art) *************** *** 365,372 **** ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) (while (and (looking-at "[0-9]+\t") ! (< (string-to-int ! (buffer-substring (match-beginning 0) (match-end 0))) article) (zerop (forward-line 1))))) --- 364,371 ---- ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) (while (and (looking-at "[0-9]+\t") ! (< (string-to-int ! (buffer-substring (match-beginning 0) (match-end 0))) article) (zerop (forward-line 1))))) *************** *** 379,391 **** (nnml-possibly-change-directory group server) (when force ;; Delete all articles in GROUP. ! (let ((articles ! (directory-files nnml-current-directory t (concat nnheader-numerical-short-files "\\|" (regexp-quote nnml-nov-file-name) "$"))) article) ! (while articles (setq article (pop articles)) (when (file-writable-p article) (nnheader-message 5 "Deleting article %s in %s..." article group) --- 378,390 ---- (nnml-possibly-change-directory group server) (when force ;; Delete all articles in GROUP. ! (let ((articles ! (directory-files nnml-current-directory t (concat nnheader-numerical-short-files "\\|" (regexp-quote nnml-nov-file-name) "$"))) article) ! (while articles (setq article (pop articles)) (when (file-writable-p article) (nnheader-message 5 "Deleting article %s in %s..." article group) *************** *** 395,401 **** (delete-directory nnml-current-directory) (error nil))) ;; Remove the group from all structures. ! (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) --- 394,400 ---- (delete-directory nnml-current-directory) (error nil))) ;; Remove the group from all structures. ! (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) *************** *** 417,423 **** ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files ! (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) --- 416,422 ---- ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files ! (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) *************** *** 469,475 **** (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) article))))))) ! ;; Find an article number in the current group given the Message-ID. (defun nnml-find-group-number (id) (save-excursion (set-buffer (get-buffer-create " *nnml id*")) --- 468,474 ---- (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) article))))))) ! ;; Find an article number in the current group given the Message-ID. (defun nnml-find-group-number (id) (save-excursion (set-buffer (get-buffer-create " *nnml id*")) *************** *** 478,484 **** number) ;; We want to look through all .overview files, but we want to ;; start with the one in the current directory. It seems most ! ;; likely that the article we are looking for is in that group. (if (setq number (nnml-find-id nnml-current-group id)) (cons nnml-current-group number) ;; It wasn't there, so we look through the other groups as well. --- 477,483 ---- number) ;; We want to look through all .overview files, but we want to ;; start with the one in the current directory. It seems most ! ;; likely that the article we are looking for is in that group. (if (setq number (nnml-find-id nnml-current-group id)) (cons nnml-current-group number) ;; It wasn't there, so we look through the other groups as well. *************** *** 554,560 **** (make-directory (directory-file-name (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) ! (defun nnml-save-mail (group-art) "Called narrowed to an article." (let (chars headers) --- 553,559 ---- (make-directory (directory-file-name (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) ! (defun nnml-save-mail (group-art) "Called narrowed to an article." (let (chars headers) *************** *** 571,590 **** first) (while ga (nnml-possibly-create-directory (caar ga)) ! (let ((file (concat (nnmail-group-pathname (caar ga) nnml-directory) (int-to-string (cdar ga))))) (if first ;; It was already saved, so we just make a hard link. (funcall nnmail-crosspost-link-function first file t) ;; Save the article. ! (nnmail-write-region (point-min) (point-max) file nil (if (nnheader-be-verbose 5) nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov ;; line after saving, because nov generation destroys the ! ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) --- 570,589 ---- first) (while ga (nnml-possibly-create-directory (caar ga)) ! (let ((file (concat (nnmail-group-pathname (caar ga) nnml-directory) (int-to-string (cdar ga))))) (if first ;; It was already saved, so we just make a hard link. (funcall nnmail-crosspost-link-function first file t) ;; Save the article. ! (nnmail-write-region (point-min) (point-max) file nil (if (nnheader-be-verbose 5) nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov ;; line after saving, because nov generation destroys the ! ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) *************** *** 597,603 **** "Compute the next article number in GROUP." (let ((active (cadr (assoc group nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ! ;; entry for it. (unless active ;; Perhaps the active file was corrupt? See whether ;; there are any articles in this group. --- 596,602 ---- "Compute the next article number in GROUP." (let ((active (cadr (assoc group nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ! ;; entry for it. (unless active ;; Perhaps the active file was corrupt? See whether ;; there are any articles in this group. *************** *** 623,629 **** (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." ! (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) (mail-header-set-number headers article) --- 622,628 ---- (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." ! (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) (mail-header-set-number headers article) *************** *** 637,643 **** (save-excursion (save-restriction (goto-char (point-min)) ! (narrow-to-region (point) (1- (or (search-forward "\n\n" nil t) (point-max)))) ;; Fold continuation lines. --- 636,642 ---- (save-excursion (save-restriction (goto-char (point-min)) ! (narrow-to-region (point) (1- (or (search-forward "\n\n" nil t) (point-max)))) ;; Fold continuation lines. *************** *** 653,659 **** (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) ! (let ((buffer (nnheader-find-file-noselect (concat (nnmail-group-pathname group nnml-directory) nnml-nov-file-name)))) (save-excursion --- 652,658 ---- (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) ! (let ((buffer (nnheader-find-file-noselect (concat (nnmail-group-pathname group nnml-directory) nnml-nov-file-name)))) (save-excursion *************** *** 677,683 **** (defun nnml-generate-nov-databases () "Generate nov databases in all nnml directories." (interactive) ! ;; Read the active file to make sure we don't re-use articles ;; numbers in empty groups. (nnmail-activate 'nnml) (nnml-open-server (or (nnoo-current-server 'nnml) "")) --- 676,682 ---- (defun nnml-generate-nov-databases () "Generate nov databases in all nnml directories." (interactive) ! ;; Read the active file to make sure we don't re-use articles ;; numbers in empty groups. (nnmail-activate 'nnml) (nnml-open-server (or (nnoo-current-server 'nnml) "")) *************** *** 710,716 **** (defvar files) (defun nnml-generate-active-info (dir) ;; Update the active info for this group. ! (let ((group (nnheader-file-to-group (directory-file-name dir) nnml-directory))) (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) --- 709,715 ---- (defvar files) (defun nnml-generate-active-info (dir) ;; Update the active info for this group. ! (let ((group (nnheader-file-to-group (directory-file-name dir) nnml-directory))) (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) *************** *** 739,745 **** (unless (file-directory-p (setq file (concat dir (cdar files)))) (erase-buffer) (nnheader-insert-file-contents file) ! (narrow-to-region (goto-char (point-min)) (progn (search-forward "\n\n" nil t) --- 738,744 ---- (unless (file-directory-p (setq file (concat dir (cdar files)))) (erase-buffer) (nnheader-insert-file-contents file) ! (narrow-to-region (goto-char (point-min)) (progn (search-forward "\n\n" nil t) *** pub/rgnus/lisp/nnoo.el Fri Jan 24 06:31:53 1997 --- rgnus/lisp/nnoo.el Fri Mar 7 23:51:33 1997 *************** *** 58,64 **** (defmacro nnoo-declare (backend &rest parents) `(eval-and-compile ! (push (list ',backend (mapcar (lambda (p) (list p)) ',parents) nil nil) nnoo-definition-alist) --- 58,64 ---- (defmacro nnoo-declare (backend &rest parents) `(eval-and-compile ! (push (list ',backend (mapcar (lambda (p) (list p)) ',parents) nil nil) nnoo-definition-alist) *************** *** 126,132 **** (&rest args) (nnoo-parent-function ',backend ',(car m) ,(cons 'list (nreverse margs)))))))) ! (defun nnoo-backend (symbol) (string-match "^[^-]+-" (symbol-name symbol)) (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) --- 126,132 ---- (&rest args) (nnoo-parent-function ',backend ',(car m) ,(cons 'list (nreverse margs)))))))) ! (defun nnoo-backend (symbol) (string-match "^[^-]+-" (symbol-name symbol)) (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) *************** *** 180,187 **** (symbol-value (car def))))))) (set (car def) (cadr def)))) (while parents ! (nnoo-change-server ! (caar parents) server (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) (cdar parents))) (pop parents)))) --- 180,187 ---- (symbol-value (car def))))))) (set (car def) (cadr def)))) (while parents ! (nnoo-change-server ! (caar parents) server (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) (cdar parents))) (pop parents)))) *************** *** 192,198 **** (defs (nnoo-variables backend))) ;; Remove the old definition. (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) ! ;; If this is the first time we push the server (i. e., this is ;; the nil server), then we update the default values of ;; all the variables to reflect the current values. (when (equal current "*internal-non-initialized-backend*") --- 192,198 ---- (defs (nnoo-variables backend))) ;; Remove the old definition. (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) ! ;; If this is the first time we push the server (i. e., this is ;; the nil server), then we update the default values of ;; all the variables to reflect the current values. (when (equal current "*internal-non-initialized-backend*") *** pub/rgnus/lisp/nnsoup.el Mon Jan 27 09:10:44 1997 --- rgnus/lisp/nnsoup.el Fri Mar 7 23:51:33 1997 *************** *** 113,119 **** (setq this-area-seq nil) ;; We take note whether this MSG has a corresponding IDX ;; for later use. ! (when (or (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) (not (file-exists-p (nnsoup-file --- 113,119 ---- (setq this-area-seq nil) ;; We take note whether this MSG has a corresponding IDX ;; for later use. ! (when (or (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) (not (file-exists-p (nnsoup-file *************** *** 128,134 **** (car useful-areas))))) ;; We now have a list of article numbers and corresponding ! ;; areas. (setq useful-areas (nreverse useful-areas)) ;; Two different approaches depending on whether all the MSG --- 128,134 ---- (car useful-areas))))) ;; We now have a list of article numbers and corresponding ! ;; areas. (setq useful-areas (nreverse useful-areas)) ;; Two different approaches depending on whether all the MSG *************** *** 163,169 **** useful-areas (cdr useful-areas)) (while articles (when (setq msg-buf ! (nnsoup-narrow-to-article (car articles) (cdar useful-areas) 'head)) (goto-char (point-max)) (insert (format "221 %d Article retrieved.\n" (car articles))) --- 163,169 ---- useful-areas (cdr useful-areas)) (while articles (when (setq msg-buf ! (nnsoup-narrow-to-article (car articles) (cdar useful-areas) 'head)) (goto-char (point-max)) (insert (format "221 %d Article retrieved.\n" (car articles))) *************** *** 181,187 **** (condition-case () (make-directory nnsoup-directory t) (error t))) ! (cond ((not (file-exists-p nnsoup-directory)) (nnsoup-close-server) (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) --- 181,187 ---- (condition-case () (make-directory nnsoup-directory t) (error t))) ! (cond ((not (file-exists-p nnsoup-directory)) (nnsoup-close-server) (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) *************** *** 225,237 **** (deffoo nnsoup-request-group (group &optional server dont-check) (nnsoup-possibly-change-group group) ! (if dont-check t (let ((active (cadr (assoc group nnsoup-group-alist)))) (if (not active) (nnheader-report 'nnsoup "No such group: %s" group) ! (nnheader-insert ! "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group))))) --- 225,237 ---- (deffoo nnsoup-request-group (group &optional server dont-check) (nnsoup-possibly-change-group group) ! (if dont-check t (let ((active (cadr (assoc group nnsoup-group-alist)))) (if (not active) (nnheader-report 'nnsoup "No such group: %s" group) ! (nnheader-insert ! "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group))))) *************** *** 243,249 **** (cdaar (cddr (assoc group nnsoup-group-alist))))) (if (not article) 'unknown ! (let ((kind (gnus-soup-encoding-kind (gnus-soup-area-encoding (nth 1 (nnsoup-article-to-area article nnsoup-current-group)))))) --- 243,249 ---- (cdaar (cddr (assoc group nnsoup-group-alist))))) (if (not article) 'unknown ! (let ((kind (gnus-soup-encoding-kind (gnus-soup-area-encoding (nth 1 (nnsoup-article-to-area article nnsoup-current-group)))))) *************** *** 312,327 **** (setq mod-time (nth 5 (file-attributes (nnsoup-file prefix t))))) (gnus-sublist-p articles range-list) ! ;; This file is old enough. (nnmail-expired-article-p group mod-time force)) ;; Ok, we delete this file. (when (ignore-errors ! (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix) group) (when (file-exists-p (nnsoup-file prefix)) (delete-file (nnsoup-file prefix))) ! (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix t) group) (when (file-exists-p (nnsoup-file prefix t)) --- 312,327 ---- (setq mod-time (nth 5 (file-attributes (nnsoup-file prefix t))))) (gnus-sublist-p articles range-list) ! ;; This file is old enough. (nnmail-expired-article-p group mod-time force)) ;; Ok, we delete this file. (when (ignore-errors ! (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix) group) (when (file-exists-p (nnsoup-file prefix)) (delete-file (nnsoup-file prefix))) ! (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix t) group) (when (file-exists-p (nnsoup-file prefix t)) *************** *** 369,375 **** (defun nnsoup-write-active-file (&optional force) (when (and nnsoup-group-alist ! (or force nnsoup-group-alist-touched)) (setq nnsoup-group-alist-touched nil) (nnheader-temp-write nnsoup-active-file --- 369,375 ---- (defun nnsoup-write-active-file (&optional force) (when (and nnsoup-group-alist ! (or force nnsoup-group-alist-touched)) (setq nnsoup-group-alist-touched nil) (nnheader-temp-write nnsoup-active-file *************** *** 381,387 **** (defun nnsoup-next-prefix () "Return the next free prefix." (let (prefix) ! (while (or (file-exists-p (nnsoup-file (setq prefix (int-to-string nnsoup-current-prefix)))) (file-exists-p (nnsoup-file prefix t))) --- 381,387 ---- (defun nnsoup-next-prefix () "Return the next free prefix." (let (prefix) ! (while (or (file-exists-p (nnsoup-file (setq prefix (int-to-string nnsoup-current-prefix)))) (file-exists-p (nnsoup-file prefix t))) *************** *** 414,425 **** ;; Change the name to the permanent name and move the files. (setq cur-prefix (nnsoup-next-prefix)) (message "Incorporating file %s..." cur-prefix) ! (when (file-exists-p (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".IDX"))) (rename-file file (nnsoup-file cur-prefix))) ! (when (file-exists-p ! (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".MSG"))) (rename-file file (nnsoup-file cur-prefix t)) (gnus-soup-set-area-prefix area cur-prefix) --- 414,425 ---- ;; Change the name to the permanent name and move the files. (setq cur-prefix (nnsoup-next-prefix)) (message "Incorporating file %s..." cur-prefix) ! (when (file-exists-p (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".IDX"))) (rename-file file (nnsoup-file cur-prefix))) ! (when (file-exists-p ! (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".MSG"))) (rename-file file (nnsoup-file cur-prefix t)) (gnus-soup-set-area-prefix area cur-prefix) *************** *** 428,434 **** (if (not (setq entry (assoc (gnus-soup-area-name area) nnsoup-group-alist))) ;; If this is a new area (group), we just add this info to ! ;; the group alist. (push (list (gnus-soup-area-name area) (cons 1 number) (list (cons 1 number) area)) --- 428,434 ---- (if (not (setq entry (assoc (gnus-soup-area-name area) nnsoup-group-alist))) ;; If this is a new area (group), we just add this info to ! ;; the group alist. (push (list (gnus-soup-area-name area) (cons 1 number) (list (cons 1 number) area)) *************** *** 444,450 **** (defun nnsoup-number-of-articles (area) (save-excursion ! (cond ;; If the number is in the area info, we just return it. ((gnus-soup-area-number area) (gnus-soup-area-number area)) --- 444,450 ---- (defun nnsoup-number-of-articles (area) (save-excursion ! (cond ;; If the number is in the area info, we just return it. ((gnus-soup-area-number area) (gnus-soup-area-number area)) *************** *** 453,464 **** (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) (count-lines (point-min) (point-max))) ;; We do it the hard way - re-searching through the message ! ;; buffer. (t (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist) (nnsoup-dissect-buffer area)) ! (length (cdr (assoc (gnus-soup-area-prefix area) nnsoup-article-alist))))))) (defun nnsoup-dissect-buffer (area) --- 453,464 ---- (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) (count-lines (point-min) (point-max))) ;; We do it the hard way - re-searching through the message ! ;; buffer. (t (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist) (nnsoup-dissect-buffer area)) ! (length (cdr (assoc (gnus-soup-area-prefix area) nnsoup-article-alist))))))) (defun nnsoup-dissect-buffer (area) *************** *** 467,473 **** (i 0) alist len) (goto-char (point-min)) ! (cond ;; rnews batch format ((= format ?n) (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") --- 467,473 ---- (i 0) alist len) (goto-char (point-min)) ! (cond ;; rnews batch format ((= format ?n) (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") *************** *** 482,488 **** ((= format ?m) (while (looking-at mbox-delim) (forward-line 1) ! (push (list (incf i) (point) (progn (if (re-search-forward mbox-delim nil t) --- 482,488 ---- ((= format ?m) (while (looking-at mbox-delim) (forward-line 1) ! (push (list (incf i) (point) (progn (if (re-search-forward mbox-delim nil t) *************** *** 494,500 **** ((= format ?M) (while (looking-at "\^A\^A\^A\^A\n") (forward-line 1) ! (push (list (incf i) (point) (progn (if (search-forward "\n\^A\^A\^A\^A\n" nil t) --- 494,500 ---- ((= format ?M) (while (looking-at "\^A\^A\^A\^A\n") (forward-line 1) ! (push (list (incf i) (point) (progn (if (search-forward "\n\^A\^A\^A\^A\n" nil t) *************** *** 545,551 **** packet) (while (setq packet (pop packets)) (message "nnsoup: unpacking %s..." packet) ! (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) (message "Couldn't unpack %s" packet) (delete-file packet) --- 545,551 ---- packet) (while (setq packet (pop packets)) (message "nnsoup: unpacking %s..." packet) ! (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) (message "Couldn't unpack %s" packet) (delete-file packet) *************** *** 563,571 **** ;; There is no MSG file. ((null msg-buf) nil) ! ;; We use the index file to find out where the article ! ;; begins and ends. ! ((and (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 area))) ?c) (file-exists-p (nnsoup-file prefix))) --- 563,571 ---- ;; There is no MSG file. ((null msg-buf) nil) ! ;; We use the index file to find out where the article ! ;; begins and ends. ! ((and (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 area))) ?c) (file-exists-p (nnsoup-file prefix))) *************** *** 697,704 **** (when (eval message-mailer-swallows-blank-line) (newline)) (let ((msg-buf ! (gnus-soup-store ! nnsoup-replies-directory (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type nnsoup-replies-index-type)) (num 0)) --- 697,704 ---- (when (eval message-mailer-swallows-blank-line) (newline)) (let ((msg-buf ! (gnus-soup-store ! nnsoup-replies-directory (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type nnsoup-replies-index-type)) (num 0)) *************** *** 715,730 **** (defun nnsoup-kind-to-prefix (kind) (unless nnsoup-replies-list (setq nnsoup-replies-list ! (gnus-soup-parse-replies (concat nnsoup-replies-directory "REPLIES")))) (let ((replies nnsoup-replies-list)) ! (while (and replies (not (string= kind (gnus-soup-reply-kind (car replies))))) (setq replies (cdr replies))) (if replies (gnus-soup-reply-prefix (car replies)) (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) ! kind (format "%c%c%c" nnsoup-replies-format-type nnsoup-replies-index-type --- 715,730 ---- (defun nnsoup-kind-to-prefix (kind) (unless nnsoup-replies-list (setq nnsoup-replies-list ! (gnus-soup-parse-replies (concat nnsoup-replies-directory "REPLIES")))) (let ((replies nnsoup-replies-list)) ! (while (and replies (not (string= kind (gnus-soup-reply-kind (car replies))))) (setq replies (cdr replies))) (if replies (gnus-soup-reply-prefix (car replies)) (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) ! kind (format "%c%c%c" nnsoup-replies-format-type nnsoup-replies-index-type *************** *** 756,762 **** (setq lines (count-lines (point-min) (point-max))) (setq ident (progn (string-match "/\\([0-9]+\\)\\." (car files)) ! (substring (car files) (match-beginning 1) (match-end 1)))) (if (not (setq elem (assoc group active))) --- 756,762 ---- (setq lines (count-lines (point-min) (point-max))) (setq ident (progn (string-match "/\\([0-9]+\\)\\." (car files)) ! (substring (car files) (match-beginning 1) (match-end 1)))) (if (not (setq elem (assoc group active))) *************** *** 778,784 **** (defun nnsoup-delete-unreferenced-message-files () "Delete any *.MSG and *.IDX files that aren't known by nnsoup." (interactive) ! (let* ((known (apply 'nconc (mapcar (lambda (ga) (mapcar (lambda (area) --- 778,784 ---- (defun nnsoup-delete-unreferenced-message-files () "Delete any *.MSG and *.IDX files that aren't known by nnsoup." (interactive) ! (let* ((known (apply 'nconc (mapcar (lambda (ga) (mapcar (lambda (area) *** pub/rgnus/lisp/nnspool.el Thu Jan 9 11:59:31 1997 --- rgnus/lisp/nnspool.el Fri Mar 7 23:51:33 1997 *************** *** 119,125 **** (if (stringp article) ;; This is a Message-ID. (setq ag (nnspool-find-id article) ! file (and ag (nnspool-article-pathname (car ag) (cdr ag))) article (cdr ag)) ;; This is an article in the current group. --- 119,125 ---- (if (stringp article) ;; This is a Message-ID. (setq ag (nnspool-find-id article) ! file (and ag (nnspool-article-pathname (car ag) (cdr ag))) article (cdr ag)) ;; This is an article in the current group. *************** *** 137,158 **** (forward-char -1) (insert ".\n") (delete-region (point) (point-max))) ! (and do-message (zerop (% (incf count) 20)) (message "nnspool: Receiving headers... %d%%" (/ (* count 100) number)))) ! (when do-message (message "nnspool: Receiving headers...done")) ! ;; Fold continuation lines. (nnheader-fold-continuation-lines) 'headers))))) (deffoo nnspool-open-server (server &optional defs) (nnoo-change-server 'nnspool server defs) ! (cond ((not (file-exists-p nnspool-spool-directory)) (nnspool-close-server) (nnheader-report 'nnspool "Spool directory doesn't exist: %s" --- 137,158 ---- (forward-char -1) (insert ".\n") (delete-region (point) (point-max))) ! (and do-message (zerop (% (incf count) 20)) (message "nnspool: Receiving headers... %d%%" (/ (* count 100) number)))) ! (when do-message (message "nnspool: Receiving headers...done")) ! ;; Fold continuation lines. (nnheader-fold-continuation-lines) 'headers))))) (deffoo nnspool-open-server (server &optional defs) (nnoo-change-server 'nnspool server defs) ! (cond ((not (file-exists-p nnspool-spool-directory)) (nnspool-close-server) (nnheader-report 'nnspool "Spool directory doesn't exist: %s" *************** *** 163,169 **** (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" --- 163,169 ---- (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" *************** *** 176,182 **** (let ((nntp-server-buffer (or buffer nntp-server-buffer)) file ag) (if (stringp id) ! ;; This is a Message-ID. (when (setq ag (nnspool-find-id id)) (setq file (nnspool-article-pathname (car ag) (cdr ag)))) (setq file (nnspool-article-pathname nnspool-current-group id))) --- 176,182 ---- (let ((nntp-server-buffer (or buffer nntp-server-buffer)) file ag) (if (stringp id) ! ;; This is a Message-ID. (when (setq ag (nnspool-find-id id)) (setq file (nnspool-article-pathname (car ag) (cdr ag)))) (setq file (nnspool-article-pathname nnspool-current-group id))) *************** *** 188,194 **** (if (numberp id) (cons nnspool-current-group id) ag)))) ! (deffoo nnspool-request-body (id &optional group server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory group) --- 188,194 ---- (if (numberp id) (cons nnspool-current-group id) ag)))) ! (deffoo nnspool-request-body (id &optional group server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory group) *************** *** 219,225 **** (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) ! (nnheader-report 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) (nnheader-report 'nnspool "Selected group %s" group) --- 219,225 ---- (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) ! (nnheader-report 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) (nnheader-report 'nnspool "Selected group %s" group) *************** *** 230,236 **** ;; Yes, completely empty spool directories *are* possible. ;; Fix by Sudish Joseph (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! (setq dir (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) (if dir (nnheader-insert --- 230,236 ---- ;; Yes, completely empty spool directories *are* possible. ;; Fix by Sudish Joseph (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! (setq dir (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) (if dir (nnheader-insert *************** *** 256,269 **** "List newsgroups (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-newsgroups-file) ! (nnheader-report 'nnspool (nnheader-file-error nnspool-newsgroups-file))))) (deffoo nnspool-request-list-distributions (&optional server) "List distributions (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-distributions-file) ! (nnheader-report 'nnspool (nnheader-file-error nnspool-distributions-file))))) ;; Suggested by Hallvard B Furuseth . --- 256,269 ---- "List newsgroups (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-newsgroups-file) ! (nnheader-report 'nnspool (nnheader-file-error nnspool-newsgroups-file))))) (deffoo nnspool-request-list-distributions (&optional server) "List distributions (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-distributions-file) ! (nnheader-report 'nnspool (nnheader-file-error nnspool-distributions-file))))) ;; Suggested by Hallvard B Furuseth . *************** *** 273,279 **** (save-excursion ;; Find the last valid line. (goto-char (point-max)) ! (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) (let ((seconds (nnspool-seconds-since-epoch date)) --- 273,279 ---- (save-excursion ;; Find the last valid line. (goto-char (point-max)) ! (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) (let ((seconds (nnspool-seconds-since-epoch date)) *************** *** 283,289 **** (progn ;; We insert a .0 to make the list reader ;; interpret the number as a float. It is far ! ;; too big to be stored in a lisp integer. (goto-char (1- (match-end 0))) (insert ".0") (> (progn --- 283,289 ---- (progn ;; We insert a .0 to make the list reader ;; interpret the number as a float. It is far ! ;; too big to be stored in a lisp integer. (goto-char (1- (match-end 0))) (insert ".0") (> (progn *************** *** 306,312 **** (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) ! (proc (condition-case err (apply 'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches) --- 306,312 ---- (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) ! (proc (condition-case err (apply 'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches) *************** *** 346,352 **** (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil ! (let ((nov (nnheader-group-pathname nnspool-current-group nnspool-nov-directory ".overview")) (arts articles) last) --- 346,352 ---- (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil ! (let ((nov (nnheader-group-pathname nnspool-current-group nnspool-nov-directory ".overview")) (arts articles) last) *************** *** 369,375 **** (car (last articles))) ;; If the buffer is empty, this wasn't very successful. (unless (zerop (buffer-size)) ! ;; We check what the last article number was. ;; The NOV file may be out of sync with the articles ;; in the group. (forward-line -1) --- 369,375 ---- (car (last articles))) ;; If the buffer is empty, this wasn't very successful. (unless (zerop (buffer-size)) ! ;; We check what the last article number was. ;; The NOV file may be out of sync with the articles ;; in the group. (forward-line -1) *************** *** 405,416 **** (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles)))) ! (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) file))) ! ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. (defun nnspool-find-id (id) (save-excursion --- 405,416 ---- (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles)))) ! (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) file))) ! ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. (defun nnspool-find-id (id) (save-excursion *** pub/rgnus/lisp/nntp.el Thu Mar 6 08:47:28 1997 --- rgnus/lisp/nntp.el Fri Mar 7 23:51:34 1997 *************** *** 43,49 **** "Port number on the physical nntp server.") (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) ! "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password --- 43,49 ---- "Port number on the physical nntp server.") (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) ! "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password *************** *** 53,62 **** (defvoo nntp-authinfo-function 'nntp-send-authinfo "Function used to send AUTHINFO to the server.") ! (defvoo nntp-server-action-alist ! '(("nntpd 1\\.5\\.11t" (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) ! ("NNRP server Netscape" (setq nntp-server-list-active-group nil))) "Alist of regexps to match on server types and actions to be taken. For instance, if you want Gnus to beep every time you connect --- 53,62 ---- (defvoo nntp-authinfo-function 'nntp-send-authinfo "Function used to send AUTHINFO to the server.") ! (defvoo nntp-server-action-alist ! '(("nntpd 1\\.5\\.11t" (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) ! ("NNRP server Netscape" (setq nntp-server-list-active-group nil))) "Alist of regexps to match on server types and actions to be taken. For instance, if you want Gnus to beep every time you connect *************** *** 188,194 **** ;; We successfully retrieved the headers via XOVER. 'nov ;; XOVER didn't work, so we do it the hard, slow and inefficient ! ;; way. (let ((number (length articles)) (count 0) (received 0) --- 188,194 ---- ;; We successfully retrieved the headers via XOVER. 'nov ;; XOVER didn't work, so we do it the hard, slow and inefficient ! ;; way. (let ((number (length articles)) (count 0) (received 0) *************** *** 197,203 **** (nntp-inhibit-erase t)) ;; Send HEAD command. (while articles ! (nntp-send-command nil "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) --- 197,203 ---- (nntp-inhibit-erase t)) ;; Send HEAD command. (while articles ! (nntp-send-command nil "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) *************** *** 254,260 **** (save-excursion (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) ;; The first time this is run, this variable is `try'. So we ! ;; try. (when (eq nntp-server-list-active-group 'try) (nntp-try-list-active (car groups))) (erase-buffer) --- 254,260 ---- (save-excursion (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) ;; The first time this is run, this variable is `try'. So we ! ;; try. (when (eq nntp-server-list-active-group 'try) (nntp-try-list-active (car groups))) (erase-buffer) *************** *** 326,332 **** (erase-buffer) ;; Send HEAD command. (while (setq article (pop articles)) ! (nntp-send-command nil "ARTICLE" (if (numberp article) (int-to-string article) --- 326,332 ---- (erase-buffer) ;; Send HEAD command. (while (setq article (pop articles)) ! (nntp-send-command nil "ARTICLE" (if (numberp article) (int-to-string article) *************** *** 379,385 **** (defun nntp-next-result-arrived-p () (let ((point (point))) ! (cond ((looking-at "2") (if (re-search-forward "\n.\r?\n" nil t) t --- 379,385 ---- (defun nntp-next-result-arrived-p () (let ((point (point))) ! (cond ((looking-at "2") (if (re-search-forward "\n.\r?\n" nil t) t *************** *** 501,507 **** (format "%s%02d%02d %s%s%s" (substring (aref date 0) 2) (string-to-int (aref date 1)) (string-to-int (aref date 2)) (substring (aref date 3) 0 2) ! (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))) (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) --- 501,507 ---- (format "%s%02d%02d %s%s%s" (substring (aref date 0) 2) (string-to-int (aref date 1)) (string-to-int (aref date 2)) (substring (aref date 3) 0 2) ! (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))) (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) *************** *** 514,520 **** (deffoo nntp-request-type (group article) 'news) ! (deffoo nntp-asynchronous-p () t) --- 514,520 ---- (deffoo nntp-request-type (group article) 'news) ! (deffoo nntp-asynchronous-p () t) *************** *** 531,541 **** "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string (format "NNTP (%s) user name: " nntp-address))) ! (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) (defun nntp-send-authinfo () --- 531,541 ---- "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string (format "NNTP (%s) user name: " nntp-address))) ! (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) (defun nntp-send-authinfo () *************** *** 544,550 **** It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address)))) (defun nntp-send-authinfo-from-file () --- 544,550 ---- It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address)))) (defun nntp-send-authinfo-from-file () *************** *** 555,562 **** (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point))))))) ;;; Internal functions. --- 555,562 ---- (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) ! (nntp-send-command ! "^.*\r?\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point))))))) ;;; Internal functions. *************** *** 636,642 **** (defun nntp-make-process-buffer (buffer) "Create a new, fresh buffer usable for nntp process connections." (save-excursion ! (set-buffer (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number --- 636,642 ---- (defun nntp-make-process-buffer (buffer) "Create a new, fresh buffer usable for nntp process connections." (save-excursion ! (set-buffer (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number *************** *** 744,766 **** (erase-buffer))) (when command (nntp-send-string process command)) ! (cond ((eq callback 'ignore) t) ((and callback wait-for) (save-excursion (set-buffer (process-buffer process)) ! (unless nntp-inside-change-function (erase-buffer)) (setq nntp-process-decode decode nntp-process-to-buffer buffer nntp-process-wait-for wait-for nntp-process-callback callback nntp-process-start-point (point-max) ! after-change-functions (list 'nntp-after-change-function-callback))) t) ! (wait-for (nntp-wait-for process wait-for buffer decode)) (t t))))) --- 744,766 ---- (erase-buffer))) (when command (nntp-send-string process command)) ! (cond ((eq callback 'ignore) t) ((and callback wait-for) (save-excursion (set-buffer (process-buffer process)) ! (unless nntp-inside-change-function (erase-buffer)) (setq nntp-process-decode decode nntp-process-to-buffer buffer nntp-process-wait-for wait-for nntp-process-callback callback nntp-process-start-point (point-max) ! after-change-functions (list 'nntp-after-change-function-callback))) t) ! (wait-for (nntp-wait-for process wait-for buffer decode)) (t t))))) *************** *** 788,794 **** (goto-char (point-max)) (let ((limit (point-min))) (while (not (re-search-backward wait-for limit t)) ! ;; We assume that whatever we wait for is less than 1000 ;; characters long. (setq limit (max (- (point-max) 1000) (point-min))) (nntp-accept-process-output process) --- 788,794 ---- (goto-char (point-max)) (let ((limit (point-min))) (while (not (re-search-backward wait-for limit t)) ! ;; We assume that whatever we wait for is less than 1000 ;; characters long. (setq limit (max (- (point-max) 1000) (point-min))) (nntp-accept-process-output process) *************** *** 888,894 **** (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) (erase-buffer) ! (cond ;; This server does not talk NOV. ((not nntp-server-xover) --- 888,894 ---- (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) (erase-buffer) ! (cond ;; This server does not talk NOV. ((not nntp-server-xover) *************** *** 897,903 **** ;; We don't care about gaps. ((or (not nntp-nov-gap) fetch-old) ! (nntp-send-xover-command (if fetch-old (if (numberp fetch-old) (max 1 (- (car articles) fetch-old)) --- 897,903 ---- ;; We don't care about gaps. ((or (not nntp-nov-gap) fetch-old) ! (nntp-send-xover-command (if fetch-old (if (numberp fetch-old) (max 1 (- (car articles) fetch-old)) *************** *** 933,939 **** (while (and nntp-server-xover articles) (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of ! ;; articles. (while (and (cdr articles) (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) --- 933,939 ---- (while (and nntp-server-xover articles) (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of ! ;; articles. (while (and (cdr articles) (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) *************** *** 950,956 **** ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only ! ;; seems to happen once in a blue moon. (set-buffer buf) (while (progn (goto-char last-point) --- 950,956 ---- ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only ! ;; seems to happen once in a blue moon. (set-buffer buf) (while (progn (goto-char last-point) *************** *** 972,978 **** (forward-line -1) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))) ! ;; We remove any "." lines and status lines. (goto-char (point-min)) (while (search-forward "\r" nil t) --- 972,978 ---- (forward-line -1) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))) ! ;; We remove any "." lines and status lines. (goto-char (point-min)) (while (search-forward "\r" nil t) *************** *** 992,1004 **** ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply ! (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ! ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) (save-excursion --- 992,1004 ---- ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply ! (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. ! ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) (save-excursion *************** *** 1106,1112 **** (and number (zerop number) (setq number nil)) ;; Then we find the group name. (setq group ! (cond ;; If there is only one group in the Newsgroups header, ;; then it seems quite likely that this article comes ;; from that group, I'd say. --- 1106,1112 ---- (and number (zerop number) (setq number nil)) ;; Then we find the group name. (setq group ! (cond ;; If there is only one group in the Newsgroups header, ;; then it seems quite likely that this article comes ;; from that group, I'd say. *************** *** 1119,1125 **** ;; article number in the Xref header is the one we are ;; looking for. This might very well be wrong if this ;; article happens to have the same number in several ! ;; groups, but that's life. ((and (setq xref (mail-fetch-field "xref")) number (string-match (format "\\([^ :]+\\):%d" number) xref)) --- 1119,1125 ---- ;; article number in the Xref header is the one we are ;; looking for. This might very well be wrong if this ;; article happens to have the same number in several ! ;; groups, but that's life. ((and (setq xref (mail-fetch-field "xref")) number (string-match (format "\\([^ :]+\\):%d" number) xref)) *** pub/rgnus/lisp/nnvirtual.el Tue Feb 4 03:53:18 1997 --- rgnus/lisp/nnvirtual.el Fri Mar 7 23:51:34 1997 *************** *** 100,106 **** (erase-buffer) (if (stringp (car articles)) 'headers ! (let ((vbuf (nnheader-set-temp-buffer (get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) (system-name (system-name)) --- 100,106 ---- (erase-buffer) (if (stringp (car articles)) 'headers ! (let ((vbuf (nnheader-set-temp-buffer (get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) (system-name (system-name)) *************** *** 143,149 **** ;; component group below. They should be coming up ;; generally in order, so this shouldn't be slow. (setq articles (delq carticle articles)) ! (setq article (nnvirtual-reverse-map-article cgroup carticle)) (if (null article) ;; This line has no reverse mapping, that means it --- 143,149 ---- ;; component group below. They should be coming up ;; generally in order, so this shouldn't be slow. (setq articles (delq carticle articles)) ! (setq article (nnvirtual-reverse-map-article cgroup carticle)) (if (null article) ;; This line has no reverse mapping, that means it *************** *** 158,164 **** prefix system-name) (forward-line 1)) ) ! (set-buffer vbuf) (goto-char (point-max)) (insert-buffer-substring nntp-server-buffer)) --- 158,164 ---- prefix system-name) (forward-line 1)) ) ! (set-buffer vbuf) (goto-char (point-max)) (insert-buffer-substring nntp-server-buffer)) *************** *** 196,202 **** 'nnvirtual "Don't know what server to request from")) (t (save-excursion ! (when buffer (set-buffer buffer)) (let ((method (gnus-find-method-for-group nnvirtual-last-accessed-component-group))) --- 196,202 ---- 'nnvirtual "Don't know what server to request from")) (t (save-excursion ! (when buffer (set-buffer buffer)) (let ((method (gnus-find-method-for-group nnvirtual-last-accessed-component-group))) *************** *** 215,221 **** (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) (t (setq nnvirtual-last-accessed-component-group cgroup) ! (if buffer (save-excursion (set-buffer buffer) (gnus-request-article-this-buffer (cdr amap) cgroup)) --- 215,221 ---- (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) (t (setq nnvirtual-last-accessed-component-group cgroup) ! (if buffer (save-excursion (set-buffer buffer) (gnus-request-article-this-buffer (cdr amap) cgroup)) *************** *** 262,268 **** nnvirtual-always-rescan) (nnvirtual-create-mapping)) (setq nnvirtual-current-group group) ! (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) --- 262,268 ---- nnvirtual-always-rescan) (nnvirtual-create-mapping)) (setq nnvirtual-current-group group) ! (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) *************** *** 284,296 **** (setq mark gnus-expirable-mark))) mark) ! (deffoo nnvirtual-close-group (group &optional server) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (nnvirtual-update-read-and-marked t t)) t) ! (deffoo nnvirtual-request-list (&optional server) (nnheader-report 'nnvirtual "LIST is not implemented.")) --- 284,296 ---- (setq mark gnus-expirable-mark))) mark) ! (deffoo nnvirtual-close-group (group &optional server) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (nnvirtual-update-read-and-marked t t)) t) ! (deffoo nnvirtual-request-list (&optional server) (nnheader-report 'nnvirtual "LIST is not implemented.")) *************** *** 317,323 **** (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))) (setq nnvirtual-info-installed t)) t)) ! (deffoo nnvirtual-catchup-group (group &optional server all) (when (and (nnvirtual-possibly-change-server server) --- 317,323 ---- (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))) (setq nnvirtual-info-installed t)) t)) ! (deffoo nnvirtual-catchup-group (group &optional server all) (when (and (nnvirtual-possibly-change-server server) *************** *** 409,416 **** If UPDATE-P is not nil, call gnus-group-update-group on the components." (when nnvirtual-current-group (let ((unreads (and read-p ! (nnvirtual-partition-sequence ! (gnus-list-of-unread-articles (nnvirtual-current-group))))) (type-marks (mapcar (lambda (ml) (cons (car ml) --- 409,416 ---- If UPDATE-P is not nil, call gnus-group-update-group on the components." (when nnvirtual-current-group (let ((unreads (and read-p ! (nnvirtual-partition-sequence ! (gnus-list-of-unread-articles (nnvirtual-current-group))))) (type-marks (mapcar (lambda (ml) (cons (car ml) *************** *** 434,440 **** (when (and (setq info (gnus-get-info (pop groups))) (gnus-info-marks info)) (gnus-info-set-marks info nil))) ! ;; Ok, currently type-marks is an assq list with keys of a mark type, ;; with data of an assq list with keys of component group names ;; and the articles which correspond to that key/group pair. --- 434,440 ---- (when (and (setq info (gnus-get-info (pop groups))) (gnus-info-marks info)) (gnus-info-set-marks info nil))) ! ;; Ok, currently type-marks is an assq list with keys of a mark type, ;; with data of an assq list with keys of component group names ;; and the articles which correspond to that key/group pair. *************** *** 442,450 **** (setq type (car mark)) (setq groups (cdr mark)) (while (setq carticles (pop groups)) ! (gnus-add-marked-articles (car carticles) type (cdr carticles) nil t)))) ! ;; possibly update the display, it is really slow (when update-p (setq groups nnvirtual-component-groups) --- 442,450 ---- (setq type (car mark)) (setq groups (cdr mark)) (while (setq carticles (pop groups)) ! (gnus-add-marked-articles (car carticles) type (cdr carticles) nil t)))) ! ;; possibly update the display, it is really slow (when update-p (setq groups nnvirtual-component-groups) *************** *** 632,638 **** (defun nnvirtual-create-mapping () ! "Build the tables necessary to map between component (group, article) to virtual article. Generate the set of read messages and marks for the virtual group based on the marks on the component groups." (let ((cnt 0) --- 632,638 ---- (defun nnvirtual-create-mapping () ! "Build the tables necessary to map between component (group, article) to virtual article. Generate the set of read messages and marks for the virtual group based on the marks on the component groups." (let ((cnt 0) *************** *** 678,684 **** ;; We want the actives list sorted by size, to build the tables. (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2))))) ! ;; Build the offset table. Largest sized groups are at the front. (setq nnvirtual-mapping-offsets (vconcat --- 678,684 ---- ;; We want the actives list sorted by size, to build the tables. (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2))))) ! ;; Build the offset table. Largest sized groups are at the front. (setq nnvirtual-mapping-offsets (vconcat *************** *** 687,693 **** (cons (nth 0 entry) (- (nth 2 entry) M))) actives)))) ! ;; Build the mapping table. (setq nnvirtual-mapping-table nil) (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives)) --- 687,693 ---- (cons (nth 0 entry) (- (nth 2 entry) M))) actives)))) ! ;; Build the mapping table. (setq nnvirtual-mapping-table nil) (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives)) *** pub/rgnus/lisp/nnweb.el Fri Mar 7 07:37:04 1997 --- rgnus/lisp/nnweb.el Fri Mar 7 23:51:34 1997 *************** *** 109,115 **** (deffoo nnweb-request-group (group &optional server dont-check) (nnweb-possibly-change-server nil server) ! (when (and group (not (equal group nnweb-group)) (not nnweb-ephemeral-p)) (let ((info (assoc group nnweb-group-alist))) --- 109,115 ---- (deffoo nnweb-request-group (group &optional server dont-check) (nnweb-possibly-change-server nil server) ! (when (and group (not (equal group nnweb-group)) (not nnweb-ephemeral-p)) (let ((info (assoc group nnweb-group-alist))) *************** *** 200,206 **** (gnus-delete-assoc group nnweb-group-alist) (gnus-delete-file (nnweb-overview-file group)) t) ! (nnoo-define-skeleton nnweb) ;;; Internal functions --- 200,206 ---- (gnus-delete-assoc group nnweb-group-alist) (gnus-delete-file (nnweb-overview-file group)) t) ! (nnoo-define-skeleton nnweb) ;;; Internal functions *************** *** 251,257 **** (defun nnweb-read-active () "Read the active file." (load (nnheader-concat nnweb-directory "active") t t t)) ! (defun nnweb-definition (type &optional noerror) "Return the definition of TYPE." (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) --- 251,257 ---- (defun nnweb-read-active () "Read the active file." (load (nnheader-concat nnweb-directory "active") t t t)) ! (defun nnweb-definition (type &optional noerror) "Return the definition of TYPE." (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) *************** *** 323,329 **** (defun nnweb-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." ! (mapconcat (function (lambda (data) (concat (w3-form-encode-xwfu (car data)) "=" --- 323,329 ---- (defun nnweb-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." ! (mapconcat (function (lambda (data) (concat (w3-form-encode-xwfu (car data)) "=" *************** *** 333,339 **** (defun nnweb-fetch-form (url pairs) (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) (url-request-method "POST") ! (url-request-extra-headers '(("Content-type" . "application/x-www-form-urlencoded")))) (url-insert-file-contents url) (setq buffer-file-name nil)) --- 333,339 ---- (defun nnweb-fetch-form (url pairs) (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) (url-request-method "POST") ! (url-request-extra-headers '(("Content-type" . "application/x-www-form-urlencoded")))) (url-insert-file-contents url) (setq buffer-file-name nil)) *************** *** 380,386 **** (nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) ! (narrow-to-region (point) (cond ((re-search-forward "^ +[0-9]+\\." nil t) (match-beginning 0)) --- 380,386 ---- (nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) ! (narrow-to-region (point) (cond ((re-search-forward "^ +[0-9]+\\." nil t) (match-beginning 0)) *************** *** 445,451 **** (replace-match "\n" t t)))) (defun nnweb-dejanews-search (search) ! (nnweb-fetch-form (nnweb-definition 'address) `(("query" . ,search) ("defaultOp" . "AND") --- 445,451 ---- (replace-match "\n" t t)))) (defun nnweb-dejanews-search (search) ! (nnweb-fetch-form (nnweb-definition 'address) `(("query" . ,search) ("defaultOp" . "AND") *************** *** 489,495 **** ;(nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) ! (narrow-to-region (point) (if (re-search-forward "^$" nil t) (match-beginning 0) --- 489,495 ---- ;(nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) ! (narrow-to-region (point) (if (re-search-forward "^$" nil t) (match-beginning 0) *************** *** 565,574 **** (defun nnweb-reference-search (search) (prog1 (url-insert-file-contents ! (concat (nnweb-definition 'address) "?" ! (nnweb-encode-www-form-urlencoded `(("search" . "advanced") ("querytext" . ,search) ("subj" . "") --- 565,574 ---- (defun nnweb-reference-search (search) (prog1 (url-insert-file-contents ! (concat (nnweb-definition 'address) "?" ! (nnweb-encode-www-form-urlencoded `(("search" . "advanced") ("querytext" . ,search) ("subj" . "") *************** *** 671,680 **** (defun nnweb-altavista-search (search &optional part) (prog1 (url-insert-file-contents ! (concat (nnweb-definition 'address) "?" ! (nnweb-encode-www-form-urlencoded `(("pg" . "aq") ("what" . "news") ,@(when part `(("stq" . ,(int-to-string (* part 30))))) --- 671,680 ---- (defun nnweb-altavista-search (search &optional part) (prog1 (url-insert-file-contents ! (concat (nnweb-definition 'address) "?" ! (nnweb-encode-www-form-urlencoded `(("pg" . "aq") ("what" . "news") ,@(when part `(("stq" . ,(int-to-string (* part 30))))) *** pub/rgnus/lisp/parse-time.el Wed Jul 31 21:06:53 1996 --- rgnus/lisp/parse-time.el Fri Mar 7 23:51:34 1997 *************** *** 142,148 **** ,#'(lambda () (car val)) ,#'(lambda () (cadr val))) ((8) ! ,#'(lambda () (and (stringp elt) (= 5 (length elt)) (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) --- 142,148 ---- ,#'(lambda () (car val)) ,#'(lambda () (cadr val))) ((8) ! ,#'(lambda () (and (stringp elt) (= 5 (length elt)) (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) *** pub/rgnus/lisp/smiley.el Fri Mar 7 07:37:05 1997 --- rgnus/lisp/smiley.el Fri Mar 7 23:51:35 1997 *************** *** 33,39 **** ;; (require 'smiley) ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) ! ;; The smilies were drawn by Joe Reiss . (require 'annotations) (require 'messagexmas) --- 33,39 ---- ;; (require 'smiley) ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) ! ;; The smilies were drawn by Joe Reiss . (require 'annotations) (require 'messagexmas) *************** *** 56,62 **** '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") ! ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") --- 56,62 ---- '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") ! ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") *************** *** 66,75 **** ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ! ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) "Normal and deformed faces for smilies." ! :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) --- 66,75 ---- ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") ! ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) "Normal and deformed faces for smilies." ! :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) *************** *** 93,99 **** ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) "Smileys with noses. These get less false matches." ! :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) --- 93,99 ---- ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) "Smileys with noses. These get less false matches." ! :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) *************** *** 106,113 **** If this is a symbol, take its value." :type '(radio (variable-item smiley-deformed-regexp-alist) (variable-item smiley-nosey-regexp-alist) ! symbol ! (repeat (list regexp (integer :tag "Match") (string :tag "Image")))) :group 'smiley) --- 106,113 ---- If this is a symbol, take its value." :type '(radio (variable-item smiley-deformed-regexp-alist) (variable-item smiley-nosey-regexp-alist) ! symbol ! (repeat (list regexp (integer :tag "Match") (string :tag "Image")))) :group 'smiley) *************** *** 154,160 **** smiley-running-xemacs (or (cdr-safe (assoc pixmap smiley-glyph-cache)) ! (let* ((xpm-color-symbols (and (featurep 'xpm) (append `(("flesh" ,smiley-flesh-color) ("features" ,smiley-features-color) --- 154,160 ---- smiley-running-xemacs (or (cdr-safe (assoc pixmap smiley-glyph-cache)) ! (let* ((xpm-color-symbols (and (featurep 'xpm) (append `(("flesh" ,smiley-flesh-color) ("features" ,smiley-features-color) *************** *** 186,192 **** (hide-annotation ant)) (when pt (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) ! (when (annotationp (setq ant (extent-property ext 'smiley-annotation))) (reveal-annotation ant) (set-extent-property ext 'invisible t))))))) --- 186,192 ---- (hide-annotation ant)) (when pt (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) ! (when (annotationp (setq ant (extent-property ext 'smiley-annotation))) (reveal-annotation ant) (set-extent-property ext 'invisible t))))))) *************** *** 249,255 **** t))) (defvar gnus-article-buffer) ! ;;;###autoload (defun gnus-smiley-display () (interactive) (save-excursion --- 249,255 ---- t))) (defvar gnus-article-buffer) ! ;;;###autoload (defun gnus-smiley-display () (interactive) (save-excursion *** pub/rgnus/lisp/wid-browse.el Thu Mar 6 08:47:28 1997 --- rgnus/lisp/wid-browse.el Fri Mar 7 23:51:35 1997 *************** *** 26,37 **** (defvar widget-browse-mode-map nil "Keymap for `widget-browse-mode'.") ! (unless widget-browse-mode-map (setq widget-browse-mode-map (make-sparse-keymap)) (set-keymap-parent widget-browse-mode-map widget-keymap)) ! (easy-menu-define widget-browse-mode-menu widget-browse-mode-map "Menu used in widget browser buffers." '("Widget" --- 26,37 ---- (defvar widget-browse-mode-map nil "Keymap for `widget-browse-mode'.") ! (unless widget-browse-mode-map (setq widget-browse-mode-map (make-sparse-keymap)) (set-keymap-parent widget-browse-mode-map widget-keymap)) ! (easy-menu-define widget-browse-mode-menu widget-browse-mode-map "Menu used in widget browser buffers." '("Widget" *************** *** 84,90 **** (defun widget-browse (widget) "Create a widget browser for WIDGET." ! (interactive (list (completing-read "Widget: " obarray (lambda (symbol) (get symbol 'widget-type)) --- 84,90 ---- (defun widget-browse (widget) "Create a widget browser for WIDGET." ! (interactive (list (completing-read "Widget: " obarray (lambda (symbol) (get symbol 'widget-type)) *************** *** 104,110 **** (kill-buffer (get-buffer-create "*Browse Widget*")) (switch-to-buffer (get-buffer-create "*Browse Widget*"))) (widget-browse-mode) ! ;; Quick way to get out. (widget-create 'push-button :action (lambda (widget &optional event) --- 104,110 ---- (kill-buffer (get-buffer-create "*Browse Widget*")) (switch-to-buffer (get-buffer-create "*Browse Widget*"))) (widget-browse-mode) ! ;; Quick way to get out. (widget-create 'push-button :action (lambda (widget &optional event) *************** *** 155,161 **** :action 'widget-browse-action) (defun widget-browse-action (widget &optional event) ! ;; Create widget browser for WIDGET's :value. (widget-browse (widget-get widget :value))) (defun widget-browse-value-create (widget) --- 155,161 ---- :action 'widget-browse-action) (defun widget-browse-action (widget &optional event) ! ;; Create widget browser for WIDGET's :value. (widget-browse (widget-get widget :value))) (defun widget-browse-value-create (widget) *** pub/rgnus/lisp/wid-edit.el Thu Mar 6 08:47:28 1997 --- rgnus/lisp/wid-edit.el Fri Mar 7 23:51:35 1997 *************** *** 27,33 **** (require 'atomic-extents) (let ((ext (make-extent from to))) ;; XEmacs doesn't understant different kinds of read-only, so ! ;; we have to use extents instead. (put-text-property from to 'read-only nil) (set-extent-property ext 'read-only t) (set-extent-property ext 'start-open nil) --- 27,33 ---- (require 'atomic-extents) (let ((ext (make-extent from to))) ;; XEmacs doesn't understant different kinds of read-only, so ! ;; we have to use extents instead. (put-text-property from to 'read-only nil) (set-extent-property ext 'read-only t) (set-extent-property ext 'start-open nil) *************** *** 37,43 **** (defun widget-make-intangible (from to size) "Make text between FROM and TO intangible." (put-text-property from to 'intangible 'front))) ! ;; The following should go away when bundled with Emacs. (eval-and-compile (condition-case () --- 37,43 ---- (defun widget-make-intangible (from to size) "Make text between FROM and TO intangible." (put-text-property from to 'intangible 'front))) ! ;; The following should go away when bundled with Emacs. (eval-and-compile (condition-case () *************** *** 47,53 **** (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) ! (defmacro defcustom (var value doc &rest args) `(defvar ,var ,value ,doc)) (defmacro defface (&rest args) nil) (define-widget-keywords :prefix :tag :load :link :options :type :group) --- 47,53 ---- (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) ! (defmacro defcustom (var value doc &rest args) `(defvar ,var ,value ,doc)) (defmacro defface (&rest args) nil) (define-widget-keywords :prefix :tag :load :link :options :type :group) *************** *** 81,87 **** (defgroup widgets nil "Customization support for the Widget Library." :link '(custom-manual "(widget)Top") ! :link '(url-link :tag "Development Page" "http://www.dina.kvl.dk/~abraham/custom/") :prefix "widget-" :group 'extensions --- 81,87 ---- (defgroup widgets nil "Customization support for the Widget Library." :link '(custom-manual "(widget)Top") ! :link '(url-link :tag "Development Page" "http://www.dina.kvl.dk/~abraham/custom/") :prefix "widget-" :group 'extensions *************** *** 113,119 **** (((class grayscale color) (background dark)) (:background "dark gray")) ! (t (:italic t))) "Face used for editable fields." :group 'widgets) --- 113,119 ---- (((class grayscale color) (background dark)) (:background "dark gray")) ! (t (:italic t))) "Face used for editable fields." :group 'widgets) *************** *** 211,218 **** nil))) ;;; Widget text specifications. ! ;; ! ;; These functions are for specifying text properties. (defun widget-specify-none (from to) ;; Clear all text properties between FROM and TO. --- 211,218 ---- nil))) ;;; Widget text specifications. ! ;; ! ;; These functions are for specifying text properties. (defun widget-specify-none (from to) ;; Clear all text properties between FROM and TO. *************** *** 241,247 **** ;; choice widget). We try to compensate by checking the format ;; string, and hope the user hasn't changed the :create method. (widget-make-intangible (- from 2) from 'end-open)) ! ;; Make it possible to edit back end of the field. (add-text-properties to (1+ to) (list 'front-sticky nil 'read-only t --- 241,247 ---- ;; choice widget). We try to compensate by checking the format ;; string, and hope the user hasn't changed the :create method. (widget-make-intangible (- from 2) from 'end-open)) ! ;; Make it possible to edit back end of the field. (add-text-properties to (1+ to) (list 'front-sticky nil 'read-only t *************** *** 264,270 **** ;; I tried putting an invisible intangible read-only space ;; before the newline, which gave really weird effects. ;; So for now, we just have trust the user not to delete the ! ;; newline. (put-text-property to (1+ to) 'read-only nil)))) (defun widget-specify-field-update (widget from to) --- 264,270 ---- ;; I tried putting an invisible intangible read-only space ;; before the newline, which gave really weird effects. ;; So for now, we just have trust the user not to delete the ! ;; newline. (put-text-property to (1+ to) 'read-only nil)))) (defun widget-specify-field-update (widget from to) *************** *** 276,282 **** (face (or (widget-get widget :value-face) 'widget-field-face))) ! (when secret (while (and size (not (zerop size)) (> secret-to from) --- 276,282 ---- (face (or (widget-get widget :value-face) 'widget-field-face))) ! (when secret (while (and size (not (zerop size)) (> secret-to from) *************** *** 297,303 **** 'local-map map 'face face)) ! (when secret (save-excursion (goto-char from) (while (< (point) secret-to) --- 297,303 ---- 'local-map map 'face face)) ! (when secret (save-excursion (goto-char from) (while (< (point) secret-to) *************** *** 373,379 **** missing nil)) ((setq tmp (car widget)) (setq widget (get tmp 'widget-type))) ! (t (setq missing nil)))) value)) --- 373,379 ---- missing nil)) ((setq tmp (car widget)) (setq widget (get tmp 'widget-type))) ! (t (setq missing nil)))) value)) *************** *** 444,450 **** (widget-glyph-insert-glyph widget tag image)) (t ;; A string. Look it up in. ! (let ((file (concat widget-glyph-directory (if (string-match "/\\'" widget-glyph-directory) "" "/") --- 444,450 ---- (widget-glyph-insert-glyph widget tag image)) (t ;; A string. Look it up in. ! (let ((file (concat widget-glyph-directory (if (string-match "/\\'" widget-glyph-directory) "" "/") *************** *** 460,466 **** (set-glyph-image glyph (cons 'tty tag)) (set-glyph-property glyph 'widget widget) (insert "*") ! (add-text-properties (1- (point)) (point) (list 'invisible t 'end-glyph glyph))) --- 460,466 ---- (set-glyph-image glyph (cons 'tty tag)) (set-glyph-property glyph 'widget widget) (insert "*") ! (add-text-properties (1- (point)) (point) (list 'invisible t 'end-glyph glyph))) *************** *** 468,474 **** ;;;###autoload (defun widget-create (type &rest args) ! "Create widget of TYPE. The optional ARGS are additional keyword arguments." (let ((widget (apply 'widget-convert type args))) (widget-apply widget :create) --- 468,474 ---- ;;;###autoload (defun widget-create (type &rest args) ! "Create widget of TYPE. The optional ARGS are additional keyword arguments." (let ((widget (apply 'widget-convert type args))) (widget-apply widget :create) *************** *** 515,524 **** (widget-apply widget :delete)) (defun widget-convert (type &rest args) ! "Convert TYPE to a widget without inserting it in the buffer. The optional ARGS are additional keyword arguments." ;; Don't touch the type. ! (let* ((widget (if (symbolp type) (list type) (copy-list type))) (current widget) --- 515,524 ---- (widget-apply widget :delete)) (defun widget-convert (type &rest args) ! "Convert TYPE to a widget without inserting it in the buffer. The optional ARGS are additional keyword arguments." ;; Don't touch the type. ! (let* ((widget (if (symbolp type) (list type) (copy-list type))) (current widget) *************** *** 544,553 **** (setq widget (funcall convert-widget widget)))) (setq type (get (car type) 'widget-type))) ;; Finally set the keyword args. ! (while keys (let ((next (nth 0 keys))) (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:)) ! (progn (widget-put widget next (nth 1 keys)) (setq keys (nthcdr 2 keys))) (setq keys nil)))) --- 544,553 ---- (setq widget (funcall convert-widget widget)))) (setq type (get (car type) 'widget-type))) ;; Finally set the keyword args. ! (while keys (let ((next (nth 0 keys))) (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:)) ! (progn (widget-put widget next (nth 1 keys)) (setq keys (nthcdr 2 keys))) (setq keys nil)))) *************** *** 573,579 **** "Keymap containing useful binding for buffers containing widgets. Recommended as a parent keymap for modes using widgets.") ! (unless widget-keymap (setq widget-keymap (make-sparse-keymap)) (define-key widget-keymap "\C-k" 'widget-kill-line) (define-key widget-keymap "\t" 'widget-forward) --- 573,579 ---- "Keymap containing useful binding for buffers containing widgets. Recommended as a parent keymap for modes using widgets.") ! (unless widget-keymap (setq widget-keymap (make-sparse-keymap)) (define-key widget-keymap "\C-k" 'widget-kill-line) (define-key widget-keymap "\t" 'widget-forward) *************** *** 581,587 **** (define-key widget-keymap [(shift tab)] 'widget-backward) (define-key widget-keymap [backtab] 'widget-backward) (if (string-match "XEmacs" (emacs-version)) ! (progn (define-key widget-keymap [button2] 'widget-button-click) (define-key widget-keymap [button1] 'widget-button1-click)) (define-key widget-keymap [mouse-2] 'ignore) --- 581,587 ---- (define-key widget-keymap [(shift tab)] 'widget-backward) (define-key widget-keymap [backtab] 'widget-backward) (if (string-match "XEmacs" (emacs-version)) ! (progn (define-key widget-keymap [button2] 'widget-button-click) (define-key widget-keymap [button1] 'widget-button1-click)) (define-key widget-keymap [mouse-2] 'ignore) *************** *** 595,601 **** (defvar widget-field-keymap nil "Keymap used inside an editable field.") ! (unless widget-field-keymap (setq widget-field-keymap (copy-keymap widget-keymap)) (unless (string-match "XEmacs" (emacs-version)) (define-key widget-field-keymap [menu-bar] 'nil)) --- 595,601 ---- (defvar widget-field-keymap nil "Keymap used inside an editable field.") ! (unless widget-field-keymap (setq widget-field-keymap (copy-keymap widget-keymap)) (unless (string-match "XEmacs" (emacs-version)) (define-key widget-field-keymap [menu-bar] 'nil)) *************** *** 607,613 **** (defvar widget-text-keymap nil "Keymap used inside a text field.") ! (unless widget-text-keymap (setq widget-text-keymap (copy-keymap widget-keymap)) (unless (string-match "XEmacs" (emacs-version)) (define-key widget-text-keymap [menu-bar] 'nil)) --- 607,613 ---- (defvar widget-text-keymap nil "Keymap used inside a text field.") ! (unless widget-text-keymap (setq widget-text-keymap (copy-keymap widget-keymap)) (unless (string-match "XEmacs" (emacs-version)) (define-key widget-text-keymap [menu-bar] 'nil)) *************** *** 637,643 **** (let ((button (get-text-property (event-point event) 'button))) (if button (widget-apply button :action event) ! (call-interactively (or (lookup-key widget-global-map [ button2 ]) (lookup-key widget-global-map [ down-mouse-2 ]) (lookup-key widget-global-map [ mouse-2])))))) --- 637,643 ---- (let ((button (get-text-property (event-point event) 'button))) (if button (widget-apply button :action event) ! (call-interactively (or (lookup-key widget-global-map [ button2 ]) (lookup-key widget-global-map [ down-mouse-2 ]) (lookup-key widget-global-map [ mouse-2])))))) *************** *** 812,818 **** (defun widget-field-find (pos) ;; Find widget whose editing field is located at POS. ;; Return nil if POS is not inside and editing field. ! ;; ;; This is only used in `widget-field-modified', since ordinarily ;; you would just test the field property. (let ((fields widget-field-list) --- 812,818 ---- (defun widget-field-find (pos) ;; Find widget whose editing field is located at POS. ;; Return nil if POS is not inside and editing field. ! ;; ;; This is only used in `widget-field-modified', since ordinarily ;; you would just test the field property. (let ((fields widget-field-list) *************** *** 838,844 **** (message "Error: `widget-after-change' called on two fields")) (t (let ((size (widget-get field :size))) ! (if size (let ((begin (1+ (widget-get field :value-from))) (end (1- (widget-get field :value-to)))) (widget-specify-field-update field begin end) --- 838,844 ---- (message "Error: `widget-after-change' called on two fields")) (t (let ((size (widget-get field :size))) ! (if size (let ((begin (1+ (widget-get field :value-from))) (end (1- (widget-get field :value-to)))) (widget-specify-field-update field begin end) *************** *** 847,853 **** (save-excursion (goto-char end) (insert-char ?\ (- (+ begin size) end)) ! (widget-specify-field-update field begin (+ begin size)))) ((> (- end begin) size) --- 847,853 ---- (save-excursion (goto-char end) (insert-char ?\ (- (+ begin size) end)) ! (widget-specify-field-update field begin (+ begin size)))) ((> (- end begin) size) *************** *** 869,875 **** ;;; Widget Functions ;; ! ;; These functions are used in the definition of multiple widgets. (defun widget-children-value-delete (widget) "Delete all :children and :buttons in WIDGET." --- 869,875 ---- ;;; Widget Functions ;; ! ;; These functions are used in the definition of multiple widgets. (defun widget-children-value-delete (widget) "Delete all :children and :buttons in WIDGET." *************** *** 893,900 **** :indent nil :offset 0 :format-handler 'widget-default-format-handler ! :button-face-get 'widget-default-button-face-get ! :sample-face-get 'widget-default-sample-face-get :delete 'widget-default-delete :value-set 'widget-default-value-set :value-inline 'widget-default-value-inline --- 893,900 ---- :indent nil :offset 0 :format-handler 'widget-default-format-handler ! :button-face-get 'widget-default-button-face-get ! :sample-face-get 'widget-default-sample-face-get :delete 'widget-default-delete :value-set 'widget-default-value-set :value-inline 'widget-default-value-inline *************** *** 935,941 **** (insert "\n") (insert-char ? (widget-get widget :indent)))) ((eq escape ?t) ! (cond (glyph (widget-glyph-insert widget (or tag "image") glyph)) (tag (insert tag)) --- 935,941 ---- (insert "\n") (insert-char ? (widget-get widget :indent)))) ((eq escape ?t) ! (cond (glyph (widget-glyph-insert widget (or tag "image") glyph)) (tag (insert tag)) *************** *** 954,960 **** (if (and button-begin (not button-end)) (widget-apply widget :value-create) (setq value-pos (point)))) ! (t (widget-apply widget :format-handler escape))))) ;; Specify button, sample, and doc, and insert value. (and button-begin button-end --- 954,960 ---- (if (and button-begin (not button-end)) (widget-apply widget :value-create) (setq value-pos (point)))) ! (t (widget-apply widget :format-handler escape))))) ;; Specify button, sample, and doc, and insert value. (and button-begin button-end *************** *** 1001,1007 **** (push (if (string-match "\n." doc-text) ;; Allow multiline doc to be hiden. (widget-create-child-and-convert ! widget 'widget-help :doc (progn (string-match "\\`.*" doc-text) (match-string 0 doc-text)) --- 1001,1007 ---- (push (if (string-match "\n." doc-text) ;; Allow multiline doc to be hiden. (widget-create-child-and-convert ! widget 'widget-help :doc (progn (string-match "\\`.*" doc-text) (match-string 0 doc-text)) *************** *** 1011,1017 **** (widget-create-child-and-convert widget 'item :format "%d" :doc doc-text nil)) buttons))) ! (t (error "Unknown escape `%c'" escape))) (widget-put widget :buttons buttons))) --- 1011,1017 ---- (widget-create-child-and-convert widget 'item :format "%d" :doc doc-text nil)) buttons))) ! (t (error "Unknown escape `%c'" escape))) (widget-put widget :buttons buttons))) *************** *** 1080,1086 **** (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 :value-to-internal (car args))) (widget-put widget :args nil))) --- 1080,1086 ---- (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 :value-to-internal (car args))) (widget-put widget :args nil))) *************** *** 1139,1145 **** (fboundp 'device-on-window-system-p) (device-on-window-system-p) (string-match "XEmacs" emacs-version)) ! (progn (unless gui (setq gui (make-gui-button tag 'widget-gui-action widget)) (push (cons tag gui) widget-push-button-cache)) --- 1139,1145 ---- (fboundp 'device-on-window-system-p) (device-on-window-system-p) (string-match "XEmacs" emacs-version)) ! (progn (unless gui (setq gui (make-gui-button tag 'widget-gui-action widget)) (push (cons tag gui) widget-push-button-cache)) *************** *** 1205,1215 **** (invalid (widget-apply widget :validate))) (when invalid (error (widget-get invalid :error))) ! (widget-value-set widget ! (widget-apply widget :value-to-external ! (read-string (concat tag ": ") ! (widget-apply widget :value-to-internal (widget-value widget)) --- 1205,1215 ---- (invalid (widget-apply widget :validate))) (when invalid (error (widget-get invalid :error))) ! (widget-value-set widget ! (widget-apply widget :value-to-external ! (read-string (concat tag ": ") ! (widget-apply widget :value-to-internal (widget-value widget)) *************** *** 1263,1269 **** (secret (widget-get widget :secret)) (old (current-buffer))) (if (and from to) ! (progn (set-buffer (marker-buffer from)) (setq from (1+ from) to (1- to)) --- 1263,1269 ---- (secret (widget-get widget :secret)) (old (current-buffer))) (if (and from to) ! (progn (set-buffer (marker-buffer from)) (setq from (1+ from) to (1- to)) *************** *** 1373,1379 **** choices))) (widget-choose tag (reverse choices) event)))) (when current ! (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) (widget-apply widget :notify widget event) --- 1373,1379 ---- choices))) (widget-choose tag (reverse choices) event)))) (when current ! (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) (widget-apply widget :notify widget event) *************** *** 1425,1432 **** (defun widget-toggle-value-create (widget) ;; Insert text representing the `on' and `off' states. (if (widget-value widget) ! (widget-glyph-insert widget ! (widget-get widget :on) (widget-get widget :on-glyph)) (widget-glyph-insert widget (widget-get widget :off) --- 1425,1432 ---- (defun widget-toggle-value-create (widget) ;; Insert text representing the `on' and `off' states. (if (widget-value widget) ! (widget-glyph-insert widget ! (widget-get widget :on) (widget-get widget :on-glyph)) (widget-glyph-insert widget (widget-get widget :off) *************** *** 1436,1442 **** ;; Toggle value. (widget-value-set widget (not (widget-value widget))) (widget-apply widget :notify widget event)) ! ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle --- 1436,1442 ---- ;; Toggle value. (widget-value-set widget (not (widget-value widget))) (widget-apply widget :notify widget event)) ! ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle *************** *** 1468,1474 **** ;; Insert all values (let ((alist (widget-checklist-match-find widget (widget-get widget :value))) (args (widget-get widget :args))) ! (while args (widget-checklist-add-item widget (car args) (assq (car args) alist)) (setq args (cdr args))) (widget-put widget :children (nreverse (widget-get widget :children))))) --- 1468,1474 ---- ;; Insert all values (let ((alist (widget-checklist-match-find widget (widget-get widget :value))) (args (widget-get widget :args))) ! (while args (widget-checklist-add-item widget (car args) (assq (car args) alist)) (setq args (cdr args))) (widget-put widget :children (nreverse (widget-get widget :children))))) *************** *** 1479,1485 **** (and (eq (preceding-char) ?\n) (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) ! (widget-specify-insert (let* ((children (widget-get widget :children)) (buttons (widget-get widget :buttons)) (from (point)) --- 1479,1485 ---- (and (eq (preceding-char) ?\n) (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) ! (widget-specify-insert (let* ((children (widget-get widget :children)) (buttons (widget-get widget :buttons)) (from (point)) *************** *** 1505,1511 **** (t (widget-create-child-value widget type (car (cdr chosen))))))) ! (t (error "Unknown escape `%c'" escape))))) ;; Update properties. (and button child (widget-put child :button button)) --- 1505,1511 ---- (t (widget-create-child-value widget type (car (cdr chosen))))))) ! (t (error "Unknown escape `%c'" escape))))) ;; Update properties. (and button child (widget-put child :button button)) *************** *** 1524,1530 **** found rest) (while values (let ((answer (widget-checklist-match-up args values))) ! (cond (answer (let ((vals (widget-match-inline answer values))) (setq found (append found (car vals)) values (cdr vals) --- 1524,1530 ---- found rest) (while values (let ((answer (widget-checklist-match-up args values))) ! (cond (answer (let ((vals (widget-match-inline answer values))) (setq found (append found (car vals)) values (cdr vals) *************** *** 1532,1538 **** (greedy (setq rest (append rest (list (car values))) values (cdr values))) ! (t (setq rest (append rest values) values nil))))) (cons found rest))) --- 1532,1538 ---- (greedy (setq rest (append rest (list (car values))) values (cdr values))) ! (t (setq rest (append rest values) values nil))))) (cons found rest))) *************** *** 1545,1558 **** found) (while vals (let ((answer (widget-checklist-match-up args vals))) ! (cond (answer (let ((match (widget-match-inline answer vals))) (setq found (cons (cons answer (car match)) found) vals (cdr match) args (delq answer args)))) (greedy (setq vals (cdr vals))) ! (t (setq vals nil))))) found)) --- 1545,1558 ---- found) (while vals (let ((answer (widget-checklist-match-up args vals))) ! (cond (answer (let ((match (widget-match-inline answer vals))) (setq found (cons (cons answer (car match)) found) vals (cdr match) args (delq answer args)))) (greedy (setq vals (cdr vals))) ! (t (setq vals nil))))) found)) *************** *** 1571,1577 **** ;; The values of all selected items. (let ((children (widget-get widget :children)) child result) ! (while children (setq child (car children) children (cdr children)) (if (widget-value (widget-get child :button)) --- 1571,1577 ---- ;; The values of all selected items. (let ((children (widget-get widget :children)) child result) ! (while children (setq child (car children) children (cdr children)) (if (widget-value (widget-get child :button)) *************** *** 1646,1652 **** ;; Insert all values (let ((args (widget-get widget :args)) arg) ! (while args (setq arg (car args) args (cdr args)) (widget-radio-add-item widget arg)))) --- 1646,1652 ---- ;; Insert all values (let ((args (widget-get widget :args)) arg) ! (while args (setq arg (car args) args (cdr args)) (widget-radio-add-item widget arg)))) *************** *** 1657,1663 **** (and (eq (preceding-char) ?\n) (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) ! (widget-specify-insert (let* ((value (widget-get widget :value)) (children (widget-get widget :children)) (buttons (widget-get widget :buttons)) --- 1657,1663 ---- (and (eq (preceding-char) ?\n) (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) ! (widget-specify-insert (let* ((value (widget-get widget :value)) (children (widget-get widget :children)) (buttons (widget-get widget :buttons)) *************** *** 1675,1693 **** (insert "%")) ((eq escape ?b) (setq button (widget-create-child-and-convert ! widget 'radio-button :value (not (null chosen))))) ((eq escape ?v) (setq child (if chosen (widget-create-child-value widget type value) (widget-create-child widget type)))) ! (t (error "Unknown escape `%c'" escape))))) ;; Update properties. (when chosen (widget-put widget :choice type)) ! (when button (widget-put child :button button) (widget-put widget :buttons (nconc buttons (list button)))) (when child --- 1675,1693 ---- (insert "%")) ((eq escape ?b) (setq button (widget-create-child-and-convert ! widget 'radio-button :value (not (null chosen))))) ((eq escape ?v) (setq child (if chosen (widget-create-child-value widget type value) (widget-create-child widget type)))) ! (t (error "Unknown escape `%c'" escape))))) ;; Update properties. (when chosen (widget-put widget :choice type)) ! (when button (widget-put child :button button) (widget-put widget :buttons (nconc buttons (list button)))) (when child *************** *** 1740,1746 **** (match (and (not found) (widget-apply current :match value)))) (widget-value-set button match) ! (if match (widget-value-set current value)) (setq found (or found match)))))) --- 1740,1746 ---- (match (and (not found) (widget-apply current :match value)))) (widget-value-set button match) ! (if match (widget-value-set current value)) (setq found (or found match)))))) *************** *** 1783,1789 **** (defun widget-insert-button-action (widget &optional event) ;; Ask the parent to insert a new item. ! (widget-apply (widget-get widget :parent) :insert-before (widget-get widget :widget))) ;;; The `delete-button' Widget. --- 1783,1789 ---- (defun widget-insert-button-action (widget &optional event) ;; Ask the parent to insert a new item. ! (widget-apply (widget-get widget :parent) :insert-before (widget-get widget :widget))) ;;; The `delete-button' Widget. *************** *** 1795,1801 **** (defun widget-delete-button-action (widget &optional event) ;; Ask the parent to insert a new item. ! (widget-apply (widget-get widget :parent) :delete-at (widget-get widget :widget))) ;;; The `editable-list' Widget. --- 1795,1801 ---- (defun widget-delete-button-action (widget &optional event) ;; Ask the parent to insert a new item. ! (widget-apply (widget-get widget :parent) :delete-at (widget-get widget :widget))) ;;; The `editable-list' Widget. *************** *** 1829,1835 **** (and (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) (widget-create-child-and-convert widget 'insert-button)) ! (t (widget-default-format-handler widget escape))))) (defun widget-editable-list-value-create (widget) --- 1829,1835 ---- (and (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) (widget-create-child-and-convert widget 'insert-button)) ! (t (widget-default-format-handler widget escape))))) (defun widget-editable-list-value-create (widget) *************** *** 1880,1886 **** found) (while (and value ok) (let ((answer (widget-match-inline type value))) ! (if answer (setq found (append found (car answer)) value (cdr answer)) (setq ok nil)))) --- 1880,1886 ---- found) (while (and value ok) (let ((answer (widget-match-inline type value))) ! (if answer (setq found (append found (car answer)) value (cdr answer)) (setq ok nil)))) *************** *** 1892,1902 **** (let ((children (widget-get widget :children)) (inhibit-read-only t) after-change-functions) ! (cond (before (goto-char (widget-get before :entry-from))) (t (goto-char (widget-get widget :value-pos)))) ! (let ((child (widget-editable-list-entry-create widget nil nil))) (when (< (widget-get child :entry-from) (widget-get widget :from)) (set-marker (widget-get widget :from) --- 1892,1902 ---- (let ((children (widget-get widget :children)) (inhibit-read-only t) after-change-functions) ! (cond (before (goto-char (widget-get before :entry-from))) (t (goto-char (widget-get widget :value-pos)))) ! (let ((child (widget-editable-list-entry-create widget nil nil))) (when (< (widget-get child :entry-from) (widget-get widget :from)) (set-marker (widget-get widget :from) *************** *** 1942,1948 **** (let ((type (nth 0 (widget-get widget :args))) (widget-push-button-gui widget-editable-list-gui) child delete insert) ! (widget-specify-insert (save-excursion (and (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) --- 1942,1948 ---- (let ((type (nth 0 (widget-get widget :args))) (widget-push-button-gui widget-editable-list-gui) child delete insert) ! (widget-specify-insert (save-excursion (and (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) *************** *** 1961,1973 **** widget 'delete-button))) ((eq escape ?v) (if conv ! (setq child (widget-create-child-value widget type value)) (setq child (widget-create-child widget type)))) ! (t (error "Unknown escape `%c'" escape))))) ! (widget-put widget ! :buttons (cons delete (cons insert (widget-get widget :buttons)))) (let ((entry-from (copy-marker (point-min))) --- 1961,1973 ---- widget 'delete-button))) ((eq escape ?v) (if conv ! (setq child (widget-create-child-value widget type value)) (setq child (widget-create-child widget type)))) ! (t (error "Unknown escape `%c'" escape))))) ! (widget-put widget ! :buttons (cons delete (cons insert (widget-get widget :buttons)))) (let ((entry-from (copy-marker (point-min))) *************** *** 2030,2036 **** (setq argument (car args) args (cdr args) answer (widget-match-inline argument vals)) ! (if answer (setq vals (cdr answer) found (append found (car answer))) (setq vals nil --- 2030,2036 ---- (setq argument (car args) args (cdr args) answer (widget-match-inline argument vals)) ! (if answer (setq vals (cdr answer) found (append found (car answer))) (setq vals nil *************** *** 2085,2091 **** :tag "Regexp") (define-widget 'file 'string ! "A file widget. It will read a file name from the minibuffer when activated." :format "%[%t%]: %v" :tag "File" --- 2085,2091 ---- :tag "Regexp") (define-widget 'file 'string ! "A file widget. It will read a file name from the minibuffer when activated." :format "%[%t%]: %v" :tag "File" *************** *** 2105,2111 **** (widget-setup))) (define-widget 'directory 'file ! "A directory widget. It will read a directory name from the minibuffer when activated." :tag "Directory") --- 2105,2111 ---- (widget-setup))) (define-widget 'directory 'file ! "A directory widget. It will read a directory name from the minibuffer when activated." :tag "Directory") *************** *** 2180,2186 **** :value 0 :type-error "This field should contain an integer" :value-to-internal (lambda (widget value) ! (if (integerp value) (prin1-to-string value) value)) :match (lambda (widget value) (integerp value))) --- 2180,2186 ---- :value 0 :type-error "This field should contain an integer" :value-to-internal (lambda (widget value) ! (if (integerp value) (prin1-to-string value) value)) :match (lambda (widget value) (integerp value))) *************** *** 2189,2199 **** "An character." :tag "Character" :value 0 ! :size 1 :format "%{%t%}: %v\n" :type-error "This field should contain a character" :value-to-internal (lambda (widget value) ! (if (integerp value) (char-to-string value) value)) :value-to-external (lambda (widget value) --- 2189,2199 ---- "An character." :tag "Character" :value 0 ! :size 1 :format "%{%t%}: %v\n" :type-error "This field should contain a character" :value-to-internal (lambda (widget value) ! (if (integerp value) (char-to-string value) value)) :value-to-external (lambda (widget value) *************** *** 2226,2232 **** :value-to-internal (lambda (widget value) (append value nil)) :value-to-external (lambda (widget value) (apply 'vector value))) ! (defun widget-vector-match (widget value) (and (vectorp value) (widget-group-match widget (widget-apply :value-to-internal widget value)))) --- 2226,2232 ---- :value-to-internal (lambda (widget value) (append value nil)) :value-to-external (lambda (widget value) (apply 'vector value))) ! (defun widget-vector-match (widget value) (and (vectorp value) (widget-group-match widget (widget-apply :value-to-internal widget value)))) *************** *** 2241,2247 **** :value-to-external (lambda (widget value) (cons (nth 0 value) (nth 1 value)))) ! (defun widget-cons-match (widget value) (and (consp value) (widget-group-match widget (widget-apply widget :value-to-internal value)))) --- 2241,2247 ---- :value-to-external (lambda (widget value) (cons (nth 0 value) (nth 1 value)))) ! (defun widget-cons-match (widget value) (and (consp value) (widget-group-match widget (widget-apply widget :value-to-internal value)))) *************** *** 2303,2309 **** (defun widget-color-choice-list () (unless widget-color-choice-list ! (setq widget-color-choice-list (mapcar '(lambda (color) (list color)) (x-defined-colors)))) widget-color-choice-list) --- 2303,2309 ---- (defun widget-color-choice-list () (unless widget-color-choice-list ! (setq widget-color-choice-list (mapcar '(lambda (color) (list color)) (x-defined-colors)))) widget-color-choice-list) *************** *** 2332,2338 **** (read-color prompt)) ((fboundp 'x-defined-colors) (completing-read (concat tag ": ") ! (widget-color-choice-list) nil nil nil 'widget-color-history)) (t (read-string prompt (widget-value widget)))))) --- 2332,2338 ---- (read-color prompt)) ((fboundp 'x-defined-colors) (completing-read (concat tag ": ") ! (widget-color-choice-list) nil nil nil 'widget-color-history)) (t (read-string prompt (widget-value widget)))))) *** pub/rgnus/lisp/widget.el Thu Mar 6 08:47:29 1997 --- rgnus/lisp/widget.el Fri Mar 7 23:51:36 1997 *************** *** 28,34 **** (setq keywords (cdr keywords))))))) (define-widget-keywords :tag-glyph :off-glyph :on-glyph :valid-regexp ! :secret :sample-face :sample-face-get :case-fold :widget-doc :create :convert-widget :format :value-create :offset :extra-offset :tag :doc :from :to :args :value :value-from :value-to :action :value-set :value-delete :match :parent :delete :menu-tag-get --- 28,34 ---- (setq keywords (cdr keywords))))))) (define-widget-keywords :tag-glyph :off-glyph :on-glyph :valid-regexp ! :secret :sample-face :sample-face-get :case-fold :widget-doc :create :convert-widget :format :value-create :offset :extra-offset :tag :doc :from :to :args :value :value-from :value-to :action :value-set :value-delete :match :parent :delete :menu-tag-get *************** *** 39,45 **** :must-match :type-error :value-inline :inline :match-inline :greedy :button-face-get :button-face :value-face :keymap :entry-from :entry-to :help-echo :documentation-property :hide-front-space ! :hide-rear-space) ;; These autoloads should be deleted when the file is added to Emacs. (unless (fboundp 'load-gc) --- 39,45 ---- :must-match :type-error :value-inline :inline :match-inline :greedy :button-face-get :button-face :value-face :keymap :entry-from :entry-to :help-echo :documentation-property :hide-front-space ! :hide-rear-space) ;; These autoloads should be deleted when the file is added to Emacs. (unless (fboundp 'load-gc) *** pub/rgnus/lisp/ChangeLog Fri Mar 7 07:36:58 1997 --- rgnus/lisp/ChangeLog Fri Mar 7 23:51:12 1997 *************** *** 1,3 **** --- 1,29 ---- + Fri Mar 7 23:33:34 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.22 is released. + + Fri Mar 7 08:25:20 1997 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-do-gcc): Made interactive. + + * gnus-sum.el (gnus-read-move-group-name): Beep on empty names. + + * nnmail.el (nnmail-check-duplication): Don't rename Message-ID. + (nnmail-cache-message-id-when-accepting): Removed. + + * gnus-sum.el (gnus-nov-parse-line): Allow showing of multiple + articles with the same Message-ID. + (gnus-get-newsgroup-headers): Ditto. + + * gnus.el: Removed trailing spaces throughout. + + * gnus-art.el (gnus-header-name-face): Made easier on the eyes. + (gnus-article-add-buttons): Make buffer read/write before doing + anything. + + * message.el (message-font-lock-keywords): Changed expression and + faces. + Fri Mar 7 07:36:14 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.21 is released. *** pub/rgnus/texi/Makefile Sat Mar 1 03:54:53 1997 --- rgnus/texi/Makefile Fri Mar 7 23:51:36 1997 *************** *** 6,11 **** --- 6,12 ---- LATEX=latex DVIPS=dvips PERL=perl + INFODIR=/usr/local/info all: gnus message custom widget *************** *** 104,106 **** --- 105,113 ---- make clean rm -f *.orig *.rej *.elc *~ gnus gnus-[0-9] gnus-[0-9][0-9] rm -f message message-[0-9] widget custom + + install: + cp gnus gnus-[0-9] gnus-[0-9][0-9] $(INFODIR) + cp message message-[0-9] $(INFODIR) + cp widget widget-[0-9] $(INFODIR) + cp custom custom-[0-9] $(INFODIR) *** pub/rgnus/texi/ChangeLog Thu Mar 6 08:47:30 1997 --- rgnus/texi/ChangeLog Fri Mar 7 23:51:36 1997 *************** *** 1,3 **** --- 1,7 ---- + Fri Mar 7 10:49:43 1997 Lars Magne Ingebrigtsen + + * Makefile: New "install" target. + Thu Mar 6 08:01:37 1997 Lars Magne Ingebrigtsen * gnus.texi (Mail and Procmail): Fix.