*** pub/dgnus/lisp/custom.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/custom.el Sat Aug 19 15:37:49 1995 *************** *** 248,254 **** "The value currently displayed for NAME in the customization buffer." (let* ((field (custom-name-field name)) (custom (custom-field-custom field))) ! (funcall (custom-property custom 'export) (car (custom-field-extract custom field))))) ;;; Custom Functions: --- 248,255 ---- "The value currently displayed for NAME in the customization buffer." (let* ((field (custom-name-field name)) (custom (custom-field-custom field))) ! (custom-field-parse field) ! (funcall (custom-property custom 'export) custom (car (custom-field-extract custom field))))) ;;; Custom Functions: *************** *** 308,313 **** --- 309,317 ---- (defconst custom-type-properties '((repeat (type . default) + (import . custom-repeat-import) + (eval . custom-repeat-eval) + (quote . custom-repeat-quote) (accept . custom-repeat-accept) (extract . custom-repeat-extract) (validate . custom-repeat-validate) *************** *** 318,331 **** (del-tag . "[DEL]") (add-tag . "[INS]")) (pair (type . group) (valid . (lambda (c d) (consp d))) (extract . custom-pair-extract)) (list (type . group) - (valid . (lambda (c d) (listp d))) (quote . custom-list-quote) (extract . custom-list-extract)) (group (type . default) (face-tag . nil) (initialize . custom-group-initialize) (apply . custom-group-apply) (reset . custom-group-reset) --- 322,341 ---- (del-tag . "[DEL]") (add-tag . "[INS]")) (pair (type . group) + (accept . custom-pair-accept) + (eval . custom-pair-eval) + (import . custom-pair-import) + (quote . custom-pair-quote) (valid . (lambda (c d) (consp d))) (extract . custom-pair-extract)) (list (type . group) (quote . custom-list-quote) + (valid . (lambda (c d) (listp d))) (extract . custom-list-extract)) (group (type . default) (face-tag . nil) + (eval . custom-group-eval) + (import . custom-group-import) (initialize . custom-group-initialize) (apply . custom-group-apply) (reset . custom-group-reset) *************** *** 380,387 **** make the text `bold', `italic', or `underline' respectively. For some fonts `bold' or `italic' will not make any visible change.")) (face (type . choice) ! (quote . custom-face-quote) ! (export . custom-face-export) (import . custom-face-import) (data ((tag . "None") (default . nil) --- 390,396 ---- make the text `bold', `italic', or `underline' respectively. For some fonts `bold' or `italic' will not make any visible change.")) (face (type . choice) ! (eval . custom-face-eval) (import . custom-face-import) (data ((tag . "None") (default . nil) *************** *** 425,431 **** ((tag . "Customized") (compact . t) (face-tag . custom-face-hack) ! (export . custom-face-export) (data ((hidden . t) (tag . "") (doc . "\ --- 434,440 ---- ((tag . "Customized") (compact . t) (face-tag . custom-face-hack) ! (eval . custom-face-eval) (data ((hidden . t) (tag . "") (doc . "\ *************** *** 472,493 **** (sexp (type . default) (width . 40) (default . (__uninitialized__ . "Uninitialized")) - (valid . custom-sexp-valid) - (quote . custom-sexp-quote) (read . custom-sexp-read) (write . custom-sexp-write)) ! (symbol (type . default) (width . 40) ! (valid . (lambda (c d) (symbolp d))) ! (quote . custom-symbol-quote) ! (read . custom-symbol-read) ! (write . custom-symbol-write)) ! (integer (type . default) (width . 10) ! (valid . (lambda (c d) (integerp d))) ! (allow-padding . nil) ! (read . custom-integer-read) ! (write . custom-integer-write)) (string (type . default) (width . 40) (valid . (lambda (c d) (stringp d))) --- 481,494 ---- (sexp (type . default) (width . 40) (default . (__uninitialized__ . "Uninitialized")) (read . custom-sexp-read) (write . custom-sexp-write)) ! (symbol (type . sexp) (width . 40) ! (valid . (lambda (c d) (symbolp d)))) ! (integer (type . sexp) (width . 10) ! (valid . (lambda (c d) (integerp d)))) (string (type . default) (width . 40) (valid . (lambda (c d) (stringp d))) *************** *** 514,523 **** (doc . nil) (header . t) (padding . ? ) ! (allow-padding . t) ! (quote . identity) ! (export . identity) ! (import . identity) (synchronize . ignore) (initialize . custom-default-initialize) (extract . custom-default-extract) --- 515,524 ---- (doc . nil) (header . t) (padding . ? ) ! (quote . custom-default-quote) ! (eval . (lambda (c v) nil)) ! (export . custom-default-export) ! (import . (lambda (c v) (list v))) (synchronize . ignore) (initialize . custom-default-initialize) (extract . custom-default-extract) *************** *** 543,548 **** --- 544,552 ---- (defconst custom-nil '__uninitialized__ "Special value representing an uninitialized field.") + (defconst custom-invalid '__invalid__ + "Special value representing an invalid field.") + (defun custom-property (custom property) "Extract from CUSTOM property PROPERTY." (let ((entry (assq property custom))) *************** *** 555,560 **** --- 559,576 ---- (custom-assert 'custom))) (cdr entry))) + (defun custom-super (custom property) + "Extract from CUSTOM property PROPERTY. Start with CUSTOM's superclass." + (let ((entry nil)) + (while (null entry) + ;; Look in superclass. + (let ((type (custom-type custom))) + (setq custom (cdr (or (assq type custom-local-type-properties) + (assq type custom-type-properties))) + entry (assq property custom)) + (custom-assert 'custom))) + (cdr entry))) + (defun custom-property-set (custom property value) "Set CUSTOM PROPERY to VALUE by side effect. CUSTOM must have at least one property already." *************** *** 606,636 **** "Extract `padding' from CUSTOM." (custom-property custom 'padding)) - (defun custom-allow-padding (custom) - "Extract `allow-padding' from CUSTOM." - (custom-property custom 'allow-padding)) - (defun custom-valid (custom value) "Non-nil if CUSTOM may legally be set to VALUE." ! (funcall (custom-property custom 'valid) custom value)) (defun custom-import (custom value) "Import CUSTOM VALUE from external variable." ! (funcall (custom-property custom 'import) value)) (defun custom-quote (custom value) "Quote CUSTOM's VALUE if necessary." ! (funcall (custom-property custom 'quote) value)) (defun custom-write (custom value) "Convert CUSTOM VALUE to a string." ! (if (eq value custom-nil) ! "" ! (funcall (custom-property custom 'write) custom value))) (defun custom-read (custom string) "Convert CUSTOM field content STRING into external form." ! (funcall (custom-property custom 'read) custom string)) (defun custom-match (custom values) "Match CUSTOM with a list of VALUES. --- 622,660 ---- "Extract `padding' from CUSTOM." (custom-property custom 'padding)) (defun custom-valid (custom value) "Non-nil if CUSTOM may legally be set to VALUE." ! (and (not (and (listp value) (eq custom-invalid (car value)))) ! (funcall (custom-property custom 'valid) custom value))) (defun custom-import (custom value) "Import CUSTOM VALUE from external variable." ! (if (eq custom-nil value) ! (list custom-nil) ! (funcall (custom-property custom 'import) custom value))) ! ! (defun custom-eval (custom value) ! "Return non-nil if CUSTOM's VALUE needs to be evaluated." ! (funcall (custom-property custom 'eval) custom value)) (defun custom-quote (custom value) "Quote CUSTOM's VALUE if necessary." ! (funcall (custom-property custom 'quote) custom value)) (defun custom-write (custom value) "Convert CUSTOM VALUE to a string." ! (cond ((eq value custom-nil) ! "") ! ((and (listp value) (eq (car value) custom-invalid)) ! (cdr value)) ! (t ! (funcall (custom-property custom 'write) custom value)))) (defun custom-read (custom string) "Convert CUSTOM field content STRING into external form." ! (condition-case nil ! (funcall (custom-property custom 'read) custom string) ! (error (cons custom-invalid string)))) (defun custom-match (custom values) "Match CUSTOM with a list of VALUES. *************** *** 749,754 **** --- 773,800 ---- ;; ;; The following functions defines type specific actions. + (defun custom-repeat-eval (custom value) + "Non-nil if CUSTOM's VALUE needs to be evaluated." + (if (eq value custom-nil) + nil + (let ((child (custom-data custom)) + (found nil)) + (mapcar (lambda (v) (if (custom-eval child v) (setq found t))) + value)))) + + (defun custom-repeat-quote (custom value) + "A list of CUSTOM's VALUEs quoted." + (let ((child (custom-data custom))) + (apply 'append (mapcar (lambda (v) (custom-quote child v)) + value)))) + + + (defun custom-repeat-import (custom value) + "Modify CUSTOM's VALUE to match internal expectations." + (let ((child (custom-data custom))) + (apply 'append (mapcar (lambda (v) (custom-import child v)) + value)))) + (defun custom-repeat-accept (field value &optional original) "Enter content of editing FIELD." (let ((values (copy-sequence (custom-field-value field))) *************** *** 890,902 **** values (cdr values))) result)) (defun custom-pair-extract (custom field) "Extract cons of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (custom-assert '(eq (length values) (length data))) - (custom-assert '(eq (length values) 2)) (while values (setq result (append result (custom-field-extract (car data) (car values))) --- 936,970 ---- values (cdr values))) result)) + (defun custom-pair-accept (field value &optional original) + "Enter content of editing FIELD with VALUE." + (custom-group-accept field (list (car value) (cdr value)) original)) + + (defun custom-pair-eval (custom value) + "Non-nil if CUSTOM's VALUE needs to be evaluated." + (custom-group-eval custom (list (car value) (cdr value)))) + + (defun custom-pair-import (custom value) + "Modify CUSTOM's VALUE to match internal expectations." + (let ((result (car (custom-group-import custom + (list (car value) (cdr value)))))) + (custom-assert '(eq (length result) 2)) + (list (cons (nth 0 result) (nth 1 result))))) + + (defun custom-pair-quote (custom value) + "Quote CUSTOM's VALUE if necessary." + (if (custom-eval custom value) + (let ((v (car (custom-group-quote custom + (list (car value) (cdr value)))))) + (list (list 'cons (nth 0 v) (nth 1 v)))) + (custom-default-quote custom value))) + (defun custom-pair-extract (custom field) "Extract cons of childrens values." (let ((values (custom-field-value field)) (data (custom-data custom)) result) (custom-assert '(eq (length values) (length data))) (while values (setq result (append result (custom-field-extract (car data) (car values))) *************** *** 905,914 **** (custom-assert '(null data)) (list (cons (nth 0 result) (nth 1 result))))) ! (defun custom-list-quote (value) ! "Quote VALUE if necessary." ! (and value ! (list 'quote value))) (defun custom-list-extract (custom field) "Extract list of childrens values." --- 973,984 ---- (custom-assert '(null data)) (list (cons (nth 0 result) (nth 1 result))))) ! (defun custom-list-quote (custom value) ! "Quote CUSTOM's VALUE if necessary." ! (if (custom-eval custom value) ! (let ((v (car (custom-group-quote custom value)))) ! (list (cons 'list v))) ! (custom-default-quote custom value))) (defun custom-list-extract (custom field) "Extract list of childrens values." *************** *** 938,943 **** --- 1008,1047 ---- values (cdr values))) result)) + (defun custom-group-eval (custom value) + "Non-nil if CUSTOM's VALUE needs to be evaluated." + (let ((found nil)) + (mapcar (lambda (c) + (or (stringp c) + (let ((match (custom-match c value))) + (if (custom-eval c (car match)) + (setq found t)) + (setq value (cdr match))))) + (custom-data custom)) + found)) + + (defun custom-group-quote (custom value) + "A list of CUSTOM's VALUE members, quoted." + (list (apply 'append + (mapcar (lambda (c) + (if (stringp c) + () + (let ((match (custom-match c value))) + (prog1 (custom-quote c (car match)) + (setq value (cdr match)))))) + (custom-data custom))))) + + (defun custom-group-import (custom value) + "Modify CUSTOM's VALUE to match internal expectations." + (list (apply 'append + (mapcar (lambda (c) + (if (stringp c) + () + (let ((match (custom-match c value))) + (prog1 (custom-import c (car match)) + (setq value (cdr match)))))) + (custom-data custom))))) + (defun custom-group-initialize (custom) "Initialize `doc' and `default' entries in CUSTOM." (if (custom-name custom) *************** *** 1147,1178 **** default nil value) (read-file-name prompt directory default))))) ! (defun custom-face-quote (value) ! "Quote VALUE if necessary." ! (if (symbolp value) ! (custom-symbol-quote value) ! value)) ! ! (defun custom-face-export (value) ! "Modify VALUE to match external expectations." ! (if (symbolp value) ! value ! (eval value))) ! (defun custom-face-import (value) ! "Modify VALUE to match internal expectations." (let ((name (symbol-name value))) ! (if (string-match "\ custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" ! name) ! (list 'custom-face-lookup ! (match-string 1 name) ! (match-string 2 name) ! (match-string 3 name) ! (intern (match-string 4 name)) ! (intern (match-string 5 name)) ! (intern (match-string 6 name))) ! value))) (defun custom-face-lookup (fg bg stipple bold italic underline) "Lookup or create a face with specified attributes. --- 1251,1274 ---- default nil value) (read-file-name prompt directory default))))) ! (defun custom-face-eval (custom value) ! "Return non-nil if CUSTOM's VALUE needs to be evaluated." ! (not (symbolp value))) ! (defun custom-face-import (custom value) ! "Modify CUSTOM's VALUE to match internal expectations." (let ((name (symbol-name value))) ! (list (if (string-match "\ custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" ! name) ! (list 'custom-face-lookup ! (match-string 1 name) ! (match-string 2 name) ! (match-string 3 name) ! (intern (match-string 4 name)) ! (intern (match-string 5 name)) ! (intern (match-string 6 name))) ! value)))) (defun custom-face-lookup (fg bg stipple bold italic underline) "Lookup or create a face with specified attributes. *************** *** 1194,1200 **** (defun custom-face-hack (field value) "Face that should be used for highlighting FIELD containing VALUE." ! (funcall (custom-property (custom-field-custom field) 'export) value)) (defun custom-const-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." --- 1290,1296 ---- (defun custom-face-hack (field value) "Face that should be used for highlighting FIELD containing VALUE." ! (eval (funcall (custom-property (custom-field-custom field) 'export) custom value))) (defun custom-const-insert (custom level) "Insert field for CUSTOM at nesting LEVEL in customization buffer." *************** *** 1224,1244 **** "Face used for a FIELD." (custom-default (custom-field-custom field))) - (defun custom-sexp-valid (custom value) - "Non-nil if CUSTOM can legally have the value VALUE." - (not (and (listp value) (eq custom-nil (car value))))) - - (defun custom-sexp-quote (value) - "Quote VALUE if necessary." - (if (or (and (symbolp value) - value - (not (eq t value))) - (and (listp value) - value - (not (memq (car value) '(quote function lambda))))) - (list 'quote value) - value)) - (defun custom-sexp-read (custom string) "Read from CUSTOM an STRING." (save-match-data --- 1320,1325 ---- *************** *** 1247,1290 **** (erase-buffer) (insert string) (goto-char (point-min)) ! (condition-case signal ! (prog1 (read (current-buffer)) ! (or (looking-at ! (concat (regexp-quote (char-to-string ! (custom-padding custom))) ! "*\\'")) ! (error "Junk at end of expression"))) ! (error (cons custom-nil string)))))) (defun custom-sexp-write (custom sexp) "Write CUSTOM SEXP as string." ! (if (and (listp sexp) (eq (car sexp) custom-nil)) ! (cdr sexp) ! (prin1-to-string sexp))) ! ! (defun custom-symbol-quote (value) ! "Quote VALUE if necessary." ! (if (or (null value) (eq t value)) ! value ! (list 'quote value))) ! ! (defun custom-symbol-read (custom symbol) ! "Read from CUSTOM an SYMBOL." ! (intern (save-match-data ! (custom-strip-padding symbol (custom-padding custom))))) ! ! (defun custom-symbol-write (custom symbol) ! "Write CUSTOM SYMBOL as string." ! (symbol-name symbol)) ! ! (defun custom-integer-read (custom integer) ! "Read from CUSTOM an INTEGER." ! (string-to-int (save-match-data ! (custom-strip-padding integer (custom-padding custom))))) ! ! (defun custom-integer-write (custom integer) ! "Write CUSTOM INTEGER as string." ! (int-to-string integer)) (defun custom-string-read (custom string) "Read string by ignoring trailing padding characters." --- 1328,1350 ---- (erase-buffer) (insert string) (goto-char (point-min)) ! (prog1 (read (current-buffer)) ! (or (looking-at ! (concat (regexp-quote (char-to-string ! (custom-padding custom))) ! "*\\'")) ! (error "Junk at end of expression")))))) ! ! (autoload 'pp-to-string "pp") (defun custom-sexp-write (custom sexp) "Write CUSTOM SEXP as string." ! (let ((string (prin1-to-string sexp))) ! (if (<= (length string) (custom-width custom)) ! string ! (setq string (pp-to-string sexp)) ! (string-match "[ \t\n]*\\'" string) ! (concat "\n" (substring string 0 (match-beginning 0)))))) (defun custom-string-read (custom string) "Read string by ignoring trailing padding characters." *************** *** 1306,1311 **** --- 1366,1389 ---- (custom-documentation-insert custom) nil) + (defun custom-default-export (custom value) + ;; Convert CUSTOM's VALUE to external representation. + (if (custom-eval custom value) + (eval (car (custom-quote custom value))) + value)) + + (defun custom-default-quote (custom value) + "Quote CUSTOM's VALUE if necessary." + (list (if (and (not (custom-eval custom value)) + (or (and (symbolp value) + value + (not (eq t value))) + (and (listp value) + value + (not (memq (car value) '(quote function lambda)))))) + (list 'quote value) + value))) + (defun custom-default-initialize (custom) "Initialize `doc' and `default' entries in CUSTOM." (let ((name (custom-name custom))) *************** *** 1386,1396 **** (let ((value (custom-field-value field)) (start (custom-field-start field))) (cond ((eq value custom-nil) ! (cons (custom-field-start field) "Uninitialized field")) ((custom-valid custom value) nil) (t ! (cons start "Wrong type"))))) (defun custom-default-face (field) "Face used for a FIELD." --- 1464,1476 ---- (let ((value (custom-field-value field)) (start (custom-field-start field))) (cond ((eq value custom-nil) ! (cons start "Uninitialized field")) ! ((and (consp value) (eq (car value) custom-invalid)) ! (cons start "Unparseable field content")) ((custom-valid custom value) nil) (t ! (cons start "Wrong type of field content"))))) (defun custom-default-face (field) "Face used for a FIELD." *************** *** 1677,1683 **** (save-excursion (if name (custom-field-original-set ! field (custom-import custom (custom-external name)))) (if (not (custom-valid custom (custom-field-original field))) (error "This field cannot be reset alone") (funcall (custom-property custom 'reset) field) --- 1757,1763 ---- (save-excursion (if name (custom-field-original-set ! field (car (custom-import custom (custom-external name))))) (if (not (custom-valid custom (custom-field-original field))) (error "This field cannot be reset alone") (funcall (custom-property custom 'reset) field) *************** *** 1712,1717 **** --- 1792,1798 ---- (interactive (if custom-modified-list nil (error "No changes to apply."))) + (custom-field-parse custom-field-last) (let ((all custom-name-fields) name field) (while all *************** *** 1733,1738 **** --- 1814,1820 ---- "Apply any changes in FIELD since the last apply." (interactive (list (or (get-text-property (point) 'custom-field) (get-text-property (point) 'custom-tag)))) + (custom-field-parse custom-field-last) (if (arrayp field) (let* ((custom (custom-field-custom field)) (error (custom-field-validate custom field))) *************** *** 1770,1776 **** (if (equal default value) (setcdr old (custom-plist-delq name (cdr old))) (setcdr old (plist-put (cdr old) name ! (custom-quote custom value)))))) (erase-buffer) (insert ";; " custom-file "\ --- Automatically generated customization information. --- 1852,1858 ---- (if (equal default value) (setcdr old (custom-plist-delq name (cdr old))) (setcdr old (plist-put (cdr old) name ! (car (custom-quote custom value))))))) (erase-buffer) (insert ";; " custom-file "\ --- Automatically generated customization information. *************** *** 1858,1868 **** (end (custom-field-end field)) (custom (custom-field-custom field)) (padding (custom-padding custom)) - (allow (custom-allow-padding custom)) (before-change-functions nil) (after-change-functions nil)) ! (or (and (eq this-command 'self-insert-command) ! allow) (let ((pos end)) (while (and (< start pos) (eq (char-after (1- pos)) padding)) --- 1940,1948 ---- (end (custom-field-end field)) (custom (custom-field-custom field)) (padding (custom-padding custom)) (before-change-functions nil) (after-change-functions nil)) ! (or (eq this-command 'self-insert-command) (let ((pos end)) (while (and (< start pos) (eq (char-after (1- pos)) padding)) *************** *** 1871,1894 **** (goto-char pos)))) (put-text-property start end 'face custom-field-active-face))) (defvar custom-field-last nil) ;; Last field containing point. (make-variable-buffer-local 'custom-field-last) (defun custom-post-command () ;; Keep track of their active field. (if (not (eq major-mode 'custom-mode)) ! ;; BUG: Should have been local! () (let ((field (custom-field-property (point)))) (if (eq field custom-field-last) ! () (if custom-field-last (custom-field-leave custom-field-last)) (if field (custom-field-enter field)) (setq custom-field-last field))) ! (set-buffer-modified-p custom-modified-list))) (defvar custom-field-was nil) ;; The custom data before the change. --- 1951,2012 ---- (goto-char pos)))) (put-text-property start end 'face custom-field-active-face))) + (defun custom-field-resize (field) + ;; Resize FIELD after change. + (let* ((custom (custom-field-custom field)) + (begin (custom-field-start field)) + (end (custom-field-end field)) + (pos (point)) + (padding (custom-padding custom)) + (width (custom-width custom)) + (size (- end begin))) + (cond ((< size width) + (goto-char end) + (insert-before-markers-and-inherit + (make-string (- width size) padding)) + (goto-char pos)) + ((> size width) + (let ((start (if (and (< (+ begin width) pos) (<= pos end)) + pos + (+ begin width)))) + (goto-char end) + (while (and (< start (point)) (= (preceding-char) padding)) + (backward-delete-char 1)) + (goto-char pos)))))) + + (defvar custom-field-changed nil) + ;; List of fields changed on the screen. + (make-variable-buffer-local 'custom-field-changed) + + (defun custom-field-parse (field) + ;; Parse FIELD content iff changed. + (if (memq field custom-field-changed) + (progn + (setq custom-field-changed (delq field custom-field-changed)) + (custom-field-value-set field (custom-field-read field)) + (custom-field-update field)))) + (defvar custom-field-last nil) ;; Last field containing point. (make-variable-buffer-local 'custom-field-last) + (defun custom-post-command () ;; Keep track of their active field. (if (not (eq major-mode 'custom-mode)) ! (message "Aargh! Why is custom-post-command called here?") () (let ((field (custom-field-property (point)))) (if (eq field custom-field-last) ! (if (memq field custom-field-changed) ! (custom-field-resize field)) ! (custom-field-parse custom-field-last) (if custom-field-last (custom-field-leave custom-field-last)) (if field (custom-field-enter field)) (setq custom-field-last field))) ! (set-buffer-modified-p (or custom-modified-list custom-field-changed)))) (defvar custom-field-was nil) ;; The custom data before the change. *************** *** 1920,1927 **** (let ((field-end (custom-field-end field))) (if (> end field-end) (set-marker field-end end)) ! (custom-field-value-set field (custom-field-read field)) ! (custom-field-update field)) ;; We deleted the entire field, reinsert it. (custom-assert '(eq begin end)) (save-excursion --- 2038,2044 ---- (let ((field-end (custom-field-end field))) (if (> end field-end) (set-marker field-end end)) ! (add-to-list 'custom-field-changed field)) ;; We deleted the entire field, reinsert it. (custom-assert '(eq begin end)) (save-excursion *** pub/dgnus/lisp/gnus-cus.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-cus.el Sat Aug 19 16:08:53 1995 *************** *** 1,9 **** ! ;;; gnus-cus.el --- User friendly customization of GNUS. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, news ! ;; Version: 0.0 ;;; Code: --- 1,27 ---- ! ;; gnus-cus.el --- User friendly customization of Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Keywords: help, news ! ;; Version: 0.1 ! ! ;; This file is part of GNU Emacs. ! ! ;; GNU Emacs is free software; you can redistribute it and/or modify ! ;; it under the terms of the GNU General Public License as published by ! ;; the Free Software Foundation; either version 2, or (at your option) ! ;; any later version. ! ! ;; GNU Emacs is distributed in the hope that it will be useful, ! ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! ;; GNU General Public License for more details. ! ! ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to ! ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! ! ;;; Commentary: ;;; Code: *************** *** 20,41 **** (type . group) (data ((tag . "Visual") (doc . "Enable visual features. ! If `visual' is disabled, there will be no menus and no faces. All the visual customization options below will be ignored. GNUS will use less space and be faster as a result.") (default . t) (name . gnus-visual) (type . toggle)) ((tag . "Summary Selected Face") (doc . "\ Face used for highlighting the current article in the summary buffer.") (name . gnus-summary-selected-face) (default . underline) (type . face)) ! ;;; gnus-summary-highlight ! ;;; need cons and sexp ))))) (provide 'gnus-cus) ;;; gnus-cus.el ends here --- 38,407 ---- (type . group) (data ((tag . "Visual") (doc . "Enable visual features. ! If `visual' is disabled, there will be no menus and few faces. Most of the visual customization options below will be ignored. GNUS will use less space and be faster as a result.") (default . t) (name . gnus-visual) (type . toggle)) + ((tag . "WWW Browser") + (doc . "\ + WWW Browser to call when clicking on an URL button in the article buffer. + + You can choose between one of the predefined browsers, or `Other'.") + (name . gnus-button-url) + (default . w3-fetch) + (type . choice) + (data ((tag . "W3") + (type . const) + (default . w3-fetch)) + ((tag . "Netscape") + (type . const) + (default . gnus-netscape-open-url)) + ((prompt . "Other") + (doc . "\ + You must specify the name of a Lisp function here. The lisp function + should open a WWW browser when called with an URL (a string). + ") + (default . __uninitialized__) + (type . symbol)))) + ((tag . "Mouse Face") + (doc . "\ + Face used for group or summary buffer mouse highlighting. + The line beneath the mouse pointer will be highlighted with this + face.") + (name . gnus-mouse-face) + (default . highlight) + (type . face)) + ((tag . "Article Display") + (doc . "Controls how the article buffer will look. + + The list below contains various filters you can use to change the look + of the article. If you leave the list empty, the article will appear + exactly as it is stored on the disk. The list entries will hide or + highlight various parts of the article, making it easier to find the + information you want.") + (name . gnus-article-display-hook) + (type . list) + (default . (gnus-article-hide-headers-if-wanted + gnus-article-treat-overstrike + gnus-article-maybe-highlight)) + (data ((type . repeat) + (header . nil) + (data (tag . "Filter") + (type . choice) + (data ((tag . "Treat Overstrike") + (doc . "\ + Convert use of overstrike into bold and underline. + + Two identical letters separated by a backspace are displayed as a + single bold letter, while a letter followed by a backspace and an + underscore will be displayed as a single underlined letter. This + technique was developed for old line printers (think about it), and is + still in use on some newsgroups, in particular the ClariNet + hierearchy. + ") + (type . const) + (default . + gnus-article-treat-overstrike)) + ((tag . "Word Wrap") + (doc . "\ + Format too long lines. + ") + (type . const) + (default . gnus-article-word-wrap)) + ((tag . "Remove CR") + (doc . "\ + Remove carriage returns from an article. + ") + (type . const) + (default . gnus-article-remove-cr)) + ((tag . "Display X-Face") + (doc . "\ + Look for an X-Face header and display it if present. + + See also `X Face Command' for a definition of the external command + used for decoding and displaying the face. + ") + (type . const) + (default . gnus-article-display-x-face)) + ((tag . "Unquote Printable") + (doc . "\ + Tranform MIME quoted printable into 8-bit characters. + + Quoted printable is often seen by strings like `=EF' where you would + expect a non-English letter. + ") + (type . const) + (default . + gnus-article-de-quoted-unreadable)) + ((tag . "Universal Time") + (doc . "\ + Convert date header to universal time. + ") + (type . const) + (default . gnus-article-date-ut)) + ((tag . "Local Time") + (doc . "\ + Convert date header to local timezone. + ") + (type . const) + (default . gnus-article-date-local)) + ((tag . "Lapsed Time") + (doc . "\ + Replace date header with a header showing the articles age. + ") + (type . const) + (default . gnus-article-date-lapsed)) + ((tag . "Highlight") + (doc . "\ + Highlight headers, citations, signature, and buttons. + ") + (type . const) + (default . gnus-article-highlight)) + ((tag . "Maybe Highlight") + (doc . "\ + Highlight headers, signature, and buttons if `Visual' is turned on. + ") + (type . const) + (default . + gnus-article-maybe-highlight)) + ((tag . "Highlight Some") + (doc . "\ + Highlight headers, signature, and buttons. + ") + (type . const) + (default . gnus-article-highlight-some)) + ((tag . "Highlight Headers") + (doc . "\ + Highlight headers as specified by `Article Header Highligting'. + ") + (type . const) + (default . + gnus-article-highlight-headers)) + ((tag . "Highlight Signature") + (doc . "\ + Highlight the signature as specified by `Article Signature Face'. + ") + (type . const) + (default . + gnus-article-highlight-signature)) + ((tag . "Citation") + (doc . "\ + Highlight the citations as specified by `Citation Faces'. + ") + (type . const) + (default . + gnus-article-highlight-citation)) + ((tag . "Hide") + (doc . "\ + Hide unwanted headers, excess citation, and the signature. + ") + (type . const) + (default . gnus-article-hide)) + ((tag . "Hide Headers If Wanted") + (doc . "\ + Hide headers, but allow user to display them with `t' or `v'. + ") + (type . const) + (default . + gnus-article-hide-headers-if-wanted)) + ((tag . "Hide Headers") + (doc . "\ + Hide unwanted headers and possibly sort them as well. + Most likely you want to use `Hide Headers If Wanted' instead. + ") + (type . const) + (default . gnus-article-hide-headers)) + ((tag . "Hide Signature") + (doc . "\ + Hide the signature. + ") + (type . const) + (default . gnus-article-hide-signature)) + ((tag . "Hide Excess Citations") + (doc . "\ + Hide excess citation. + + Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. + ") + (type . const) + (default . + gnus-article-hide-citation-maybe)) + ((tag . "Hide Citations") + (doc . "\ + Hide all cited text. + ") + (type . const) + (default . gnus-article-hide-citation)) + ((tag . "Add Buttons") + (doc . "\ + Make URL's into clickable buttons. + ") + (type . const) + (default . gnus-article-add-buttons)) + ((prompt . "Other") + (doc . "\ + Name of Lisp function to call. + + Push the `Filter' button to select one of the predefined filters. + ") + (type . symbol))))))) + ((tag . "Article Button Face") + (doc . "\ + Face used for highlighting buttons in the article buffer. + + An article button is a piece of text that you can activate by pressing + `RET' or `mouse-2' above it.") + (name . gnus-article-button-face) + (default . bold) + (type . face)) + ((tag . "Article Mouse Face") + (doc . "\ + Face used for mouse highlighting in the article buffer. + + Article buttons will be displayed in this face when the cursor is + above them.") + (name . gnus-article-mouse-face) + (default . highlight) + (type . face)) + ((tag . "Article Signature Face") + (doc . "\ + Face used for highlighting a signature in the article buffer.") + (name . gnus-signature-face) + (default . italic) + (type . face)) + ((tag . "Article Header Highlighting") + (doc . "\ + Controls highlighting of article header. + + Below is a list of article header names, and the faces used for + displaying the name and content of the header. The `Header' field + should contain the name of the header. The field actually contains a + regular expression that should match the beginning of the header line, + but if you don't know what a regular expression is, just write the + name of the header. The second field is the `Name' field, which + determines how the the header name (i.e. the part of the header left + of the `:') is displayed. The third field is the `Content' field, + which determines how the content (i.e. the part of the header right of + the `:') is displayed. + + If you leave the last `Header' field in the list empty, the `Name' and + `Content' fields will determine how headers not listed above are + displayed. + + If you only want to change the display of the name part for a specific + header, specify `None' in the `Content' field. Similarly, specify + `None' in the `Name' field if you only want to leave the name part + alone.") + (name . gnus-header-face-alist) + (type . list) + (default . (("" bold italic))) + (data ((type . repeat) + (header . nil) + (data (type . list) + (compact . t) + (data ((type . string) + (prompt . "Header") + (tag . "Header ")) + "\n " + ((type . face) + (prompt . "Name") + (tag . "Name ")) + "\n " + ((type . face) + (tag . "Content")) + "\n"))))) + ((tag . "Attribution Face") + (doc . "\ + Face used for attribution lines. + It is merged with the face for the cited text belonging to the attribution.") + (name . gnus-cite-attribution-face) + (default . underline) + (type . face)) + ((tag . "Citation Faces") + (doc . "\ + 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. + This should make it easier to see who wrote what.") + (name . gnus-cite-face-list) + (type . list) + (default . (italic)) + (data ((type . repeat) + (header . nil) + (data (type . face) + (tag . "Face"))))) + ((tag . "Citation Hide Percentage") + (doc . "\ + Only hide excess citation if above this percentage of the body.") + (name . gnus-cite-hide-percentage) + (default . 50) + (type . integer)) + ((tag . "Citation Hide Absolute") + (doc . "\ + Only hide excess citation if above this number of lines in the body.") + (name . gnus-cite-hide-absolute) + (default . 10) + (type . integer)) ((tag . "Summary Selected Face") (doc . "\ Face used for highlighting the current article in the summary buffer.") (name . gnus-summary-selected-face) (default . underline) (type . face)) ! ((tag . "Summary Line Highlighting") ! (doc . "\ ! Controls the higlighting of summary buffer lines. ! ! Below is a list of `Form'/`Face' pairs. When deciding how a a ! particular summary 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 summary 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 ! change in a future release. For now, you can use the following ! variables in the Lisp expression: ! ! score: The article's score ! default: The default article score. ! below: The score below which articles are automatically marked as read. ! mark: The article's mark.") ! (name . gnus-summary-highlight) ! (type . list) ! (default . (((> score default) . bold) ! ((< score default) . italic))) ! (data ((type . repeat) ! (header . nil) ! (data (type . pair) ! (compact . t) ! (data ((type . sexp) ! (width . 60) ! (tag . "Form")) ! "\n " ! ((type . face) ! (tag . "Face")) ! "\n"))))) ! ;; Do not define `gnus-button-alist' before we have ! ;; some `complexity' attribute so we can hide it from ! ;; beginners. ))))) + (defun gnus-custom-import-swap-alist (custom alist) + ;; Swap key and value in CUSTOM ALIST. + (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) + (funcall (custom-super custom 'import) custom swap))) + + (defun gnus-custom-export-swap-alist (custom alist) + ;; Swap key and value in CUSTOM ALIST. + (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) + (funcall (custom-super custom 'export) custom swap))) + (provide 'gnus-cus) ;;; gnus-cus.el ends here + + *** pub/dgnus/lisp/gnus-edit.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-edit.el Thu Aug 17 19:04:29 1995 *************** *** 1,4 **** ! ;;; gnus-edit.el --- Gnus SCORE file editing. ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen --- 1,4 ---- ! ;;; gnus-edit.el --- Gnus SCORE file editing ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen *** pub/dgnus/lisp/gnus-ems.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-ems.el Wed Aug 16 08:18:49 1995 *************** *** 196,202 **** ((and (not (string-match "28.9" emacs-version)) (not (string-match "29" emacs-version))) ! (setq gnus-hidden-properties '(invisible t)) (or (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) --- 196,206 ---- ((and (not (string-match "28.9" emacs-version)) (not (string-match "29" emacs-version))) ! ;; Remove the `intangible' prop. ! (let ((props gnus-hidden-properties)) ! (while (and props (not (eq (car (cdr props)) 'intangible))) ! (setq props (cdr props))) ! (and props (setcdr props (cdr (cdr (cdr props)))))) (or (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) *** pub/dgnus/lisp/gnus-score.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-score.el Sat Aug 19 20:08:09 1995 *************** *** 70,76 **** touched: If this alist has been modified. mark: Automatically mark articles below this. expunge: Automatically expunge articles below this. ! files: List of other SCORE files to load when loading this one. eval: Sexp to be evaluated when the score file is loaded. String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) --- 70,76 ---- touched: If this alist has been modified. mark: Automatically mark articles below this. expunge: Automatically expunge articles below this. ! files: List of other score files to load when loading this one. eval: Sexp to be evaluated when the score file is loaded. String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) *************** *** 342,348 **** (if (y-or-n-p "Use regexp match? ") 'r 's) (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) ! (cond ((not (y-or-n-p "Add to SCORE file? ")) 'now) ((y-or-n-p "Expire kill? ") (current-time-string)) --- 342,348 ---- (if (y-or-n-p "Use regexp match? ") 'r 's) (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) ! (cond ((not (y-or-n-p "Add to score file? ")) 'now) ((y-or-n-p "Expire kill? ") (current-time-string)) *************** *** 519,525 **** (defun gnus-score-change-score-file (file) "Change current score alist." ! (interactive (list (completing-read "Score file: " gnus-score-cache))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) --- 519,526 ---- (defun gnus-score-change-score-file (file) "Change current score alist." ! (interactive ! (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) *************** *** 730,736 **** (cons (list 'touched t) (nreverse out)))) (defun gnus-score-save () ! ;; Save all SCORE information. (let ((cache gnus-score-cache)) (save-excursion (setq gnus-score-alist nil) --- 731,737 ---- (cons (list 'touched t) (nreverse out)))) (defun gnus-score-save () ! ;; Save all score information. (let ((cache gnus-score-cache)) (save-excursion (setq gnus-score-alist nil) *************** *** 758,769 **** ;; 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. ! (write-region (point-min) (point-max) file nil 'silent))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) --- 759,771 ---- ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) ! (if (not (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. ! (write-region (point-min) (point-max) file nil 'silent)))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) *************** *** 771,777 **** (let (scores) ;; PLM: probably this is not the best place to clear orphan-score (setq gnus-orphan-score nil) ! ;; Load the SCORE files. (while score-files (if (stringp (car score-files)) ;; It is a string, which means that it's a score file name, --- 773,779 ---- (let (scores) ;; PLM: probably this is not the best place to clear orphan-score (setq gnus-orphan-score nil) ! ;; Load the score files. (while score-files (if (stringp (car score-files)) ;; It is a string, which means that it's a score file name, *** pub/dgnus/lisp/gnus-vis.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-vis.el Sat Aug 19 15:37:36 1995 *************** *** 32,40 **** ;;; Summary highlights. - (defvar gnus-summary-selected-face 'underline - "*Face used for highlighting the current article in the summary buffer.") - (defvar gnus-summary-highlight-properties '((unread "ForestGreen" "green") (ticked "Firebrick" "pink") --- 32,37 ---- *************** *** 58,64 **** map) (while props))) ! (defvar gnus-summary-highlight (cond ((not (eq gnus-display-type 'color)) '(((> score default) . bold) --- 55,63 ---- map) (while props))) ! (defvar gnus-summary-selected-face 'underline ! "*Face used for highlighting the current article in the summary buffer.") ! (defvar gnus-summary-highlight (cond ((not (eq gnus-display-type 'color)) '(((> score default) . bold) *************** *** 217,224 **** (defvar gnus-button-url (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) ! ((eq window-system 'x) 'gnus-netscape-open-url) ! ((fboundp 'w3-fetch) 'w3-fetch)) "*Function to fetch URL. The function will be called with one argument, the URL to fetch. Useful values of this function are: --- 216,223 ---- (defvar gnus-button-url (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) ! ((fboundp 'w3-fetch) 'w3-fetch) ! ((eq window-system 'x) 'gnus-netscape-open-url)) "*Function to fetch URL. The function will be called with one argument, the URL to fetch. Useful values of this function are: *************** *** 311,330 **** )) (easy-menu-define - gnus-group-post-menu - gnus-group-mode-map - "" - '("Post" - ["Send a mail" gnus-group-mail t] - ["Post an article" gnus-group-post-news t] - )) - - (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" '("Misc" ["Send a bug report" gnus-bug t] ["Customize score file" gnus-score-customize t] ["Check for new news" gnus-group-get-new-news t] ["Delete bogus groups" gnus-group-check-bogus-groups t] --- 310,322 ---- )) (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" '("Misc" ["Send a bug report" gnus-bug t] + ["Send a mail" gnus-group-mail t] + ["Post an article" gnus-group-post-news t] ["Customize score file" gnus-score-customize t] ["Check for new news" gnus-group-get-new-news t] ["Delete bogus groups" gnus-group-check-bogus-groups t] *************** *** 579,587 **** --- 571,753 ---- ["Edit current score file" gnus-score-edit-alist t] ["Edit score file" gnus-score-edit-file t] ["Trace score" gnus-score-find-trace t] + ["Increase score" gnus-summary-increase-score t] + ["Lower score" gnus-summary-lower-score t] + ("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) + :style radio + ;; :active (not (memq gnus-score-default-header '(l d))) + :selected (eq gnus-score-default-type 'r)] + ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) + :style radio + ;; :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 + :style toggle + :selected gnus-score-default-fold] + ("Default duration" + ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) + :style radio + :selected (null gnus-score-default-duration)] + ["Permanent" + (gnus-score-set-default 'gnus-score-default-duration 'p) + :style radio + :selected (eq gnus-score-default-duration 'p)] + ["Temporary" + (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)]) )))) ))) + (defun gnus-score-set-default (var value) + ;; A version of set that updates the GNU Emacs menu-bar. + (set var value) + ;; It is the message that forces the active status to be updated. + (message "")) + + (defvar gnus-score-default-header nil + "Default header when entering new scores. + + Should be one of the following symbols. + + a: from + s: subject + b: body + h: head + i: message-id + t: references + x: xref + l: lines + d: date + f: followup + + If nil, the user will be asked for a header.") + + (defvar gnus-score-default-type nil + "Default match type when entering new scores. + + Should be one of the following symbols. + + s: substring + e: exact string + f: fuzzy string + r: regexp string + b: before date + a: at date + n: this date + <: less than number + >: greater than number + =: equal to number + + If nil, the user will be asked for a match type.") + + (defvar gnus-score-default-fold nil + "Use case folding for new score file entries iff not nil.") + + + (defun gnus-score-default-fold-toggle () + "Toggle folding for new score file entries." + (interactive) + (setq gnus-score-default-fold (not gnus-score-default-fold)) + (if gnus-score-default-fold + (message "New score file entries will be case insensitive.") + (message "New score file entries will be case sensitive."))) + + (defvar gnus-score-default-duration nil + "Default duration of effect when entering new scores. + + Should be one of the following symbols. + + t: temporary + p: permanent + i: immediate + + If nil, the user will be asked for a duration.") + (defun gnus-visual-score-map (type) (if t nil *************** *** 1215,1222 **** list (cdr list)))) result))) (gnus-ems-redefine) - (provide 'gnus-vis) ;;; gnus-vis.el ends here --- 1381,1388 ---- list (cdr list)))) result))) + (require 'gnus-cus) (gnus-ems-redefine) (provide 'gnus-vis) ;;; gnus-vis.el ends here *** pub/dgnus/lisp/gnus-vm.el Mon Aug 14 00:06:33 1995 --- dgnus/lisp/gnus-vm.el Sat Aug 19 20:56:07 1995 *************** *** 222,228 **** (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn ! (gnus-check-news-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) (and (stringp article) --- 222,228 ---- (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn ! (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) (and (stringp article) *** pub/dgnus/lisp/gnus.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/gnus.el Sat Aug 19 20:56:36 1995 *************** *** 1,4 **** ! ;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ! ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 231,246 **** "*Suffix of the adaptive score files.") (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews ! "*Function used to find SCORE files. The function will be called with the group name as the argument, and should return a list of score files to apply to that group. The score files do not actually have to exist. Predefined values are: ! gnus-score-find-single: Only apply the group's own SCORE file. ! gnus-score-find-hierarchical: Also apply SCORE files from parent groups. ! gnus-score-find-bnews: Apply SCORE files whose names matches. See the documentation to these functions for more information. --- 231,246 ---- "*Suffix of the adaptive score files.") (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews ! "*Function used to find score files. The function will be called with the group name as the argument, and should return a list of score files to apply to that group. The score files do not actually have to exist. Predefined values are: ! gnus-score-find-single: Only apply the group's own score file. ! gnus-score-find-hierarchical: Also apply score files from parent groups. ! gnus-score-find-bnews: Apply score files whose names matches. See the documentation to these functions for more information. *************** *** 594,604 **** (defvar gnus-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" "*All headers that match this regexp will be hidden. ! Also see `gnus-visible-headers'.") (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:" "*All headers that do not match this regexp will be hidden. ! Also see `gnus-ignored-headers'.") (defvar gnus-sorted-header-list '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" --- 594,604 ---- (defvar gnus-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" "*All headers that match this regexp will be hidden. ! If `gnus-visible-headers' is non-nil, this variable will be ignored.") (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:" "*All headers that do not match this regexp will be hidden. ! If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" *************** *** 1310,1316 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "(ding) Gnus v0.99.11" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1310,1316 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "(ding) Gnus v0.99.12" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 2226,2246 **** newsgroup)) (defun gnus-newsgroup-saveable-name (group) (gnus-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! (let* ((dir (expand-file-name dir default-directory)) ! dirs) (if (string-match "/$" dir) (setq dir (substring dir 0 (match-beginning 0)))) (while (not (file-exists-p dir)) (setq dirs (cons dir dirs)) (string-match "/[^/]+$" dir) (setq dir (substring dir 0 (match-beginning 0)))) ! (while dirs ! (make-directory (car dirs)) ! (setq dirs (cdr dirs))))) (defun gnus-capitalize-newsgroup (newsgroup) "Capitalize NEWSGROUP name." --- 2226,2256 ---- newsgroup)) (defun gnus-newsgroup-saveable-name (group) + ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) + ;; with dots. (gnus-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! ;; Why don't we use `(make-directory dir 'parents)'? That's just one ! ;; of the many mysteries of the universe. ! (let* ((dir (expand-file-name dir default-directory)) ! dirs err) (if (string-match "/$" dir) (setq dir (substring dir 0 (match-beginning 0)))) + ;; First go down the path until we find a directory that exists. (while (not (file-exists-p dir)) (setq dirs (cons dir dirs)) (string-match "/[^/]+$" dir) (setq dir (substring dir 0 (match-beginning 0)))) ! ;; Then create all the subdirs. ! (while (and dirs (not err)) ! (condition-case () ! (make-directory (car dirs)) ! (error (setq err t))) ! (setq dirs (cdr dirs))) ! ;; We return whether we were successful or not. ! (not dirs))) (defun gnus-capitalize-newsgroup (newsgroup) "Capitalize NEWSGROUP name." *************** *** 3839,3846 **** (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) ! (or (gnus-server-opened method) ! (gnus-open-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (if activate (or (gnus-request-group group) (error "Couldn't request group"))) --- 3849,3855 ---- (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) ! (or (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (if activate (or (gnus-request-group group) (error "Couldn't request group"))) *************** *** 3868,3874 **** ;; ... or insert the line. (or (gnus-gethash group gnus-active-hashtb) ! (gnus-activate-newsgroup group) (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) --- 3877,3883 ---- ;; ... or insert the line. (or (gnus-gethash group gnus-active-hashtb) ! (gnus-activate-group group) (error "%s error: %s" group (gnus-status-message group))) (gnus-group-update-group group) *************** *** 4334,4340 **** group (and (not all) (append (cdr (assq 'tick marked)) (cdr (assq 'dormant marked)))) nil (and (not all) (cdr (assq 'tick marked)))) ! (and all marked (setcar (nthcdr 3 (nth 2 entry)) (delq (assq 'dormant marked) (nth 3 (nth 2 entry))))))) --- 4343,4350 ---- group (and (not all) (append (cdr (assq 'tick marked)) (cdr (assq 'dormant marked)))) nil (and (not all) (cdr (assq 'tick marked)))) ! (and all ! (setq marked (nth 3 (nth 2 entry))) (setcar (nthcdr 3 (nth 2 entry)) (delq (assq 'dormant marked) (nth 3 (nth 2 entry))))))) *************** *** 4595,4611 **** (ding) (message "%s error: %s" group (gnus-status-message group)) (sit-for 2)))) - ;; !!! I don't know why the buffer scrolls forward when updating - ;; the first line in the group buffer, but it does. So we set the - ;; window start forcibly. - ; (set-window-start (get-buffer-window (current-buffer)) w-p) (gnus-group-next-unread-group 1 t) (gnus-summary-position-cursor) ret)) (defun gnus-get-new-news-in-group (group) (and group ! (gnus-activate-newsgroup group) (progn (gnus-get-unread-articles-in-group (nth 2 (gnus-gethash group gnus-newsrc-hashtb)) --- 4605,4617 ---- (ding) (message "%s error: %s" group (gnus-status-message group)) (sit-for 2)))) (gnus-group-next-unread-group 1 t) (gnus-summary-position-cursor) ret)) (defun gnus-get-new-news-in-group (group) (and group ! (gnus-activate-group group) (progn (gnus-get-unread-articles-in-group (nth 2 (gnus-gethash group gnus-newsrc-hashtb)) *************** *** 4862,4870 **** (gnus-clear-system)))) (defun gnus-offer-save-summaries () ! (let ((buffers (buffer-list))) (save-excursion ! (while buffers (and ;; We look for buffers with "Summary" in the name. (string-match "Summary" (or (buffer-name (car buffers)) "")) --- 4868,4877 ---- (gnus-clear-system)))) (defun gnus-offer-save-summaries () ! (let ((buffers (buffer-list)) ! answer) (save-excursion ! (while (and buffers (not (eq answer ?q))) (and ;; We look for buffers with "Summary" in the name. (string-match "Summary" (or (buffer-name (car buffers)) "")) *************** *** 4873,4880 **** ;; We check that this is, indeed, a summary buffer. (eq major-mode 'gnus-summary-mode)) ;; We ask the user whether she wants to save the info. ! (gnus-y-or-n-p ! (format "Update summary buffer %s? " (buffer-name))) ;; We do it by simply exiting. (gnus-summary-exit)) (setq buffers (cdr buffers)))))) --- 4880,4894 ---- ;; We check that this is, indeed, a summary buffer. (eq major-mode 'gnus-summary-mode)) ;; We ask the user whether she wants to save the info. ! (or (eq answer ?!) ! (progn ! (setq answer nil) ! (while (not (memq answer '(?y ?n ?! ?q))) ! (message (format "%sUpdate summary buffer %s? (y, n, !, q)" ! (if answer "Illegal char. " "") ! (buffer-name))) ! (setq answer (read-char))) ! (or (eq answer ?y) (eq answer ?!)))) ;; We do it by simply exiting. (gnus-summary-exit)) (setq buffers (cdr buffers)))))) *************** *** 4952,4959 **** (let ((gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) ! (or (gnus-server-opened method) ! (gnus-open-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (or (gnus-request-list method) (error "Couldn't request list: %s" (gnus-status-message method))) --- 4966,4972 ---- (let ((gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) ! (or (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (or (gnus-request-list method) (error "Couldn't request list: %s" (gnus-status-message method))) *************** *** 5365,5373 **** (define-prefix-command 'gnus-summary-wash-time-map) (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-map "u" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-map "l" 'gnus-article-date-local) ! (define-key gnus-summary-wash-map "e" 'gnus-article-date-lapsed) (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) --- 5378,5387 ---- (define-prefix-command 'gnus-summary-wash-time-map) (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local) ! (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed) (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) *************** *** 5838,5843 **** --- 5852,5859 ---- (gnus-update-format-specifications) ;; Generate the summary buffer. (gnus-summary-prepare) + ;; Create the header hashtb. + (gnus-make-headers-hashtable-by-number) (if (zerop (buffer-size)) (cond (gnus-newsgroup-dormant (gnus-summary-show-all-dormant)) *************** *** 6504,6520 **** (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) articles) ! (gnus-check-news-server (setq gnus-current-select-method (gnus-find-method-for-group group))) ! (or (gnus-server-opened gnus-current-select-method) ! (gnus-open-server gnus-current-select-method) (error "Couldn't open server")) (or (and (null entry) ! (gnus-activate-newsgroup group)) (and (eq (car entry) t) ! (gnus-activate-newsgroup (car info))) (gnus-request-group group t) (progn (kill-buffer (current-buffer)) --- 6520,6535 ---- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) articles) ! (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) ! (or (gnus-check-server gnus-current-select-method) (error "Couldn't open server")) (or (and (null entry) ! (gnus-activate-group group)) (and (eq (car entry) t) ! (gnus-activate-group (car info))) (gnus-request-group group t) (progn (kill-buffer (current-buffer)) *************** *** 6565,6571 **** ;; If we were to fetch old headers, but the backend didn't ;; support XOVER, then it is possible we fetched one article ;; that we shouldn't have. If that's the case, we remove it. ! (if (not gnus-fetch-old-headers) () (save-excursion (set-buffer nntp-server-buffer) --- 6580,6587 ---- ;; If we were to fetch old headers, but the backend didn't ;; support XOVER, then it is possible we fetched one article ;; that we shouldn't have. If that's the case, we remove it. ! (if (or (not gnus-fetch-old-headers) ! (eq 1 (car articles))) () (save-excursion (set-buffer nntp-server-buffer) *************** *** 6603,6611 **** (setq gnus-newsgroup-scored (copy-sequence (cdr (assq 'score marked)))) (setq gnus-newsgroup-processable nil))) - ;; Create the header hashtb. - (or gnus-newsgroup-headers-hashtb-by-number - (gnus-make-headers-hashtable-by-number)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (or (and (stringp gnus-auto-expirable-newsgroups) --- 6619,6624 ---- *************** *** 8232,8244 **** ;; score. (goto-char (point-min)) (while (and (or (not (= (gnus-summary-article-mark) gnus-unread-mark)) ! (not (eq (cdr (memq (gnus-summary-article-number) gnus-newsgroup-scored)) gnus-summary-default-score))) (zerop (forward-line 1)) (not (eobp)))) ! ;; We jump to the article we have finally found. ! (gnus-summary-goto-article (gnus-summary-article-number)))) (gnus-summary-position-cursor))) (defun gnus-summary-goto-article (article &optional all-headers) --- 8245,8260 ---- ;; score. (goto-char (point-min)) (while (and (or (not (= (gnus-summary-article-mark) gnus-unread-mark)) ! (not (eq (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored)) gnus-summary-default-score))) (zerop (forward-line 1)) (not (eobp)))) ! (if (= (gnus-summary-article-mark) gnus-unread-mark) ! ;; We jump to the article we have finally found. ! (gnus-summary-goto-article (gnus-summary-article-number)) ! ;; Or there were no default-scored articles. ! (gnus-summary-goto-article article)))) (gnus-summary-position-cursor))) (defun gnus-summary-goto-article (article &optional all-headers) *************** *** 8331,8338 **** (get-buffer-window gnus-article-buffer))) number tmp-buf) (and gnus-refer-article-method ! (or (gnus-server-opened gnus-refer-article-method) ! (gnus-open-server gnus-refer-article-method))) ;; Save the old article buffer. (save-excursion (set-buffer gnus-article-buffer) --- 8347,8353 ---- (get-buffer-window gnus-article-buffer))) number tmp-buf) (and gnus-refer-article-method ! (gnus-check-server gnus-refer-article-method)) ;; Save the old article buffer. (save-excursion (set-buffer gnus-article-buffer) *************** *** 8517,8535 **** (goto-char (point-max)) (and gnus-break-pages (gnus-narrow-to-page)))) ! (defun gnus-summary-show-article (&optional no-refetch) ! "Force re-fetching of the current article. ! If the prefix argument NO-REFETCH is non-nil, no actual refetch will ! be performed. The current article will simply be redisplayed." ! (interactive "P") (gnus-set-global-variables) ! (if (not no-refetch) ! (gnus-summary-select-article gnus-have-all-headers t) ! (or gnus-current-article ! (error "There is no current article")) ! (gnus-summary-goto-subject gnus-current-article) ! (gnus-configure-windows 'article) ! (gnus-summary-position-cursor))) (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. --- 8532,8547 ---- (goto-char (point-max)) (and gnus-break-pages (gnus-narrow-to-page)))) ! (defun gnus-summary-show-article () ! "Force re-fetching of the current article." ! (interactive) (gnus-set-global-variables) ! (or gnus-current-article ! (error "There is no current article")) ! (gnus-summary-goto-subject gnus-current-article) ! (gnus-summary-select-article nil 'force) ! (gnus-configure-windows 'article) ! (gnus-summary-position-cursor)) (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. *************** *** 8651,8665 **** (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-newsgroup to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) ! (or (gnus-server-opened to-method) ! (gnus-open-server to-method) (error "Can't open server %s" (car to-method))) (gnus-message 6 "Moving to %s: %s..." (or select-method to-newsgroup) articles) --- 8663,8676 ---- (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) ! (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) (gnus-message 6 "Moving to %s: %s..." (or select-method to-newsgroup) articles) *************** *** 8690,8714 **** (article (car articles))) (gnus-summary-goto-subject article) (beginning-of-line) ! (delete-region (point) ! (progn (forward-line 1) (point))) ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! ; (score . gnus-newsgroup-scored) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks)))) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-dormant --- 8701,8727 ---- (article (car articles))) (gnus-summary-goto-subject article) (beginning-of-line) ! (delete-region (point) (progn (forward-line 1) (point))) ! ;; Update the group that has been moved to. ! (if (not info) ! () ; This group does not exist yet. ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks))))) ! ;; Update marks. (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-dormant *************** *** 8787,8801 **** (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-newsgroup to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) ! (or (gnus-server-opened to-method) ! (gnus-open-server to-method) (error "Can't open server %s" (car to-method))) (while articles (gnus-message 6 "Copying to %s: %s..." --- 8800,8813 ---- (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup (or gnus-current-move-group ""))) (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-group to-newsgroup) (error "No such group: %s" to-newsgroup)) (setq gnus-current-move-group to-newsgroup))) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) ! (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) (while articles (gnus-message 6 "Copying to %s: %s..." *************** *** 8819,8841 **** gnus-newsrc-hashtb))) (info (nth 2 entry)) (article (car articles))) ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! ; (score . gnus-newsgroup-scored) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks))))) (gnus-message 1 "Couldn't copy article %s" (car articles))) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))) --- 8831,8855 ---- gnus-newsrc-hashtb))) (info (nth 2 entry)) (article (car articles))) ! ;; We copy the info over to the new group. ! (if (not info) ! () ; This group does not exist (yet). ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks)))))) (gnus-message 1 "Couldn't copy article %s" (car articles))) (gnus-summary-remove-process-mark (car articles)) (setq articles (cdr articles))) *************** *** 8980,8987 **** (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)) ! (gnus-configure-windows 'summary)))) (defun gnus-summary-edit-article-postpone () "Postpone changes to the current article." --- 8994,9001 ---- (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary)) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)))) (defun gnus-summary-edit-article-postpone () "Postpone changes to the current article." *************** *** 8990,8997 **** (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)) ! (gnus-configure-windows 'summary)) (defun gnus-summary-fancy-query () "Query where the fancy respool algorithm would put this article." --- 9004,9011 ---- (use-local-map gnus-article-mode-map) (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))) (defun gnus-summary-fancy-query () "Query where the fancy respool algorithm would put this article." *************** *** 9112,9119 **** ;; select the first unread article. (gnus-summary-next-article t (and gnus-auto-select-same (gnus-summary-subject-string))) ! (gnus-message 7 "%d articles are marked as %s" ! count (if unmark "unread" "read")))) (defun gnus-summary-kill-same-subject (&optional unmark) "Mark articles which has the same subject as read. --- 9126,9134 ---- ;; select the first unread article. (gnus-summary-next-article t (and gnus-auto-select-same (gnus-summary-subject-string))) ! (gnus-message 7 "%d article%s marked as %s" ! count (if (= count 1) " is" "s are") ! (if unmark "unread" "read")))) (defun gnus-summary-kill-same-subject (&optional unmark) "Mark articles which has the same subject as read. *************** *** 9160,9165 **** --- 9175,9181 ---- (gnus-summary-show-thread) t) (gnus-summary-search-forward nil subject)) (setq count (1+ count))))) + (gnus-set-mode-line 'summary) ;; Return the number of marked articles. count))) *************** *** 10378,10385 **** b) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) - (or gnus-newsgroup-headers-hashtb-by-number - (gnus-make-headers-hashtable-by-number)) (gnus-summary-position-cursor) ;; If all commands are to be bunched up on one line, we collect ;; them here. --- 10394,10399 ---- *************** *** 10541,10547 **** ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" ))) ! (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands)))) --- 10555,10561 ---- ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" ))) ! (while (and nil commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands)))) *************** *** 10549,10555 **** (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "n" "^" "\M-^"))) ! (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) --- 10563,10569 ---- (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "n" "^" "\M-^"))) ! (while (and nil commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) *************** *** 10627,10633 **** (setq group (or group gnus-newsgroup-name)) ;; Open server if it has closed. ! (gnus-check-news-server (gnus-find-method-for-group group)) ;; Using `gnus-request-article' directly will insert the article into ;; `nntp-server-buffer' - so we'll save some time by not having to --- 10641,10647 ---- (setq group (or group gnus-newsgroup-name)) ;; Open server if it has closed. ! (gnus-check-server (gnus-find-method-for-group group)) ;; Using `gnus-request-article' directly will insert the article into ;; `nntp-server-buffer' - so we'll save some time by not having to *************** *** 10682,10689 **** (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." - (or gnus-newsgroup-headers-hashtb-by-number - (gnus-make-headers-hashtable-by-number)) (let (header) (if (not (setq header (car (if (let ((gnus-nov-is-evil t)) --- 10696,10701 ---- *************** *** 10714,10724 **** ;; Make sure the connection to the server is alive. (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn ! (gnus-check-news-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) - (or gnus-newsgroup-headers-hashtb-by-number - (gnus-make-headers-hashtable-by-number)) (let* ((article (if header (header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) --- 10726,10734 ---- ;; Make sure the connection to the server is alive. (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) (progn ! (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) (let* ((article (if header (header-number header) article)) (summary-buffer (current-buffer)) (internal-hook gnus-article-internal-prepare-hook) *************** *** 11109,11114 **** --- 11119,11125 ---- (gnus-article-date-ut 'lapsed)) (defun gnus-article-maybe-highlight () + "Do some article highlighting if `gnus-visual' is non-nil." (if gnus-visual (gnus-article-highlight-some))) ;; Article savers. *************** *** 11697,11703 **** (ding) nil))))) ! (defun gnus-check-news-server (&optional method) "If the news server is down, start it up again." (let ((method (if method method gnus-select-method))) (and (stringp method) --- 11708,11714 ---- (ding) nil))))) ! (defun gnus-check-server (&optional method) "If the news server is down, start it up again." (let ((method (if method method gnus-select-method))) (and (stringp method) *************** *** 11708,11716 **** ;; Open server. (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method)) (run-hooks 'gnus-open-server-hook) ! (or (gnus-server-opened method) ! (gnus-open-server method)) ! (message "")))) (defun gnus-nntp-message (&optional message) "Check the status of the NNTP server. --- 11719,11727 ---- ;; Open server. (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method)) (run-hooks 'gnus-open-server-hook) ! (prog1 ! (gnus-open-server method) ! (message ""))))) (defun gnus-nntp-message (&optional message) "Check the status of the NNTP server. *************** *** 11824,11831 **** gnus-valid-select-methods))) gnus-post-method (gnus-find-method-for-group gnus-newsgroup-name)))) ! (or (gnus-server-opened method) ! (gnus-open-server method) (error "Can't open server %s:%s" (car method) (nth 1 method))) (let ((mail-self-blind nil) (mail-archive-file-name nil)) --- 11835,11841 ---- gnus-valid-select-methods))) gnus-post-method (gnus-find-method-for-group gnus-newsgroup-name)))) ! (or (gnus-check-server method) (error "Can't open server %s:%s" (car method) (nth 1 method))) (let ((mail-self-blind nil) (mail-archive-file-name nil)) *************** *** 12077,12084 **** ;; request new newsgroups. (while methods (setq method (gnus-server-get-method nil (car methods))) ! (and (or (gnus-server-opened method) ! (gnus-open-server method)) (gnus-request-newgroups date method) (save-excursion (setq got-new t) --- 12087,12093 ---- ;; request new newsgroups. (while methods (setq method (gnus-server-get-method nil (car methods))) ! (and (gnus-check-server method) (gnus-request-newgroups date method) (save-excursion (setq got-new t) *************** *** 12384,12397 **** ;; the others, so we just pop them on a list for ;; now. (setq virtuals (cons info virtuals)) ! (and (setq active (gnus-activate-newsgroup (car info))) ;; Close the groups as we look at them! (gnus-close-group group)))) ! ;; These groups are native or secondary. (if (and (not gnus-read-active-file) (<= (nth 1 info) level)) ! (setq active (gnus-activate-newsgroup (car info))))) (if active (gnus-get-unread-articles-in-group info active) --- 12393,12407 ---- ;; the others, so we just pop them on a list for ;; now. (setq virtuals (cons info virtuals)) ! (and (setq active (gnus-activate-group (car info))) ;; Close the groups as we look at them! (gnus-close-group group)))) ! ! (or gnus-read-active-file (gnus-check-server method)) ;; These groups are native or secondary. (if (and (not gnus-read-active-file) (<= (nth 1 info) level)) ! (setq active (gnus-activate-group (car info))))) (if active (gnus-get-unread-articles-in-group info active) *************** *** 12406,12413 **** ;; other groups. ;; !!! If one virtual group contains another virtual group, even ;; doing it this way might cause problems. ! (while virtuals ! (and (setq active (gnus-activate-newsgroup (car (car virtuals)))) (gnus-get-unread-articles-in-group (car virtuals) active)) (setq virtuals (cdr virtuals))) --- 12416,12423 ---- ;; other groups. ;; !!! If one virtual group contains another virtual group, even ;; doing it this way might cause problems. ! (while virtuals ! (and (setq active (gnus-activate-group (car (car virtuals)))) (gnus-get-unread-articles-in-group (car virtuals) active)) (setq virtuals (cdr virtuals))) *************** *** 12543,12556 **** (setq marked m)) (setq m (cdr m))))) ! (defun gnus-activate-newsgroup (group) (let ((method (gnus-find-method-for-group group)) active) ! (and (or (gnus-server-opened method) (gnus-open-server method)) ! (gnus-request-group group) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) --- 12553,12574 ---- (setq marked m)) (setq m (cdr m))))) ! (defun gnus-activate-group (group) ! ;; Check whether a group has been activated or not. (let ((method (gnus-find-method-for-group group)) active) ! (and (gnus-check-server method) ! ;; We escape all bugs and quits here to make it possible to ! ;; continue if a group is so out-there that it reports bugs ! ;; and stuff. ! (condition-case () ! (gnus-request-group group) ! (error nil) ! (quit nil)) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) + ;; Parse the result we got from `gnus-request-group'. (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") (progn (goto-char (match-beginning 1)) *************** *** 12558,12563 **** --- 12576,12582 ---- group (setq active (cons (read (current-buffer)) (read (current-buffer)))) gnus-active-hashtb)) + ;; Return the new active info. active))))) (defun gnus-update-read-articles *************** *** 12593,12601 **** (while (and dormant (< (car dormant) (car active))) (setq dormant (cdr dormant))) (setq unread (sort (append unselected unread) '<)) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (setcar entry (max 0 (- (length unread) (length ticked) - (length dormant)))) ;; Compute the ranges of read articles by looking at the list of ;; unread articles. (while unread --- 12612,12617 ---- *************** *** 12618,12623 **** --- 12634,12642 ---- (if domarks dormant (cdr (assq 'dormant marked))) (if domarks bookmark (cdr (assq 'bookmark marked))) (if domarks score (cdr (assq 'score marked)))) + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group + info (gnus-gethash group gnus-active-hashtb)) t))) (defun gnus-make-articles-unread (group articles) *************** *** 12640,12647 **** ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (or (gnus-server-opened gnus-select-method) ! (gnus-open-server gnus-select-method)) ;; The native server is available. (cons gnus-select-method gnus-secondary-select-methods) ;; The native server is down, so we just do the --- 12659,12665 ---- ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (gnus-check-server gnus-select-method) ;; The native server is available. (cons gnus-select-method gnus-secondary-select-methods) ;; The native server is down, so we just do the *************** *** 12659,12665 **** (concat " from " where) "") (car method)))) (gnus-message 5 mesg) ! (gnus-check-news-server method) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) --- 12677,12683 ---- (concat " from " where) "") (car method)))) (gnus-message 5 mesg) ! (gnus-check-server method) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) *************** *** 12674,12681 **** (setq groups (cons (gnus-group-real-name (car (car newsrc))) groups))) (setq newsrc (cdr newsrc))) ! (or (gnus-server-opened method) ! (gnus-open-server method)) (setq list-type (gnus-retrieve-groups groups method)) (cond ((not list-type) (gnus-message --- 12692,12698 ---- (setq groups (cons (gnus-group-real-name (car (car newsrc))) groups))) (setq newsrc (cdr newsrc))) ! (gnus-check-server method) (setq list-type (gnus-retrieve-groups groups method)) (cond ((not list-type) (gnus-message *************** *** 12697,12704 **** ;; We mark this active file as read. (setq gnus-have-read-active-file (cons method gnus-have-read-active-file)) ! (gnus-message 5 "%sdone" mesg)))) ! ) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. --- 12714,12720 ---- ;; We mark this active file as read. (setq gnus-have-read-active-file (cons method gnus-have-read-active-file)) ! (gnus-message 5 "%sdone" mesg))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. *************** *** 12723,12728 **** --- 12739,12750 ---- (progn (goto-char (point-min)) (delete-matching-lines gnus-ignored-newsgroups))) + ;; Make the group names readable as a lisp expression even if they + ;; contain special characters. + ;; Fix by Luc Van Eycken . + (goto-char (point-max)) + (while (re-search-backward "[][';?()#]" nil t) + (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ;; group prefix in front of the group names. (and method (not (gnus-server-equal *************** *** 12733,12740 **** (while (and (not (eobp)) (progn (insert prefix) (zerop (forward-line 1))))))) ! (goto-char (point-min)) ! ;; Store active file in hashtable. (goto-char (point-min)) (if (string-match "%[oO]" gnus-group-line-format) ;; Suggested by Brian Edmonds . --- 12755,12761 ---- (while (and (not (eobp)) (progn (insert prefix) (zerop (forward-line 1))))))) ! ;; Store the active file in a hash table. (goto-char (point-min)) (if (string-match "%[oO]" gnus-group-line-format) ;; Suggested by Brian Edmonds . *************** *** 12791,12797 **** (set group nil) (if ignore-errors () - (ding) (gnus-message 3 "Warning - illegal active: %s" (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))) --- 12812,12817 ---- *************** *** 13359,13366 **** (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond ! ((not (or (gnus-server-opened method) ! (gnus-open-server method))) (gnus-message 1 "Couldn't open server") nil) ((not (gnus-request-list-newsgroups method)) --- 13379,13385 ---- (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond ! ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") nil) ((not (gnus-request-list-newsgroups method)) *** pub/dgnus/lisp/nnbabyl.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nnbabyl.el Sat Aug 19 21:20:06 1995 *************** *** 486,499 **** (set-buffer-modified-p nil) (goto-char (point-min)) (while (re-search-forward delim nil t) ! (setq start (match-beginning 0)) ! (if (not (search-forward ! "\nX-Gnus-Newsgroup: " ! (save-excursion ! (setq end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (point-max)))) t)) (progn (goto-char end) (save-excursion --- 486,496 ---- (set-buffer-modified-p nil) (goto-char (point-min)) + (re-search-forward delim nil t) + (setq start (match-beginning 0)) (while (re-search-forward delim nil t) ! (setq end (match-end 0)) ! (or (search-backward "\nX-Gnus-Newsgroup: " start t) (progn (goto-char end) (save-excursion *************** *** 501,508 **** (goto-char start) (narrow-to-region start end) (nnbabyl-save-mail) ! (setq end (point-max)))) ! (goto-char end)))) (and (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) --- 498,505 ---- (goto-char start) (narrow-to-region start end) (nnbabyl-save-mail) ! (setq end (point-max)))))) ! (goto-char (setq start end))) (and (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) *** pub/dgnus/lisp/nndoc.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nndoc.el Sat Aug 19 18:02:10 1995 *************** *** 106,111 **** --- 106,112 ---- (if (stringp (car sequence)) 'headers (set-buffer nndoc-current-buffer) + (widen) (goto-char (point-min)) (re-search-forward (or nndoc-first-article nndoc-article-begin) nil t) *** pub/dgnus/lisp/nnfolder.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nnfolder.el Sat Aug 19 19:50:07 1995 *************** *** 624,630 **** (while (not (= end (point-max))) (setq start (marker-position end)) (goto-char end) ! (end-of-line) (set-marker end (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max))) --- 624,633 ---- (while (not (= end (point-max))) (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 (or (and (re-search-forward delim nil t) (match-beginning 0)) (point-max))) *** pub/dgnus/lisp/nnkiboze.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nnkiboze.el Thu Aug 17 19:04:28 1995 *************** *** 1,4 **** ! ;;; nnkiboze.el --- select virtual news access for (ding) Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ! ;;; nnkiboze.el --- select virtual news access for Gnus ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *** pub/dgnus/lisp/nntp.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nntp.el Mon Aug 14 13:23:16 1995 *************** *** 1089,1096 **** (run-hooks 'nntp-server-hook) nntp-server-process))))) - (defvar nntp-dum-num 5) - (defun nntp-open-network-stream (server) (open-network-stream "nntpd" nntp-server-buffer server nntp-port-number)) --- 1089,1094 ---- *** pub/dgnus/lisp/nnvirtual.el Mon Aug 14 00:06:34 1995 --- dgnus/lisp/nnvirtual.el Sat Aug 19 20:56:52 1995 *************** *** 1,4 **** ! ;;; nnvirtual.el --- virtual newsgroups access for (ding) Gnus ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ! ;;; nnvirtual.el --- virtual newsgroups access for Gnus ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 325,331 **** ;; See if the group has had its active list read this session ;; if not, we do it now. (if (null active) ! (if (gnus-activate-newsgroup igroup) (progn (gnus-get-unread-articles-in-group info (gnus-gethash igroup gnus-active-hashtb)) --- 325,331 ---- ;; See if the group has had its active list read this session ;; if not, we do it now. (if (null active) ! (if (gnus-activate-group igroup) (progn (gnus-get-unread-articles-in-group info (gnus-gethash igroup gnus-active-hashtb)) *** pub/dgnus/lisp/ChangeLog Mon Aug 14 00:06:35 1995 --- dgnus/lisp/ChangeLog Sat Aug 19 21:11:01 1995 *************** *** 1,4 **** --- 1,89 ---- + Sat Aug 19 16:37:58 1995 Lars Magne Ingebrigtsen + + * nnbabyl.el (nnbabyl-read-mbox): Would create ghost articles. + + * gnus.el (gnus-summary-move-article): Would barf on respooling to + (as-yet) non-existant groups. + (gnus-summary-best-unread-article): Really go to the best article. + (gnus-activate-group): Continue on non-available groups. + + * gnus-score.el (gnus-score-change-score-file): Prompt from dir, + not cache. + + * nnfolder.el (nnfolder-read-folder): Ghost articles would be + produced when there were more than 1 consecutive "From " line. + + * gnus.el (gnus-update-read-articles): Would display the wrong + number of unread articles in the group buffer when updates have + been done while the summary buffer was active. + (gnus-summary-read-group): `O' old-fetched articles would be + improperly inited. + (gnus-ignored-newsgroups): Removed again. + (gnus-active-to-gnus-format): Understand groups that have strange + chars in the names. + (gnus-select-newsgroup): Would ignore the first article from all + backends that did not support NOV when using + `gnus-fetch-old-headers'. + (gnus-article-mode-map): Disabled all summary commands in the + article buffer. + (gnus-get-unread-articles): Make sure that the server connection + is up. + + Sat Aug 19 16:07:59 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-catchup): Would bug out on `all' sometimes. + + Thu Aug 17 20:19:07 1995 Per Abrahamsen + + * gnus-cus.el: Added `gnus-summary-highlight'. + + Wed Aug 16 16:07:35 1995 Per Abrahamsen + + * custom.el: Added support for including values that needs to be + evaluated in lists. + + Fri Aug 18 15:27:20 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-ignored-newsgroups): Start ignoring stuff again. + (gnus-summary-show-article): Removed interpretation of prefix arg. + + Wed Aug 16 08:22:05 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-mark-same-subject): Update number mode + line. + + Tue Aug 15 19:21:55 1995 Per Abrahamsen + + * custom.el: Allow all field to contain invalid data. Only parse + field when point leaves it or when the value is needed, not + after each change as previously. + + Wed Aug 16 08:11:24 1995 Lars Magne Ingebrigtsen + + * gnus-ems.el: Don't destroy the hidden props in 19.28. + + Tue Aug 15 09:03:11 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-offer-save-summaries): Allow ! and q as answers. + (gnus-summary-mode-map): Defined date keys in the wrong map. + + * gnus-vis.el (gnus-button-url): Use w3 if it exists. + + Mon Aug 14 15:51:08 1995 Lars Magne Ingebrigtsen + + * gnus-vis.el (gnus-group-make-menu-bar): Removed "post" menu. + + Mon Aug 14 11:37:39 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-edit-article-done): Do the visual hook + after returning to the summary buffer. + + * gnus-score.el (gnus-score-save): Ignore score files that can't + be saved. + Sun Aug 13 17:15:22 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.99.11 is released. * gnus.el (gnus-groups-to-gnus-format): Don't skip everything if a simple error occurs; just ignore the buggy line. *** pub/dgnus/texi/gnus.texi Mon Aug 14 00:06:36 1995 --- dgnus/texi/gnus.texi Sat Aug 19 16:57:42 1995 *************** *** 5302,5310 **** --- 5302,5312 ---- Predefined functions available are: @table @code + @item gnus-score-find-single @findex gnus-score-find-single Only apply the group's own score file. + @item gnus-score-find-bnews @findex gnus-score-find-bnews Apply all score files that match, using bnews syntax. For instance, if *************** *** 5312,5317 **** --- 5314,5324 ---- @samp{not.alt.all.SCORE} and @samp{gnu.all.SCORE} would all apply. In short, the instances of @samp{all} in the score file names are translated into @samp{.*}, and then a regexp match is done. + + If @code{gnus-use-long-file-name} is non-@code{nil}, this won't work + very will. It will find stuff like @file{gnu/all/SCORE}, but will not + find files like @file{not/gnu/all/SCORE}. + @item gnus-score-find-hierarchical @findex gnus-score-find-hierarchical Apply all score files from all the parent groups.