From 65ff6f795c865d97a8f70d7c096f426aa773c597 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 03:29:56 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 42 +++++++++++++++++++++++++++- lisp/custom.el | 11 +++++--- lisp/gnus-cus.el | 2 +- lisp/gnus-msg.el | 68 ++++++++++++++++++++++++++-------------------- lisp/gnus-score.el | 37 +++++++++++++++++-------- lisp/gnus-vis.el | 5 +++- lisp/gnus.el | 44 ++++++++++++++++++++---------- texi/gnus.texi | 39 +++++++++++++++++++++++++- 8 files changed, 186 insertions(+), 62 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 22828a354..7d0957bfd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,4 +1,44 @@ -Mon Aug 28 05:09:47 1995 Lars Magne Ingebrigtsen +Tue Aug 29 05:55:19 1995 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-delete-supersedes-headers): Delete + Supersedes. + + * gnus-score.el (gnus-score-adaptive): Did not like matches on + numbers or dates. + + * gnus.el (gnus-server-kill-server): Did not mark the dribble + buffer as changed. + + * gnus-score.el (gnus-score-string): Did not do traces on fuzzy + scores. + + * gnus.el (gnus-read-init-file): Run on load. + + * gnus-cus.el (gnus-face-dark-name-list): Dark salmon isn't very + dark. + + * gnus-msg.el (gnus-inews-insert-headers): Don't insert multiple + Original-Sender headers. + + * gnus-vis.el (gnus-group-make-menu-bar): New submenu for editing + groups. + + * gnus-msg.el (gnus-removable-headers): New variable. + (gnus-inews-remove-headers): Use it. + +Mon Aug 28 17:19:41 1995 Per Abrahamsen + + * custom.el (custom-help-button): Add `custom-jump' property. + (custom-forward-field): Ignore fields with `custom-jump' property. + +Mon Aug 28 13:59:04 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-newsrc-to-gnus-format): Would totally barf on + illegal group names. + +Mon Aug 28 05:09:47 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.99.26 is released. * nntp.el (nntp-send-region-to-server): Would hang. diff --git a/lisp/custom.el b/lisp/custom.el index 9c0bfd0b2..5b18d2bda 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1721,6 +1721,7 @@ If the optional argument SAVE is non-nil, use that for saving changes." (set-text-properties from (point) (list 'face custom-button-face mouse-face custom-mouse-face + 'custom-jump t ;Make TAB jump over it. 'custom-tag command)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) @@ -1779,7 +1780,6 @@ If the optional argument SAVE is non-nil, use that for saving changes." With optional ARG, move across that many fields." (interactive "p") (while (> arg 0) - (setq arg (1- arg)) (let ((next (if (get-text-property (point) 'custom-tag) (next-single-property-change (point) 'custom-tag) (point)))) @@ -1787,9 +1787,10 @@ With optional ARG, move across that many fields." (next-single-property-change (point-min) 'custom-tag))) (if next (goto-char next) - (error "No customization fields in this buffer.")))) + (error "No customization fields in this buffer."))) + (or (get-text-property (point) 'custom-jump) + (setq arg (1- arg)))) (while (< arg 0) - (setq arg (1+ arg)) (let ((previous (if (get-text-property (1- (point)) 'custom-tag) (previous-single-property-change (point) 'custom-tag) (point)))) @@ -1798,7 +1799,9 @@ With optional ARG, move across that many fields." (previous-single-property-change (point-max) 'custom-tag))) (if previous (goto-char previous) - (error "No customization fields in this buffer."))))) + (error "No customization fields in this buffer."))) + (or (get-text-property (1- (point)) 'custom-jump) + (setq arg (1+ arg))))) (defun custom-backward-field (arg) "Move point to the previous field or button. diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 6516e05aa..32fb78e12 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -40,7 +40,7 @@ "turquoise")) (defvar gnus-face-dark-name-list - '("dark salmon" "firebrick" + '("blue" "firebrick" "dark green" "dark orange" "dark khaki" "dark violet" "dark turquoise")) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index f359ed828..858a83d7c 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -151,7 +151,10 @@ Message-ID. Organization, Lines and X-Newsreader are optional. If you want Gnus not to insert some header, remove it from this list.") (defvar gnus-deletable-headers '(Message-ID Date) - "*Headers to be deleted if they already exists.") + "*Headers to be deleted if they already exists and were generated by Gnus previously.") + +(defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref) + "*Headers to be removed unconditionally before posting.") (defvar gnus-check-before-posting '(subject-cmsg multiple-headers sendsys message-id from @@ -161,7 +164,8 @@ you want Gnus not to insert some header, remove it from this list.") If this variable is t, Gnus will check everything it can. If it is a list, then those elements in that list will be checked.") -(defvar gnus-delete-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:" +(defvar gnus-delete-supersedes-headers + "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before psoting to avoid any confusion.") @@ -358,21 +362,21 @@ header line with the old Message-ID." (progn (erase-buffer) (insert-buffer gnus-article-buffer) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (if (not (re-search-backward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (search-forward "\n\n") - (forward-line -1) - (insert mail-header-separator) - - (forward-line -1) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max))) (narrow-to-region (point-min) (point)) (goto-char (point-min)) (and gnus-delete-supersedes-headers (delete-matching-lines gnus-delete-supersedes-headers)) - (widen)))) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: " t t)) + (goto-char (point-max)) + (insert mail-header-separator) + (widen) + (forward-line 1)))) ;;;###autoload @@ -997,17 +1001,17 @@ will attempt to use the foreign server to post the article." (kill-buffer (current-buffer))))))) (defun gnus-inews-remove-headers () - (let ((case-fold-search t)) - ;; Remove NNTP-posting-host. - (goto-char (point-min)) - (and (re-search-forward "^nntp-posting-host:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Remove Bcc. - (goto-char (point-min)) - (and (re-search-forward "^bcc:" nil t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))))) + (let ((case-fold-search t) + (headers gnus-removable-headers)) + ;; Remove toxic headers. + (while headers + (goto-char (point-min)) + (and (re-search-forward + (concat "^" (downcase (format "%s" (car headers)))) + nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + (setq headers (cdr headers))))) (defun gnus-inews-insert-headers () "Prepare article headers. @@ -1097,11 +1101,17 @@ Headers in `gnus-required-headers' will be generated." '(gnus-deletable t face italic) (current-buffer)))))) (setq headers (cdr headers))) ;; Insert new Sender if the From is strange. - (let ((from (mail-fetch-field "from"))) - (if (and from (not (string= - (downcase (car (gnus-extract-address-components - from))) - (downcase (gnus-inews-real-user-address))))) + (let ((from (mail-fetch-field "from")) + (sender (mail-fetch-field "sender"))) + (if (and from + (not (string= + (downcase (car (gnus-extract-address-components from))) + (downcase (gnus-inews-real-user-address)))) + (or (null sender) + (not + (string= + (downcase (car (gnus-extract-address-components sender))) + (downcase (gnus-inews-real-user-address)))))) (progn (goto-char (point-min)) (and (re-search-forward "^Sender:" nil t) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 5b0910de5..7f7b32ec8 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1402,10 +1402,19 @@ SCORE is the score to add." (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art)))))) + (if trace + (while arts + (setq art (car arts) + arts (cdr arts)) + (setcdr art (+ score (cdr art))) + (setq gnus-score-trace + (cons (cons (header-number + (car art)) kill) + gnus-score-trace))) + (while arts + (setq art (car arts) + arts (cdr arts)) + (setcdr art (+ score (cdr art))))))) (forward-line 1)) ;; Update expire date (cond ((null date)) ;Permanent entry. @@ -1488,13 +1497,19 @@ SCORE is the score to add." (setq match (funcall (car (car elem)) headers)) (gnus-summary-score-entry (nth 1 (car elem)) match - ;; Whether we use substring or exact matches are controlled - ;; here. - (if (or (not gnus-score-exact-adapt-limit) - (< (length match) gnus-score-exact-adapt-limit)) - 'e - (if (equal (nth 1 (car elem)) "subject") - 'f 's)) + (cond + ((numberp match) + '=) + ((equal (nth 1 (car elem)) "date") + 'a) + (t + ;; Whether we use substring or exact matches are controlled + ;; here. + (if (or (not gnus-score-exact-adapt-limit) + (< (length match) gnus-score-exact-adapt-limit)) + 'e + (if (equal (nth 1 (car elem)) "subject") + 'f 's)))) (nth 2 (car elem)) date nil t) (setq elem (cdr elem)))) (forward-line 1))))) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index 28c8327d0..3b6dbc1d1 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -305,7 +305,6 @@ variable it the real callback function.") ["Kill all zombie groups" gnus-group-kill-all-zombies t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] - ["Edit a group entry" gnus-group-edit-group t] ["Add a directory group" gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] ["Add the archive group" gnus-group-make-archive-group t] @@ -313,6 +312,10 @@ variable it the real callback function.") ["Make a kiboze group" gnus-group-make-kiboze-group t] ["Make a virtual group" gnus-group-make-empty-virtual t] ["Add a group to a virtual" gnus-group-add-to-virtual t]) + ("Editing groups" + ["Parameters" gnus-group-edit-group-parameters t] + ["Select method" gnus-group-edit-group-method t] + ["Info" gnus-group-edit-group t]) ["Read a directory as a group" gnus-group-enter-directory t] ["Jump to group" gnus-group-jump-to-group t] ["Best unread group" gnus-group-best-unread-group t] diff --git a/lisp/gnus.el b/lisp/gnus.el index 57907d1ea..989400088 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1343,7 +1343,7 @@ variable (string, integer, character, etc).") "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") -(defconst gnus-version "(ding) Gnus v0.99.26" +(defconst gnus-version "(ding) Gnus v0.99.27" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -1512,7 +1512,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (defvar gnus-reffed-article-number nil) ; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-file) +(defvar rmail-default-rmail-file) (defvar gnus-cache-removeable-articles nil) @@ -1821,6 +1821,23 @@ Thank you for your help in stamping out bugs. (` (delete-region (progn (beginning-of-line) (point)) (progn (forward-line (, (or n 1))) (point))))) +;; Suggested by Brian Edmonds . +(defvar gnus-init-inhibit nil) +(defun gnus-read-init-file (&optional inhibit-next) + (if gnus-init-inhibit + (setq gnus-init-inhibit nil) + (setq gnus-init-inhibit inhibit-next) + (and gnus-init-file + (or (and (file-exists-p gnus-init-file) + ;; Don't try to load a directory. + (not (file-directory-p gnus-init-file))) + (file-exists-p (concat gnus-init-file ".el")) + (file-exists-p (concat gnus-init-file ".elc"))) + (load gnus-init-file nil t)))) + +;;; Load the user startup file. +(gnus-read-init-file 'inhibit) + ;;; Load the compatability functions. (require 'gnus-cus) @@ -2039,16 +2056,6 @@ Thank you for your help in stamping out bugs. (setq fstring (buffer-substring 1 (point-max)))) (cons 'format (cons fstring (nreverse flist))))) -;; Suggested by Brian Edmonds . -(defun gnus-read-init-file () - (and gnus-init-file - (or (and (file-exists-p gnus-init-file) - ;; Don't try to load a directory. - (not (file-directory-p gnus-init-file))) - (file-exists-p (concat gnus-init-file ".el")) - (file-exists-p (concat gnus-init-file ".elc"))) - (load gnus-init-file nil t))) - (defun gnus-set-work-buffer () (if (get-buffer gnus-work-buffer) (progn @@ -2374,6 +2381,12 @@ If optional argument RE-ONLY is non-nil, strip `Re:' only." (defun gnus-header-id (header) (header-id header)) +(defun gnus-header-message-id (header) + (header-id header)) + +(defun gnus-header-chars (header) + (header-chars header)) + (defun gnus-header-references (header) (header-references header)) @@ -10588,6 +10601,8 @@ is initialized from the SAVEDIR environment variable." (put 'gnus-article-mode 'mode-class 'special) +(defvar gnus-boogaboo nil) + (if gnus-article-mode-map nil (setq gnus-article-mode-map (make-keymap)) @@ -10632,7 +10647,7 @@ is initialized from the SAVEDIR environment variable." ;; "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 + (while (and gnus-boogaboo commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands)))) @@ -10640,7 +10655,7 @@ is initialized from the SAVEDIR environment variable." (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 + (while (and gnus-boogaboo commands) ; disabled (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) @@ -13750,6 +13765,7 @@ The following commands are available: (or (gnus-server-goto-server server) (if server (error "No such server: %s" server) (error "No server on the current line"))) + (gnus-dribble-enter "") (let ((buffer-read-only nil)) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) diff --git a/texi/gnus.texi b/texi/gnus.texi index 33ec9a983..ed56cdd18 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -3373,6 +3373,13 @@ like this: This function will be called narrowed to header of the article that is being followed up. +@item gnus-removable-headers +@vindex gnus-removable-headers +Some headers that are generated are toxic to the @sc{nntp} server. +These include the @code{NNTP-Posting-Host}, @code{Bcc} and @code{Xref}, +so these headers are deleted if they are present in this list of +symbols. + @item gnus-deletable-headers @vindex gnus-deletable-headers Headers in this list that were previously generated by Gnus will be @@ -5211,6 +5218,10 @@ Score on thread - the References line. Score on the date. @item l Score on the number of lines. +@item i +Score on the Message-ID. +@item f +Score on followups. @item b Score on the body. @item h @@ -5218,7 +5229,12 @@ Score on the head. @end table @item -The third key is the match type. +The third key is the match type. Which match types are legal depends on +what headers you are scoring on. + +@table @code +@item strings + @table @kbd @item e Exact matching. @@ -5230,6 +5246,27 @@ Fuzzy matching. Regexp matching @end table +@item date +@table @kbd +@item b +Before date. +@item a +At date. +@item n +This date. +@end table + +@item number +@table @kbd +@item < +Less than number. +@item = +Equal to number. +@item > +Greater than number. +@end table +@end table + @item The fourth and final key says whether this is a temporary (i.e., expiring) score entry, or a permanent (i.e., non-expiring) score entry, or whether -- 2.34.1