+Sat May 20 00:11:59 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-msg.el (gnus-mail-reply-using-mail): Don't barf wifout a
+ message-id.
+
+ * gnus-score.el (gnus-score-load-file): 'eval was not right.
+
+ * gnus.el (gnus-make-articles-unread): Would deliver wrong
+ results.
+
+Fri May 19 01:10:34 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * nnbabyl.el (nnbabyl-insert-newsgroup-line): Did not translate
+ "From " lines.
+ (nnbabyl-insert-lines): Wrong number of lines.
+ (nnbabyl-request-accept-article): Bugged out.
+
+ * nnmh.el (nnmh-request-accept-article): Would never accept an
+ article.
+
+ * gnus-vis.el (gnus-article-add-buttons): `Entry' would be nil
+ sometimes.
+
+ * gnus-ems.el (gnus-ems-redefine): Redefine buffer-display-table.
+
+ * gnus.el (gnus): Init server buffer, just in case.
+
+ * nnml.el (nnml-request-create-group): string-to-int instead of
+ int-to-string.
+
+ * gnus.el (gnus-group-use-permament-levels): New variable,
+ supersedes other variables.
+ (gnus-article-prepare): Let buffer-read-only nil before calling
+ hooks.
+ (gnus-summary-next-group): Recenter group buffer.
+ (gnus-get-newsgroup-headers): Articles without message-id's
+ fetched in separate batches would be clobbered.
+
+ * gnus-msg.el (gnus-inews-do-fcc): Make sure the fcc dir exists.
+ (gnus-inews-news): If both mailing and posting, remove the Fcc
+ before posting.
+
+ * nnvirtual.el (nnvirtual-request-post-buffer): Don't suggest any
+ newsgroups to post in.
+
+ * gnus.el (gnus-list-of-read-articles): Would totally bug out.
+
+ * gnus-score.el (gnus-score-string): Add tracing.
+ (gnus-score-find-trace): New command and keystroke.
+
+ * nnmbox.el (nnmbox-request-expire-articles): When deleting the
+ last article, would infloop.
+
+ * nnbabyl.el (nnbabyl-article-string): Did not anchor end of
+ number.
+
+ * gnus-msg.el (gnus-forward-insert-buffer): Don't do double
+ copying of article buffer.
+ (gnus-copy-article-buffer): Would barf when the article buffer
+ didn't exist.
+
+ * gnus.el (gnus-configure-windows): Split the opposite way.
+ (gnus-summary-next-group): Would cycle on 0 on the last group.
+
+ * gnus-score.el (gnus-summary-increase-score): Give fuller
+ prompts.
+
+Sun May 14 10:01:49 1995 Per Abrahamsen <abraham@iesd.auc.dk>
+
+ * gnus.el: Use (point-min) instead if `1'.
+
+ * gnus.el (gnus-hidden-properties): Added.
+ (gnus-summary-toggle-header, gnus-article-show-all-headers,
+ gnus-article-hide-headers): Use it.
+
+ * gnus-cite.el (gnus-article-hide-citation,
+ gnus-article-hide-citation-maybe, gnus-cite-toggle): Use it.
+
+ * gnus-vis.el (gnus-article-hide-signature,
+ gnus-signature-toggle): use it.
+
+ * gnus.el (gnus-article-hide-signature): Deleted. Use the version
+ in `gnus-vis.el' instead.
+
+ * gnus-vis.el (gnus-article-next-button): New function and
+ keybinding.
+
+Thu May 18 03:10:03 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-score-edit-alist): Really save winconf.
+
+ * gnus.el (gnus-summary-enter-digest-group): Don't use / in group
+ names.
+
+ * nnmail.el (nnmail-split-incoming): Use Content-Length header.
+
+ * gnus-score.el (gnus-score-headers): Let current-score-file.
+
+ * gnus-ems.el: Don't use intagible before 19.29.
+
+ * nndigest.el (nndigest-narrow-to-article): Stop before that *End
+ of digest* line.
+
+ * gnus-score.el (gnus-score-score-files): Expand the kill-file
+ path before using it.
+ (gnus-summary-increase-score): Double quoting of types.
+
+ * gnus-mh.el (gnus-mail-forward-using-mhe): Use the incoming
+ buffer.
+
+ * gnus.el (gnus-summary-prepare-threads): False roots would get
+ incorrect number of children.
+
+ * nnspool.el (nnspool-inews-sentinel): condition-case the sending
+ of eof.
+
+ * gnus.el (gnus-summary-mark-article): Always un-hide threads.
+ (gnus-update-read-articles): Peel off expired article numbers.
+ (gnus-article-set-window-start): New function.
+ (gnus-summary-refer-article): Would scroll to the end of the
+ buffer.
+
+ * gnus-uu.el (gnus-uu-save-article): Grabbed one char to many when
+ snarfing headers.
+
+ * gnus-score.el (gnus-score-add-followups): Don't enter if there
+ already is one.
+
+ * gnus.el (gnus-nov-read-integer): Condition-case the read.
+
+ * nnvirtual.el (nnvirtual-close-group): Always handle a close.
+
+ * gnus-vm.el (gnus-mail-forward-using-vm): Accept an argument.
+
+ * gnus-mh.el (gnus-mail-forward-using-mhe): Ditto.
+
+ * gnus.el (gnus-summary-make-display-table): New function.
+
+Thu May 18 00:58:54 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-summary-mode): Display-table would be nil.
+
+ * gnus.el: 0.72 is released.
+
Wed May 17 19:38:43 1995 Lars Magne Ingebrigtsen <larsi@surt.ifi.uio.no>
* gnus.el: 0.71 is released.
(if props
(put-text-property start end (car props) (cadr props) buffer)
(remove-text-properties start end ()))))
-
+
+ (or (fboundp 'make-overlay (fset 'make-overlay 'make-extent)))
+ (or (fboundp 'over-lay-put (fset 'overlay-put 'set-extent-property)))
+ (or (boundp 'standard-display-table (setq standard-display-table nil)))
+
(if (not gnus-visual)
()
(setq gnus-group-mode-hook
(defun gnus-install-mouse-tracker ()
(require 'mode-motion)
(setq mode-motion-hook 'mode-motion-highlight-line)))
+
+ ((and (not (string-match "28.9" emacs-version))
+ (not (string-match "29" emacs-version)))
+ (setq gnus-hidden-properties '(invisible t)))
+
+ ))
+
+(eval-and-compile
+ (cond
+ ((not window-system)
+ (defun gnus-dummy-func (&rest args))
+ (let ((funcs '(mouse-set-point make-face set-face-foreground
+ set-face-background)))
+ (while funcs
+ (or (fboundp (car funcs))
+ (fset (car funcs) 'gnus-dummy-func))
+ (setq funcs (cdr funcs)))))
))
(defun gnus-ems-redefine ()
(cond
((string-match "XEmacs\\|Lucid" emacs-version)
;; XEmacs definitions.
- (fset 'gnus-set-mouse-face (lambda (string) string)))
+ (fset 'gnus-set-mouse-face (lambda (string) string))
+
+ (defun gnus-summary-make-display-table ()
+ (let* ((table (window-display-table)))
+ (and (not table)
+ (setq table (make-vector 261 ())))
+ (let ((i 32))
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??])))
+ (aset table ?\n nil)
+ (let ((i 160))
+ (while (>= (setq i (1- i)) 127)
+ (aset table i [??])))
+ (setq gnus-summary-display-table table)))
+
+ )
))
(provide 'gnus-ems)
+;; Local Variables:
+;; byte-compile-warnings: nil
+;; End:
+
;;; gnus-ems.el ends here
;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
;; <itojun@ingram.mt.cs.keio.ac.jp>
-(defun gnus-mail-forward-using-mhe ()
+(defun gnus-mail-forward-using-mhe (&optional buffer)
"Forward the current message to another user using mh-e."
;; First of all, prepare mhe mail buffer.
(let ((to (read-string "To: "))
(cc (read-string "Cc: "))
- (buffer (current-buffer))
+ (buffer (or buffer gnus-article-buffer))
subject
(config (current-window-configuration))) ;; need to add this - erik
;;(gnus-article-show-all-headers)
The hook is called from the *post-news* buffer, narrowed to the
headers.")
+(defvar gnus-mail-hook nil
+ "*A hook called as the last thing after setting up a mail buffer.")
+
;;; Internal variables.
(defvar gnus-post-news-buffer "*post-news*")
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
+ (buffer-disable-undo gnus-article-copy)
(or (memq gnus-article-copy gnus-buffer-list)
(setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
- (save-excursion
- (set-buffer (or article-buffer gnus-article-buffer))
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-text-properties (point-min) (point-max) nil gnus-article-copy)))
+ (let ((article-buffer (or article-buffer gnus-article-buffer)))
+ (if (and (get-buffer article-buffer)
+ (buffer-name (get-buffer article-buffer)))
+ (save-excursion
+ (set-buffer article-buffer)
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-text-properties (point-min) (point-max)
+ nil gnus-article-copy)))))
(defun gnus-post-news (post &optional group header article-buffer yank subject)
"Begin editing a new USENET news article to be posted.
(progn
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))))
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (match-beginning 0)))
;; Correct newsgroups field: change sequence of spaces to comma and
;; eliminate spaces around commas. Eliminate imbedded line breaks.
;; Mail the message too if To:, Bcc:. or Cc: exists.
(let* ((types '("to" "bcc" "cc"))
- (ty types))
+ (ty types)
+ fcc-line)
(while ty
(or (mail-fetch-field (car ty) nil t)
(setq types (delete (car ty) types)))
1 "No mailer defined. To: and/or Cc: fields ignored.")
(sit-for 1))
(save-excursion
+ ;; We want to remove Fcc, because we want to handle
+ ;; that one ourselves...
+
+ (goto-char (point-min))
+ (if (re-search-forward "^Fcc: " nil t)
+ (progn
+ (setq fcc-line
+ (buffer-substring
+ (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (forward-line -1)
+ (gnus-delete-line)))
+
(save-restriction
(widen)
(gnus-message 5 "Sending via mail...")
-
+
(if (and gnus-mail-courtesy-message
(or (member "to" types)
(member "cc" types)))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")))
(goto-char (point-min))
- (delete-matching-lines "^BCC:")))))))
+ (delete-matching-lines "^BCC:"))
+ (if fcc-line
+ (progn
+ (goto-char (point-max))
+ (insert fcc-line))))))))
;; Send to NNTP server.
(gnus-message 5 "Posting to USENET...")
(t
;; Suggested by hyoko@flab.fujitsu.junet.
;; Save article in Unix mail format by default.
+ (gnus-make-directory fcc-file)
(if (and gnus-author-copy-saver
(not (eq gnus-author-copy-saver 'rmail-output)))
(funcall gnus-author-copy-saver fcc-file)
"~/.organization")))
(and (stringp organization)
(> (length organization) 0)
- (or (file-exists-p organization)
- (string-match " " organization)
- (not (string-match "^/[^/]+/" (expand-file-name organization))))
(save-excursion
(gnus-set-work-buffer)
(if (file-exists-p organization)
(setq reply-to (mail-fetch-field "reply-to"))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id")))
- (setq news-reply-yank-from from)
- (setq news-reply-yank-message-id message-id)
+ (setq news-reply-yank-from (or from "(nobody)"))
+ (setq news-reply-yank-message-id
+ (or message-id "(unknown Message-ID)"))
;; Gather the "to" addresses out of the follow-to list and remove
;; them as we go.
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
- (gnus-configure-windows 'reply-yank))))))
+ (gnus-configure-windows 'reply-yank))
+ (run-hooks 'gnus-mail-hook)))))
(defun gnus-mail-yank-original ()
(interactive)
(defun gnus-forward-insert-buffer (buffer)
(let ((beg (goto-char (point-max))))
(insert "------- Start of forwarded message -------\n")
- (gnus-copy-article-buffer buffer)
- (insert-buffer gnus-article-copy)
+ (insert-buffer buffer)
(goto-char (point-max))
(insert "------- End of forwarded message -------\n")
;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
(gnus-catchup-mark (from -1) (subject -1)))
"*Alist of marks and scores.")
+(defvar gnus-score-mimic-keymap nil
+ "*Have the score entry functions pretend that they are a keymap.")
+
(defvar gnus-score-exact-adapt-limit nil
"*Number that says how long a match has to be before using substring matching.
When doing adaptive scoring, one normally uses substring matching.
(defvar gnus-internal-global-score-files nil)
(defvar gnus-score-file-list nil)
-(defvar gnus-current-score-file nil)
(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
+(defvar gnus-score-trace nil)
+
(defvar gnus-score-alist nil
"Alist containing score information.
The keys can be symbols or strings. The following symbols are defined.
(define-key gnus-summary-score-map "x" 'gnus-score-set-expunge-below)
(define-key gnus-summary-score-map "e" 'gnus-score-edit-alist)
(define-key gnus-summary-score-map "f" 'gnus-score-edit-file)
+(define-key gnus-summary-score-map "t" 'gnus-score-find-trace)
(defun gnus-summary-increase-score (score)
(interactive "P")
- (let* ((score (gnus-score-default score))
- (prefix (if (< score 0) ?L ?I))
+ (let* ((nscore (gnus-score-default score))
+ (prefix (if (< nscore 0) ?L ?I))
+ (increase (> nscore 0))
(char-to-header
'((?a "from")
(?s "subject")
(?d "date")
(?f "followup")))
(char-to-type
- '((?e 'e)
- (?f 'f)
- (?s 's)
- (?r 'r)
- (?b 'before)
- (?a 'at)
- (?n 'now)
- (?< '<)
- (?> '>)
- (?= '=)))
+ '((?e e) (?f f) (?s nil) (?r r) (?b before)
+ (?a at) (?n now) (?< <) (?> >) (?= =)))
+ (char-to-perm
+ (list (list ?t (current-time-string)) '(?p nil) '(?i now)))
+ (mimic gnus-score-mimic-keymap)
hchar entry temporary tchar pchar end type)
;; First we read the header to score.
- (message "%c-" prefix)
+ (if mimic
+ (message "%c-" prefix)
+ (message "%s header (%s): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-header "")))
(setq hchar (read-char))
(or (setq entry (assq (downcase hchar) char-to-header))
(progn
(ding)
(setq end t)
- (message "%c %c" prefix hchar)))
+ (if mimic (message "%c %c" prefix hchar) (message ""))))
(if (or end (/= (downcase hchar) hchar))
(progn
;; This was a majuscle, so we end reading and set the defaults.
- (message "%c %c" prefix hchar)
- (setq type 's
- temporary t))
+ (if mimic (message "%c %c" prefix hchar) (message ""))
+ (setq type nil
+ temporary (current-time-string)))
;; We continue reading - the type.
- (message "%c %c-" prefix hchar)
+ (if mimic
+ (message "%c %c-" prefix hchar)
+ (message "%s header '%s' with match type (%s): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-type "")))
(setq tchar (read-char))
(or (setq type (nth 1 (assq (downcase tchar) char-to-type)))
(progn
(ding)
- (message "%c %c" prefix hchar)
+ (if mimic (message "%c %c" prefix hchar) (message ""))
(setq end t)))
(if (or end (/= (downcase tchar) tchar))
(progn
;; It was a majuscle, so we end reading and the the default.
- (message "%c %c %c" prefix hchar tchar)
- (setq temporary t))
+ (if mimic (message "%c %c %c" prefix hchar tchar)
+ (message ""))
+ (setq temporary (current-time-string)))
;; We continue reading.
- (message "%c %c %c-" prefix hchar tchar)
+ (if mimic
+ (message "%c %c %c-" prefix hchar tchar)
+ (message "%s permanence (%s): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-perm "")))
(setq pchar (read-char))
- (message "%c %c %c" prefix hchar tchar pchar)
- (cond ((= pchar ?t)
- (setq temporary t))
- ((/= pchar ?p)
- (ding)
- (setq end t)
- (message "%c %c %c %c" prefix hchar tchar pchar)))))
+ (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (message ""))
+ (if (setq temporary (nth 1 (assq pchar char-to-perm)))
+ ()
+ (ding)
+ (setq end t)
+ (if mimic
+ (message "%c %c %c %c" prefix hchar tchar pchar)
+ (message "")))))
;; We have all the data, so we enter this score.
(if end
()
(nth 1 entry) ; Header
(gnus-summary-header (or (nth 2 entry) (nth 1 entry))) ; Match
type ; Type
- (gnus-score-default score) ; Score
- (and temporary (current-time-string)) ; Temp
+ score ; Score
+ temporary ; Temp
(not (nth 3 entry))) ; Prompt
)))
(defun gnus-score-edit-alist (file)
"Edit the current score alist."
(interactive (list gnus-current-score-file))
- (and (buffer-name gnus-summary-buffer) (gnus-score-save))
(let ((winconf (current-window-configuration)))
+ (and (buffer-name gnus-summary-buffer) (gnus-score-save))
(gnus-configure-windows 'article)
(pop-to-buffer (find-file-noselect file))
+ (gnus-score-mode)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-done] to save edits"))
- (gnus-score-mode))
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-done] to save edits")))
(defun gnus-score-edit-file (file)
"Edit a score file."
(let ((winconf (current-window-configuration)))
(gnus-configure-windows 'article)
(pop-to-buffer (find-file-noselect file))
+ (gnus-score-mode)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
(gnus-message
4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-done] to save edits"))
- (gnus-score-mode))
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-done] to save edits")))
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
(exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist)))
(adapt (gnus-score-get 'adapt alist))
- (eval (gnus-score-get 'eval alist)))
+ (eval (car (gnus-score-get 'eval alist))))
;; We do not respect eval and files atoms from global score
;; files.
(and files (not global)
(write-region (point-min) (point-max) file nil 'silent))))
(kill-buffer (current-buffer)))))
-(defun gnus-score-headers (score-files)
+(defun gnus-score-headers (score-files &optional trace)
;; Score `gnus-newsgroup-headers'.
(let (scores)
;; PLM: probably this is not the best place to clear orphan-score
(now (gnus-day-number (current-time-string)))
(expire (- now gnus-score-expiry-days))
(headers gnus-newsgroup-headers)
+ (gnus-current-score-file gnus-current-score-file)
entry header)
(gnus-message 5 "Scoring...")
;; Create articles, an alist of the form `(HEADER . SCORE)'.
(lambda (score)
(length (gnus-score-get header score)))
scores)))
- (funcall (nth 2 entry) scores header now expire)))
+ (funcall (nth 2 entry) scores header now expire trace)))
;; Remove the buffer.
(kill-buffer (current-buffer)))
(forward-line))))))
-(defun gnus-score-integer (scores header now expire)
+(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
alike last this art entries alist articles)
(or (aref (car (car articles)) gnus-score-index) 0)
match)
(progn
+ (and trace (setq gnus-score-trace
+ (cons (cons (car (car articles)) kill)
+ gnus-score-trace)))
(setq found t)
(setcdr (car articles) (+ score (cdr (car articles))))))
(setq articles (cdr articles)))
(setq rest entries)))
(setq entries rest))))))
-(defun gnus-score-date (scores header now expire)
+(defun gnus-score-date (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
alike last this art entries alist articles)
(setq l (aref (car (car articles)) gnus-score-index))
(funcall match-func match (timezone-make-date-sortable l))
(progn
+ (and trace (setq gnus-score-trace
+ (cons (cons (car (car articles)) kill)
+ gnus-score-trace)))
(setq found t)
(setcdr (car articles) (+ score (cdr (car articles))))))
(setq articles (cdr articles)))
(setq rest entries)))
(setq entries rest))))))
-(defun gnus-score-body (scores header now expire)
+(defun gnus-score-body (scores header now expire &optional trace)
(save-excursion
(set-buffer nntp-server-buffer)
(save-restriction
;; Found a match, update scores.
(progn
(setcdr (car articles) (+ score (cdr (car articles))))
- (setq found t)))
+ (setq found t)
+ (and trace (setq gnus-score-trace
+ (cons (cons (car (car articles)) kill)
+ gnus-score-trace)))))
;; Update expire date
(cond ((null date)) ;Permanent entry.
(found ;Match, update date.
(defun gnus-score-add-followups (header score)
(save-excursion
(set-buffer gnus-summary-buffer)
- (gnus-summary-score-entry
- "references" (header-id header) 's score
- (current-time-string) nil t)))
+ (let ((id (header-id header))
+ (score gnus-score-alist)
+ dont)
+ ;; Don't enter a score if there already is one.
+ (while score
+ (and (equal "references" (car (car score)))
+ (or (null (nth 3 (car score)))
+ (eq 's (nth 3 (car score))))
+ (progn
+ (or (assoc id (car score))
+ (setq dont t))
+ (setq score nil)))
+ (setq score (cdr score)))
+ (or dont
+ (gnus-summary-score-entry
+ "references" id 's score (current-time-string) nil t)))))
-(defun gnus-score-string (score-list header now expire)
+(defun gnus-score-string (score-list header now expire &optional trace)
;; Score ARTICLES according to HEADER in SCORE-LIST.
;; Update matches entries to NOW and remove unmatched entried older
;; than EXPIRE.
(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))
(and (string= match "") (setq match "\n"))
(while (funcall search-func match nil t)
(end-of-line)
(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)))))))
;; Update expire date
(cond ((null date)) ;Permanent entry.
(found ;Match, update date.
(winconf gnus-prev-winconf))
(save-buffer)
(kill-buffer (current-buffer))
- (and winconf (set-window-configuration winconf))
(gnus-score-remove-from-cache bufnam)
- (gnus-score-load-file bufnam)))
+ (gnus-score-load-file bufnam)
+ (and winconf (set-window-configuration winconf))))
;;; Finding score files.
(file-name-as-directory
(or gnus-kill-files-directory "~/News/")))
;; If er can't read it, there's no score files.
- (if (not (file-readable-p gnus-kill-files-directory))
+ (if (not (file-readable-p (expand-file-name gnus-kill-files-directory)))
(setq gnus-score-file-list nil)
(if (gnus-use-long-file-name 'not-score)
;; We want long file names.
(setq all (cons group all))
(mapcar 'gnus-score-file-name (nreverse all))))
-(defun gnus-possibly-score-headers ()
+(defun gnus-possibly-score-headers (&optional trace)
(let ((func gnus-score-find-score-files-function)
score-files scores)
(and func (not (listp func))
(setq score-files
(nconc score-files (funcall (car func) gnus-newsgroup-name))))
(setq func (cdr func)))
- (if score-files (gnus-score-headers score-files))))
+ (if score-files (gnus-score-headers score-files trace))))
(defun gnus-score-file-name (newsgroup &optional suffix)
"Return the name of a score file for NEWSGROUP."
(setq files (cdr files)))
(setq gnus-internal-global-score-files out)))
+(defun gnus-score-find-trace ()
+ "Find all score rules applied to this article."
+ (interactive)
+ (let ((gnus-newsgroup-headers
+ (list (gnus-get-header-by-number (gnus-summary-article-number))))
+ (gnus-newsgroup-scored nil)
+ (buf (current-buffer))
+ trace)
+ (setq gnus-score-trace nil)
+ (gnus-possibly-score-headers 'trace)
+ (pop-to-buffer "*Gnus Scores*")
+ (erase-buffer)
+ (setq trace gnus-score-trace)
+ (or trace
+ (error "No score rules apply to the current article."))
+ (while trace
+ (insert (format "%S\n" (cdr (car trace))))
+ (setq trace (cdr trace)))
+ (goto-char (point-min))
+ (pop-to-buffer buf)))
+
+
(provide 'gnus-score)
;;; gnus-score.el ends here
(concat sorthead
(buffer-substring
(match-beginning 0)
- (or (re-search-forward "^[^ \t]" nil t)
+ (or (and (re-search-forward "^[^ \t]" nil t)
+ (1- (point)))
(progn (forward-line 1) (point))))))))
(widen)))
(insert sorthead)(goto-char (point-max))
["Set mark below" gnus-score-set-mark-below t]
["Set expunge below" gnus-score-set-expunge-below t]
["Edit current score file" gnus-score-edit-alist t]
- ["Edit score file" gnus-score-edit-file t])
- ["Raise score with current subject"
- gnus-summary-temporarily-raise-by-subject t]
- ["Raise score with current author"
- gnus-summary-temporarily-raise-by-author t]
- ["Raise score with current thread"
- gnus-summary-temporarily-raise-by-thread t]
- ["Raise score with current crossposting"
- gnus-summary-temporarily-raise-by-xref t]
- ["Raise score for followups to current author"
- gnus-summary-temporarily-raise-followups-to-author t]
- ["Permanently raise score with current subject"
- gnus-summary-raise-by-subject t]
- ["Permanently raise score with current author"
- gnus-summary-raise-by-author t]
- ["Permanently raise score with current crossposting"
- gnus-summary-raise-by-xref t]
- ["Permanently raise score for followups to current author"
- gnus-summary-raise-followups-to-author t]
- ["Lower score with current subject"
- gnus-summary-temporarily-lower-by-subject t]
- ["Lower score with current author"
- gnus-summary-temporarily-lower-by-author t]
- ["Lower score with current thread"
- gnus-summary-temporarily-lower-by-thread t]
- ["Lower score with current crossposting"
- gnus-summary-temporarily-lower-by-xref t]
- ["Lower score for followups to current author"
- gnus-summary-temporarily-lower-followups-to-author t]
- ["Permanently lower score with current subject"
- gnus-summary-lower-by-subject t]
- ["Permanently lower score with current author"
- gnus-summary-lower-by-author t]
- ["Permanently lower score with current crossposting"
- gnus-summary-lower-by-xref t]
- ["Permanently lower score for followups to current author"
- gnus-summary-lower-followups-to-author t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t])
))
)
(save-excursion
(let* ((beg (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point)))
- (to (max 1 (1- (or (previous-single-property-change
- end 'mouse-face nil beg) end))))
- (from (1+ (or (next-single-property-change
- beg 'mouse-face nil end) beg))))
+ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
+ (from (if (get-text-property beg 'mouse-face)
+ beg
+ (next-single-property-change
+ beg 'mouse-face nil end)))
+ (to (next-single-property-change
+ from 'mouse-face nil end)))
(if (< to beg)
(progn
(setq from beg)
("fetch parent" . gnus-summary-refer-parent-article)
"mail"
("move" . gnus-summary-move-article)
+ ("copy" . gnus-summary-copy-article)
+ ("respool" . gnus-summary-respool-article)
"threads"
("lower" . gnus-summary-lower-thread)
("kill" . gnus-summary-kill-thread)
(defvar gnus-carpal-button-face 'bold
"*Face used on carpal buttons.")
+(defvar gnus-carpal-header-face 'bold-italic
+ "*Face used on carpal buffer headers.")
+
(defvar gnus-carpal-mode-map nil)
(put 'gnus-carpal-mode 'mode-class 'special)
(setq button (car buttons)
buttons (cdr buttons))
(if (stringp button)
- (insert button " ")
+ (set-text-properties
+ (point)
+ (prog2 (insert button) (point) (insert " "))
+ (list 'face gnus-carpal-header-face))
(set-text-properties
(point)
- (progn (insert (car button)) (point))
+ (prog2 (insert (car button)) (point) (insert " "))
(list 'gnus-callback (cdr button)
'face gnus-carpal-button-face
- 'mouse-face 'highlight))
- (insert " ")))
+ 'mouse-face 'highlight))))
(let ((fill-column (- (window-width) 2)))
(fill-region (point-min) (point-max)))
(set-window-point (get-buffer-window (current-buffer))
(goto-char (match-beginning 0))
(let* ((from (point))
(entry (gnus-button-entry))
- (start (match-beginning (nth 1 entry)))
- (end (match-end (nth 1 entry)))
+ (start (and entry (match-beginning (nth 1 entry))))
+ (end (and entry (match-end (nth 1 entry))))
(form (nth 2 entry))
marker)
- (goto-char (match-end 0))
- (if (eval form)
- (gnus-article-add-button start end 'gnus-button-push
- (set-marker (make-marker)
- from))))))))
+ (if (not entry)
+ ()
+ (goto-char (match-end 0))
+ (if (eval form)
+ (gnus-article-add-button start end 'gnus-button-push
+ (set-marker (make-marker)
+ from)))))))))
;;; External functions:
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-mail folder)))
-(defun gnus-mail-forward-using-vm ()
+(defun gnus-mail-forward-using-vm (&optional buffer)
"Forward the current message to another user using vm."
- (let ((gnus-buffer (current-buffer))
+ (let ((gnus-buffer (or buffer (current-buffer)))
(subject (concat "[" gnus-newsgroup-name "] "
(or (gnus-fetch-field "Subject") ""))))
(or (featurep 'win-vm)
(require 'mail-utils)
(require 'timezone)
(require 'nnheader)
-(require 'gnus-ems)
;; Site dependent variables. These variables should be defined in
;; paths.el.
If this variable contains a function, this function will be called
with the current newsgroup name as the argument. The function should
return a string.
+
In any case, if the string (either in the variable, in the environment
variable, or returned by the function) is a file name, the contents of
this file will be used as the organization.")
(defvar gnus-group-default-list-level gnus-level-subscribed
"*Default listing level.")
-(defvar gnus-group-always-list-unread gnus-level-subscribed
- "*Always list groups less than this variable with unread articles.
-If nil, use parameter to specify.")
+(defvar gnus-group-use-permanent-levels nil
+ "*If non-nil, once you set a level, Gnus will use this level.")
(defvar gnus-show-mime nil
"*If non-ni, do mime processing of articles.
(defvar gnus-override-method nil)
(defvar gnus-article-check-size nil)
+(defvar gnus-current-score-file nil)
(defvar gnus-current-move-group nil)
(defvar gnus-newsgroup-dependencies nil)
(defvar gnus-newsgroup-adaptive nil)
+(defvar gnus-summary-display-table nil)
+
(defconst gnus-group-line-format-alist
(list (list ?M 'marked ?c)
(list ?S 'subscribed ?c)
(list ?z 'score-char ?c)
(list ?U 'unread ?c)
(list ?t '(gnus-summary-number-of-articles-in-thread
- (or gnus-tmp-adopt-thread
+ (or (prog1 gnus-tmp-adopt-thread
+ (setq gnus-tmp-adopt-thread nil))
(if (boundp 'thread) (symbol-value 'thread)
thread nil)))
?d)
(defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)"
"The mail address of the Gnus maintainer.")
-(defconst gnus-version "(ding) Gnus v0.72"
+(defconst gnus-version "(ding) Gnus v0.73"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(autoload 'gnus-score-adaptive "gnus-score")
(autoload 'gnus-score-remove-lines-adaptive "gnus-score")
(autoload 'gnus-possibly-score-headers "gnus-score")
+ (autoload 'gnus-score-find-trace "gnus-score")
;; gnus-uu
(autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap)
(point)
(goto-char p))))
+;;; Load the compatability functions.
+
+(require 'gnus-ems)
+
\f
;;;
;;; Gnus Utility Functions
(if (and (listp (car hor))
(eq (car (car hor)) 'horizontal))
(progn
- (split-window nil (floor (* (frame-width) (nth 1 (car hor)))) t)
+ (split-window nil (- (frame-width)
+ (floor (* (frame-width) (nth 1 (car hor)))))
+ t)
(setq hor (cdr hor))))
;; Go through the rules and eval the elements that are to be
(pop-to-buffer "*Gnus Bug*")
(erase-buffer)
(mail-mode)
- (mail-setup gnus-maintainer "[Gnus Bug Report] " nil nil nil nil)
+ (mail-setup gnus-maintainer nil nil nil nil nil)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(goto-char (point-min))
(switch-to-buffer gnus-group-buffer)
(gnus-group-get-new-news))
(gnus-clear-system)
+ (nnheader-init-server-buffer)
(gnus-read-init-file)
(let ((level (and arg (numberp arg) (> arg 0) arg))
did-connect)
(run-hooks 'gnus-startup-hook)
;; NNTP server is successfully open.
(gnus-update-format-specifications)
+ (gnus-summary-make-display-table)
(let ((buffer-read-only nil))
(erase-buffer)
(if (not gnus-inhibit-startup-message)
If argument UNREAD is non-nil, groups with no unread articles are also listed."
(interactive (list (and current-prefix-arg
(prefix-numeric-value current-prefix-arg))))
- (setq level (or level gnus-group-default-list-level gnus-level-subscribed))
+ (if gnus-group-use-permanent-levels
+ (progn
+ (setq gnus-group-default-list-level
+ (or level gnus-group-default-list-level))
+ (setq level (or gnus-group-default-list-level gnus-level-subscribed)))
+ (setq level (or level gnus-group-default-list-level
+ gnus-level-subscribed)))
(gnus-group-setup-buffer) ;May call from out of group buffer
(let ((case-fold-search nil)
(group (gnus-group-group-name)))
ticked)
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up; non-active group")
- ;; Do the updating only if the newsgroup isn't killed
+ ;; Do the updating only if the newsgroup isn't killed.
(if entry
(progn
(setq ticked (if all nil (cdr (assq 'tick marked))))
(interactive "P")
(run-hooks 'gnus-get-new-news-hook)
(let ((level arg))
+ (if gnus-group-use-permanent-levels
+ (progn
+ (if level
+ (setq gnus-group-default-list-level level)
+ (setq level (or gnus-group-default-list-level
+ gnus-level-subscribed)))))
(if (and gnus-read-active-file (not level))
(progn
(gnus-read-active-file)
(gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
(let ((gnus-read-active-file nil))
(gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))))
- (gnus-group-list-groups
- (or gnus-group-always-list-unread level gnus-level-subscribed)
- gnus-have-all-newsgroups)))
+ (gnus-group-list-groups (or (and gnus-group-use-permanent-levels level)
+ gnus-level-subscribed)
+ gnus-have-all-newsgroups)))
(defun gnus-group-get-new-news-this-group (n)
"Check for newly arrived news in the current group (and the N-1 next groups).
(setq truncate-lines t)
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
+ (setq buffer-display-table gnus-summary-display-table)
+ (run-hooks 'gnus-summary-mode-hook))
+
+(defun gnus-summary-make-display-table ()
;; Change the display table. Odd characters have a tendency to mess
- ;; up nicely formatted displays.
- (setq buffer-display-table (if (vectorp standard-display-table)
- (copy-sequence standard-display-table)
- (make-vector 261 nil)))
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (setq gnus-summary-display-table
+ (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ ;; Nix out all the control chars...
(let ((i 32))
(while (>= (setq i (1- i)) 0)
- (aset buffer-display-table i [??])))
- (aset buffer-display-table ?\n nil)
- (let ((i 160))
+ (aset gnus-summary-display-table i [??])))
+ ;; ... but not newline, of course.
+ (aset gnus-summary-display-table ?\n nil)
+ ;; We nix out any glyphs over 126 that are not set already.
+ (let ((i 256))
(while (>= (setq i (1- i)) 127)
- (aset buffer-display-table i [??])))
- (run-hooks 'gnus-summary-mode-hook))
+ ;; Only modify if the entry is nil.
+ (or (aref gnus-summary-display-table i)
+ (aset gnus-summary-display-table i [??])))))
(defun gnus-summary-clear-local-variables ()
(let ((locals gnus-summary-local-variables))
(let ((name gnus-newsgroup-name)
(marked gnus-newsgroup-marked)
(unread gnus-newsgroup-unreads)
- (headers gnus-current-headers))
+ (headers gnus-current-headers)
+ (score-file gnus-current-score-file))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name)
(setq gnus-newsgroup-marked marked)
(setq gnus-newsgroup-unreads unread)
- (setq gnus-current-headers headers))))))
+ (setq gnus-current-headers headers)
+ (setq gnus-current-score-file score-file))))))
(defun gnus-summary-insert-dummy-line (sformat subject number)
(if (not sformat)
(kill-buffer (current-buffer))
(set-buffer gnus-group-buffer)
(gnus-group-next-unread-group 1)))
+ (message "Can't select group")
nil)
((eq did-select 'quit)
(and (eq major-mode 'gnus-summary-mode)
;; This newsgroup is empty.
(gnus-summary-catchup-and-exit nil t) ;Without confirmations.
(gnus-message 6 "No unread news")
- (gnus-kill-buffer kill-buffer))
+ (gnus-kill-buffer kill-buffer)
+ nil)
(save-excursion
(if kill-buffer
(let ((gnus-summary-buffer kill-buffer))
(funcall gnus-asynchronous-article-function
gnus-newsgroup-threads)
gnus-newsgroup-threads)))
- (gnus-kill-buffer kill-buffer))))))
+ (gnus-kill-buffer kill-buffer))
+ t))))
(defun gnus-summary-prepare ()
;; Generate the summary buffer.
(if gnus-show-threads
(gnus-gather-threads
(gnus-sort-threads
- (if gnus-summary-expunge-below
+ (if (and gnus-summary-expunge-below
+ (not gnus-fetch-old-headers))
(gnus-make-threads-and-expunge)
(gnus-make-threads))))
gnus-newsgroup-headers)
;; Erase header retrieval message.
(gnus-summary-update-lines)
(message "")
+ ;; Remove the final newline.
+ ;;(goto-char (point-max))
+ ;;(delete-char -1)
;; Call hooks for modifying summary buffer.
;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
(goto-char (point-min))
(let ((hashtb (gnus-make-hashtable 1023))
(prev threads)
(result threads)
- thread subject hthread unre-subject whole-subject)
+ thread subject hthread whole-subject)
(while threads
- (setq subject (header-subject (car (car threads)))
- whole-subject subject)
- (and gnus-summary-gather-subject-limit
- (or (and (numberp gnus-summary-gather-subject-limit)
- (> (length subject) gnus-summary-gather-subject-limit)
- (setq subject
- (substring subject 0
- gnus-summary-gather-subject-limit)))
- (and (eq 'fuzzy gnus-summary-gather-subject-limit)
- (setq subject (gnus-simplify-subject-fuzzy subject)))))
+ (setq whole-subject
+ (setq subject (header-subject (car (car threads)))))
+ (if gnus-summary-gather-subject-limit
+ (or (and (numberp gnus-summary-gather-subject-limit)
+ (> (length subject) gnus-summary-gather-subject-limit)
+ (setq subject
+ (substring subject 0
+ gnus-summary-gather-subject-limit)))
+ (and (eq 'fuzzy gnus-summary-gather-subject-limit)
+ (setq subject (gnus-simplify-subject-fuzzy subject))))
+ (setq subject (gnus-simplify-subject-re subject)))
(if (setq hthread
- (gnus-gethash
- (setq unre-subject (gnus-simplify-subject-re subject))
- hashtb))
+ (gnus-gethash subject hashtb))
(progn
(or (stringp (car (car hthread)))
(setcar hthread (list whole-subject (car hthread))))
(list (car threads))))
(setcdr prev (cdr threads))
(setq threads prev))
- (gnus-sethash unre-subject threads hashtb))
+ (gnus-sethash subject threads hashtb))
(setq prev threads)
(setq threads (cdr threads)))
result)))
;; `gnus-get-newsgroup-headers' and builds the trees. First we go
;; through the dependecies in the hash table and finds all the
;; roots. Roots do not refer back to any valid articles.
- (let (roots)
+ (let ((default (or gnus-summary-default-score 0))
+ (below gnus-summary-expunge-below)
+ roots article)
(and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
(gnus-build-old-threads))
(mapatoms
(lambda (refs)
(if (not (car (symbol-value refs)))
- (if (and gnus-summary-expunge-below
- (not gnus-fetch-old-headers))
- (let ((headers (cdr (symbol-value refs))))
- (while headers
- (if (not (< (or (cdr (assq (header-number (car headers))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-expunge-below))
- (setq roots (cons (car headers) roots))
- (setq gnus-newsgroup-unreads
- (delq (header-number (car headers))
- gnus-newsgroup-unreads)))
- (setq headers (cdr headers))))
- (setq roots (append (cdr (symbol-value refs)) roots)))
+ ;; These articles do not refer back to any other articles -
+ ;; they are roots.
+ (let ((headers (cdr (symbol-value refs))))
+ ;; We weed out the low-scored articles.
+ (while headers
+ (if (not (< (or (cdr (assq (header-number (car headers))
+ gnus-newsgroup-scored)) default)
+ below))
+ ;; It is over.
+ (setq roots (cons (car headers) roots))
+ ;; It is below, so we mark it as read.
+ (setq gnus-newsgroup-unreads
+ (delq (header-number (car headers))
+ gnus-newsgroup-unreads)))
+ (setq headers (cdr headers))))
;; Ok, these refer back to valid articles, but if
;; `gnus-thread-ignore-subject' is nil, we have to check that
;; the root has the same subject as its children. The children
(progn
(if (not (< (or (cdr (assq (header-number (car headers))
gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-expunge-below))
+ default) below))
(setq roots (cons (car headers) roots))
(setq gnus-newsgroup-unreads
(delq (header-number (car headers))
(setcdr prev (cdr headers)))
(setq prev headers))
(setq headers (cdr headers)))))
- (and gnus-summary-expunge-below
- (not gnus-fetch-old-headers)
- (let* ((prev (symbol-value refs))
- (headers (cdr prev))
- id)
- (while headers
- (if (not (< (or (cdr (assq (header-number (car headers))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-expunge-below))
- (setq prev (cdr prev))
- (setq gnus-newsgroup-unreads
- (delq (header-number (car headers))
- gnus-newsgroup-unreads))
- (setcdr prev (cdr headers))
- (setq id (gnus-gethash (header-id (car headers))
- gnus-newsgroup-dependencies))
- (let ((h (cdr id)))
- (while h
- (if (not (< (or (cdr (assq (header-number (car h))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-expunge-below))
- (setq roots (cons (car h) roots)))
- (setq h (cdr h)))))
- (setq headers (cdr headers)))))))
+ ;; If this article is expunged, some of the children might be
+ ;; roots.
+ (if (< (or (cdr (assq (header-number (car (symbol-value refs)))
+ gnus-newsgroup-scored)) default)
+ below)
+ (let* ((prev (symbol-value refs))
+ (headers (cdr prev)))
+ (while headers
+ (setq article (header-number (car headers)))
+ (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
+ default) below))
+ (progn (setq roots (cons (car headers) roots))
+ (setq prev headers))
+ (setq gnus-newsgroup-unreads
+ (delq article gnus-newsgroup-unreads))
+ (setcdr prev (cdr headers)))
+ (setq headers (cdr headers))))
+ ;; It was not expunged, but we look at expunged children.
+ (let* ((prev (symbol-value refs))
+ (headers (cdr prev))
+ article id)
+ (while headers
+ (setq article (header-number (car headers)))
+ (if (not (< (or (cdr (assq article gnus-newsgroup-scored))
+ default) below))
+ (setq prev headers)
+ (setq gnus-newsgroup-unreads
+ (delq article gnus-newsgroup-unreads))
+ (setcdr prev (cdr headers)))
+ (setq headers (cdr headers)))))))
gnus-newsgroup-dependencies)
-
+
(mapcar 'gnus-trim-thread
(apply 'append
(mapcar 'gnus-cut-thread
;; The header is a dummy root.
(cond ((eq gnus-summary-make-false-root 'adopt)
;; We let the first article adopt the rest.
- (let ((gnus-tmp-adopt-thread thread))
+ (let ((gnus-tmp-adopt-thread (list (cdr thread))))
(gnus-summary-prepare-threads (list (car (cdr thread))) 0))
(setq thread (cdr (cdr thread)))
(while thread
(setq clevel 1))
((eq gnus-summary-make-false-root 'empty)
;; We print the articles with empty subject fields.
- (let ((gnus-tmp-adopt-thread thread))
+ (let ((gnus-tmp-adopt-thread (list (cdr thread))))
(gnus-summary-prepare-threads (list (car (cdr thread))) 0))
(setq thread (cdr (cdr thread)))
(while thread
(setq ids (cdr ids)))))
;; Update expirable articles.
(gnus-add-marked-articles nil 'expirable exps info)
- (and (null (nth 2 info))
+ (and active
+ (null (nth 2 info))
(> (car active) 1)
(setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
(setcar (nthcdr 2 info)
(defsubst gnus-header-value ()
(buffer-substring (match-end 0) (gnus-point-at-eol)))
+(defvar gnus-newsgroup-none-id 0)
+
(defun gnus-get-newsgroup-headers ()
(setq gnus-article-internal-prepare-hook nil)
(let ((cur nntp-server-buffer)
(dependencies gnus-newsgroup-dependencies)
- (none-id 0)
headers char article id dep end)
(save-excursion
(set-buffer nntp-server-buffer)
;; subsequent routines simpler.
(header-set-id
header
- (setq id (concat "none+" (int-to-string
- (setq none-id (1+ none-id)))))))
+ (setq id (concat "none+"
+ (int-to-string
+ (setq gnus-newsgroup-none-id
+ (1+ gnus-newsgroup-none-id)))))))
(goto-char p)
(if (search-forward "\nreferences: " nil t)
(progn
'(prog1
(if (= (following-char) ?\t)
0
- (let ((num (read buffer)))
+ (let ((num (condition-case nil (read buffer) (error nil))))
(if (numberp num) num 0)))
(or (eobp) (forward-char 1))))
(and info active
(gnus-sorted-complement
(gnus-uncompress-range active)
- (gnus-list-of-unread-articles (nth 2 info))))))
+ (gnus-list-of-unread-articles group)))))
;; Various summary commands
(progn
(set-buffer (setq gnus-summary-buffer sumbuf))
(gnus-summary-exit-no-update t))))
- (gnus-summary-read-group group nil no-article buf)
- (while (and (string= gnus-newsgroup-name ingroup)
- (bufferp sumbuf) (buffer-name sumbuf))
- (set-buffer gnus-group-buffer)
- (gnus-summary-read-group
- (gnus-group-group-name) nil no-article buf)))))))
+ (let ((prevgroup group))
+ (gnus-summary-read-group group nil no-article buf)
+ (while (and (string= gnus-newsgroup-name ingroup)
+ (bufferp sumbuf)
+ (buffer-name sumbuf)
+ (not (string= prevgroup (gnus-group-group-name))))
+ (set-buffer gnus-group-buffer)
+ (gnus-summary-read-group
+ (setq prevgroup (gnus-group-group-name))
+ nil no-article buf))
+ (and (string= prevgroup (gnus-group-group-name))
+ ;; We have reached the final group in the group
+ ;; buffer.
+ (progn
+ (set-buffer sumbuf)
+ (gnus-summary-exit)))))))))
(defun gnus-summary-prev-group (no-article)
"Exit current newsgroup and then select previous unread newsgroup.
(goto-char (point-min))
(while (and (not (eq (car (get-text-property (point) 'gnus)) article))
(zerop (forward-line 1))))
+ (gnus-summary-show-thread)
;; Skip dummy articles.
(if (eq (gnus-summary-article-mark) ?Z)
(forward-line 1))
(if (null article)
nil
(gnus-article-prepare article all-header)
+ (gnus-summary-show-thread)
(if (eq (gnus-summary-article-mark) ?Z)
(progn
(forward-line 1)
(gnus-summary-goto-subject article)
;; Successfully display article.
(gnus-summary-update-line)
- (let ((bookmark (cdr (assq article gnus-newsgroup-bookmarks))))
- (set-window-start
- (get-buffer-window gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (cond (bookmark
- (gnus-message 6 "Moved to bookmark")
- (search-forward "\n\n" nil t)
- (forward-line bookmark)
- (point))
- (t
- (point-min))))))
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))
t))
(defun gnus-summary-select-article (&optional all-headers force pseudo article)
(if all-headers (gnus-article-show-all-headers))
(gnus-configure-windows 'article)
nil))
- (if (not did)
- ()
- (let ((bookmark (cdr (assq article gnus-newsgroup-bookmarks))))
- (set-window-start
- (get-buffer-window gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (cond (bookmark
- (gnus-message 6 "Moved to bookmark")
- (search-forward "\n\n" nil t)
- (forward-line bookmark)
- (point))
- (t
- (point-min))))))))))
+ (if did (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))))))
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
"Show previous page of selected article.
Argument LINES specifies lines to be scrolled down."
(interactive "P")
+ (gnus-set-global-variables)
(let ((article (gnus-summary-article-number)))
(if (or (null gnus-current-article)
(null gnus-article-current)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative)."
(interactive "p")
+ (gnus-set-global-variables)
(or (gnus-summary-select-article nil nil 'pseudo)
(gnus-eval-in-buffer-window
gnus-article-buffer
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-next-article nil (gnus-summary-subject-string)))
(defun gnus-summary-prev-same-subject ()
"Select previous article which has the same subject as current one."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-prev-article nil (gnus-summary-subject-string)))
(defun gnus-summary-next-unread-same-subject ()
"Select next unread article which has the same subject as current one."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-next-article t (gnus-summary-subject-string)))
(defun gnus-summary-prev-unread-same-subject ()
"Select previous unread article which has the same subject as current one."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-prev-article t (gnus-summary-subject-string)))
(defun gnus-summary-first-unread-article ()
"Select the first unread article.
Return nil if there are no unread articles."
(interactive)
+ (gnus-set-global-variables)
(prog1
(if (gnus-summary-first-subject t)
(gnus-summary-display-article (gnus-summary-article-number)))
(setq number (header-number gnus-current-headers))
(gnus-rebuild-thread message-id)
(gnus-summary-goto-subject number)
+ (gnus-article-set-window-start
+ (cdr (assq number gnus-newsgroup-bookmarks)))
message-id)
(gnus-message 1 "No such references")
nil))))))
(gnus-summary-select-article)
;; We do not want a narrowed article.
(gnus-summary-stop-page-breaking)
- (let ((name (format "%s/%d"
+ (let ((name (format "%s-%d"
(gnus-group-prefixed-name
gnus-newsgroup-name (list 'nndigest ""))
gnus-current-article))
(interactive "p")
;; Skip dummy header line.
(save-excursion
+ (gnus-summary-show-thread)
(if (eq (gnus-summary-article-mark) ?Z)
(forward-line 1))
(let ((buffer-read-only nil))
(let ((buffer-read-only nil))
(if (gnus-summary-goto-subject article)
(progn
+ (gnus-summary-show-thread)
(and (eq (gnus-summary-article-mark) ?Z)
(forward-line 1))
(gnus-summary-update-mark gnus-process-mark 'replied)
(let ((buffer-read-only nil))
(if (gnus-summary-goto-subject article)
(progn
+ (gnus-summary-show-thread)
(and (eq (gnus-summary-article-mark) ?Z)
(forward-line 1))
(gnus-summary-update-mark ? 'replied)
(if (gnus-summary-goto-subject article)
(let ((buffer-read-only nil))
(gnus-summary-show-thread)
- (beginning-of-line)
(and (eq (gnus-summary-article-mark) ?Z)
(forward-line 1))
;; Fix the mark.
(gnus-add-current-to-buffer-list)
(gnus-article-mode))))
+;; Set article window start at LINE, where LINE is the number of lines
+;; from the head of the article.
+(defun gnus-article-set-window-start (&optional line)
+ (set-window-start
+ (get-buffer-window gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (if (not line)
+ (point-min)
+ (gnus-message 6 "Moved to bookmark")
+ (search-forward "\n\n" nil t)
+ (forward-line line)
+ (point)))))
+
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(setq group (or group gnus-newsgroup-name))
(not (not (or all-headers gnus-show-all-headers))))
;; Hooks for getting information from the article.
;; This hook must be called before being narrowed.
- (run-hooks 'internal-hook)
- (run-hooks 'gnus-article-prepare-hook)
+ (let (buffer-read-only)
+ (run-hooks 'internal-hook)
+ (run-hooks 'gnus-article-prepare-hook))
;; Decode MIME message.
(if (and gnus-show-mime
(gnus-fetch-field "Mime-Version"))
(funcall gnus-show-mime-method))
;; Perform the article display hooks.
- (let ((buffer-read-only nil))
+ (let (buffer-read-only)
(run-hooks 'gnus-article-display-hook))
;; Do page break.
(goto-char (point-min))
;; Remove any negative articles numbers.
(while (and unread (< (car unread) 0))
(setq unread (cdr unread)))
+ ;; Remove any expired article numbers
+ (while (and unread (< (car unread) (car active)))
+ (setq unread (cdr unread)))
+ (while (and ticked (< (car ticked) (car active)))
+ (setq ticked (cdr ticked)))
+ (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)
(defun gnus-make-articles-unread (group articles)
"Mark ARTICLES in GROUP as unread."
- (let ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash (gnus-group-real-name group)
- gnus-newsrc-hashtb)))))
- (setcar (nthcdr 2 info)
- (gnus-remove-from-range (nth 2 info) articles))
- (gnus-group-update-group group t)))
+ (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-gethash (gnus-group-real-name group)
+ gnus-newsrc-hashtb))))
+ (ranges (nth 2 info))
+ news)
+ (while articles
+ (and (gnus-member-of-range (car articles) ranges)
+ (setq news (cons (car articles) news)))
+ (setq articles (cdr articles)))
+ (if (not news)
+ ()
+ (setcar (nthcdr 2 info)
+ (gnus-remove-from-range (nth 2 info) (nreverse news)))
+ (gnus-group-update-group group t))))
(defun gnus-read-active-file ()
"Get active file from NNTP server."
(let ((nnmail-split-methods
(if (stringp group) (list (list group ""))
nnmail-split-methods)))
- (setq result (nnbabyl-save-mail)))
+ (setq result (car (nnbabyl-save-mail))))
(set-buffer nnbabyl-mbox-buffer)
(goto-char (point-max))
(search-backward "\n\^_")
(defun nnbabyl-article-string (article)
(concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
- (int-to-string article)))
+ (int-to-string article) " "))
+
+(defun nnbabyl-insert-lines ()
+ "Insert how many lines and chars there are in the body of the mail."
+ (let (lines chars)
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (progn
+ ;; There may be an EOOH line here...
+ (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
+ (search-forward "\n\n" nil t))
+ (setq chars (- (point-max) (point)))
+ (setq lines (- (count-lines (point) (point-max)) 1))
+ ;; Move back to the end of the headers.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (save-excursion
+ (if (re-search-backward "^Lines: " nil t)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (insert (format "Lines: %d\n" lines))
+ chars)))))
(defun nnbabyl-save-mail ()
;; Called narrowed to an article.
(let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
- (nnmail-insert-lines)
+ (nnbabyl-insert-lines)
(nnmail-insert-xref group-art)
(nnbabyl-insert-newsgroup-line group-art)
(run-hooks 'nnbabyl-prepare-save-mail-hook)
(goto-char (point-min))
;; If there is a C-l at the beginning of the narrowed region, this
;; isn't really a "save", but rather a "scan".
+ (while (looking-at "From ")
+ (replace-match "Mail-from: From " t t)
+ (forward-line 1))
+ (goto-char (point-min))
(or (looking-at "\^L")
(save-excursion
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
(goto-char (point-max))
(insert "\^_\n")))
- (while (looking-at "From ")
- (replace-match "Mail-from: " t t)
- (forward-line 1))
(if (search-forward "\n\n" nil t)
(progn
(forward-char -1)
(point)
(or (and (re-search-forward nndigest-separator nil t)
(match-beginning 0))
+ (and (re-search-forward "^------------------------------" nil t)
+ (match-beginning 0))
(point-max)))
(cons (point-min) (point-max)))
nil)))
"Go through the entire INCOMING file and pick out each individual mail.
FUNC will be called with the buffer narrowed to each mail."
(let ((delim (concat "^" rmail-unix-mail-delimiter))
- start end)
+ start end content-length do-search)
(save-excursion
(set-buffer (get-buffer-create " *nnmail incoming*"))
(buffer-disable-undo (current-buffer))
;; Skip all the headers in case there are more "From "s...
(if (not (search-forward "\n\n" nil t))
(forward-line 1))
+ ;; Look for a Content-Length header.
+ (if (not (save-excursion
+ (and (re-search-backward
+ "^Content-Length: \\([0-9]+\\)" nil t)
+ (setq content-length (int-to-string
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
+ ;; We destroy the header, since none of
+ ;; the backends ever use it, and we do not
+ ;; want to confuse other mailers by having
+ ;; a (possibly) faulty header.
+ (progn (insert "X-") t))))
+ (setq do-search t)
+ (if (save-excursion
+ (forward-char content-length)
+ (looking-at delim))
+ (progn
+ (forward-char content-length)
+ (setq do-search nil))
+ (setq do-search t)))
;; Go to the beginning of the next article - or to the end
;; of the buffer.
- (if (re-search-forward delim nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max)))
+ (if do-search
+ (if (re-search-forward delim nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))))
(save-excursion
(save-restriction
(narrow-to-region start (point))
;; Find the lowest active article in this group.
(let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
(goto-char (point-min))
- (while (not (search-forward
- (nnmbox-article-string (car active)) nil t))
+ (while (and (not (search-forward
+ (nnmbox-article-string (car active)) nil t))
+ (<= (car active) (cdr active)))
(setcar active (1+ (car active)))
(goto-char (point-min))))
(nnmail-save-active nnmbox-group-alist nnmbox-active-file)
(setq nnmh-group-alist (nnmail-get-active))
;; We trick the choosing function into believing that only one
;; group is availiable.
- (let ((nnmail-split-methods '(group "")))
- (cons group (nnmh-save-mail))))
+ (let ((nnmail-split-methods (list (list group ""))))
+ (car (nnmh-save-mail))))
(and
(nnmh-request-list)
(setq nnmh-group-alist (nnmail-get-active))
- (nnmh-save-mail))))
+ (car (nnmh-save-mail)))))
(defun nnmh-request-replace-article (article group buffer)
(nnmh-possibly-change-directory group)
(nnml-possibly-change-directory group)
(let ((articles (mapcar
(lambda (file)
- (int-to-string file))
+ (string-to-int file))
(directory-files
nnml-current-directory nil "^[0-9]+$"))))
(and articles
nnspool-inews-program nnspool-inews-switches)))
(set-process-sentinel proc 'nnspool-inews-sentinel)
(process-send-region proc (point-min) (point-max))
- (process-send-eof proc)
+ ;; We slap a condition-case around this, because the process may
+ ;; have exited already...
+ (condition-case nil
+ (process-send-eof proc)
+ (error nil))
t)))
(defun nnspool-inews-sentinel (proc status)
(let ((first (car articles))
(last (progn (while (cdr articles) (setq articles (cdr articles)))
(car articles))))
- (call-process "sed" nil t nil "-e"
- (format "1,/^%d\t/d\n/^%d\t/,$d"
- (1- first) (1+ last)) file)))
+ (call-process "awk" nil t nil
+ (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
+ (1- first) (1+ last))
+ file)))
(defun nnspool-find-article-by-message-id (id)
"Return full pathname of an article identified by message-ID."
nil))))
(defun nnvirtual-close-group (group &optional server)
- (nnvirtual-possibly-change-newsgroups group server t)
- (nnvirtual-update-marked)
- (setq nnvirtual-current-group nil
- nnvirtual-current-groups nil
- nnvirtual-current-mapping nil)
- (setq nnvirtual-group-alist
- (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist)))
+ (if (not nnvirtual-current-group)
+ ()
+ (nnvirtual-possibly-change-newsgroups group server t)
+ (nnvirtual-update-marked)
+ (setq nnvirtual-current-group nil
+ nnvirtual-current-groups nil
+ nnvirtual-current-mapping nil)
+ (setq nnvirtual-group-alist
+ (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist))))
(defun nnvirtual-request-list (&optional server)
(setq nnvirtual-status-string "nnvirtual: LIST is not implemented.")
(fset 'nnvirtual-request-post 'nntp-request-post)
-(fset 'nnvirtual-request-post-buffer 'nntp-request-post-buffer)
+(defun nnvirtual-request-post-buffer
+ (post group subject header article-buffer info follow-to respect-poster)
+ (nntp-request-post-buffer post "" subject header article-buffer
+ info follow-to respect-poster))
\f
;;; Internal functions.
projects / gnus / commitdiff