+Sat Apr 20 00:20:09 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+
+ * nntp.el (nntp-server-opened-hook): Use the default.
+
+Sat Apr 20 01:58:15 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nntp.el (nntp-open-server-semi-internal): Don't call
+ `cancel-timer' under XEmacs.
+
+Fri Apr 19 23:20:52 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+
+ * gnus.el (gnus-ask-server-for-new-groups): Would call with wrong
+ hashtb.
+
+Fri Apr 19 20:42:16 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * gnus.el (gnus-article-hide-headers): Use message sorting.
+
+ * message.el (message-required-mail-headers): Changed sequence.
+ (message-sort-headers-1): New function.
+ (message-sort-headers): New command.
+
+ * nnheader.el (nnheader-change-server-old): Removed.
+ (nnheader-file-error): New function.
+
+ * nnspool.el (nnspool-request-list): Give a better error message.
+
+ * message.el (message-use-followup-to): Doc fix.
+
+ * gnus.el (gnus-summary-read-group): Dont limit unthreaded
+ groups.
+
+Fri Apr 19 15:05:19 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-setup): Don't generate headers first.
+
+ * nnmail.el (nnmail-message-id): Use message.
+
Thu Apr 18 20:10:11 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+ * gnus.el: September Gnus v0.75 is released.
+
* gnus.el (gnus-summary-show-article): Stop page breaking when
given a prefix.
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.75"
+(defconst gnus-version "September Gnus v0.76"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(when gnus-build-sparse-threads
(gnus-build-sparse-threads))
;; Find the initial limit.
- (if show-all
- (let ((gnus-newsgroup-dormant nil))
+ (if gnus-show-threads
+ (if show-all
+ (let ((gnus-newsgroup-dormant nil))
+ (gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- (gnus-summary-initial-limit show-all))
+ (setq gnus-newsgroup-limit
+ (mapcar
+ (lambda (header) (mail-header-number header))
+ gnus-newsgroup-headers)))
;; Generate the summary buffer.
(unless no-display
(gnus-summary-prepare))
(let (header number mark)
(while headers
- (setq header (car headers)
- headers (cdr headers)
- number (mail-header-number header))
-
;; We may have to root out some bad articles...
- (when (memq number gnus-newsgroup-limit)
+ (when (memq (setq number (mail-header-number
+ (setq header (pop headers))))
+ gnus-newsgroup-limit)
+ ;; Mark article as read when it has a low score.
(when (and gnus-summary-mark-below
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
(let ((buffer-read-only nil)
(props (nconc (list 'gnus-type 'headers)
gnus-hidden-properties))
+ (max (1+ (length gnus-sorted-header-list)))
(ignored (when (not (stringp gnus-visible-headers))
(cond ((stringp gnus-ignored-headers)
gnus-ignored-headers)
(beginning-of-line)
;; We add the headers we want to keep to a list and delete
;; them from the buffer.
- (if (or (and visible (looking-at visible))
- (and ignored (not (looking-at ignored))))
- (progn
- (push (buffer-substring
- (setq beg (point))
- (progn
- (forward-line 1)
- ;; Be sure to get multi-line headers...
- (re-search-forward "^[^ \t]*:" nil t)
- (beginning-of-line)
- (point)))
- want-list)
- (delete-region beg (point)))
- (forward-line 1)))
- ;; Sort the headers that we want to display.
- (setq want-list (sort want-list 'gnus-article-header-less))
- (goto-char (point-min))
- (while want-list
- (insert (pop want-list)))
- ;; We make the unwanted headers invisible.
- (if delete
- (delete-region (point-min) (point-max))
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (gnus-hide-text-type (point) (point-max) 'headers))))))))
-
-(defsubst gnus-article-header-rank (header)
+ (put-text-property
+ (point) (1+ (point)) 'message-rank
+ (if (or (and visible (looking-at visible))
+ (and ignored
+ (not (looking-at ignored))))
+ (gnus-article-header-rank)
+ (+ 2 max)))
+ (forward-line 1))
+ (message-sort-headers-1)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'message-rank (+ 2 max)))
+ ;; We make the unwanted headers invisible.
+ (if delete
+ (delete-region beg (point-max))
+ ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
+ (gnus-hide-text-type beg (point-max) 'headers)))))))))
+
+(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
(i 0))
(while list
- (when (string-match (car list) header)
+ (when (looking-at (car list))
(setq list nil))
(setq list (cdr list))
(incf i))
i))
-(defun gnus-article-header-less (h1 h2)
- "Say whether string H1 is \"less\" than string H2."
- (< (gnus-article-header-rank h1)
- (gnus-article-header-rank h2)))
-
(defun gnus-article-hide-boring-headers (&optional arg)
"Toggle hiding of headers that aren't very interesting.
If given a negative prefix, always show; if given a positive prefix,
(setq hashtb (gnus-make-hashtable 100))
(set-buffer nntp-server-buffer)
;; Enter all the new groups into a hashtable.
- (gnus-active-to-gnus-format method hashtb 'ignore)))
- ;; Now all new groups from `method' are in `hashtb'.
- (mapatoms
- (lambda (group-sym)
- (if (or (null (setq group (symbol-name group-sym)))
- (not (boundp group-sym))
- (null (symbol-value group-sym))
- (gnus-gethash group gnus-newsrc-hashtb)
- (member group gnus-zombie-list)
- (member group gnus-killed-list))
- ;; The group is already known.
- ()
- ;; Make this group active.
- (when (symbol-value group-sym)
- (gnus-set-active group (symbol-value group-sym)))
- ;; Check whether we want it or not.
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (if gnus-subscribe-hierarchical-interactive
- (push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
- hashtb)
+ (gnus-active-to-gnus-format method hashtb 'ignore))
+ ;; Now all new groups from `method' are in `hashtb'.
+ (mapatoms
+ (lambda (group-sym)
+ (if (or (null (setq group (symbol-name group-sym)))
+ (not (boundp group-sym))
+ (null (symbol-value group-sym))
+ (gnus-gethash group gnus-newsrc-hashtb)
+ (member group gnus-zombie-list)
+ (member group gnus-killed-list))
+ ;; The group is already known.
+ ()
+ ;; Make this group active.
+ (when (symbol-value group-sym)
+ (gnus-set-active group (symbol-value group-sym)))
+ ;; Check whether we want it or not.
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (if gnus-subscribe-hierarchical-interactive
+ (push group new-newsgroups)
+ (funcall gnus-subscribe-newsgroup-method group)))))))
+ hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
;;;###autoload
(defvar message-required-news-headers
- '(From Date Newsgroups Subject Message-ID
+ '(From Newsgroups Subject Date Message-ID
(optional . Organization) Lines
(optional . X-Newsreader))
"*Headers to be generated or prompted for when posting an article.
;;;###autoload
(defvar message-required-mail-headers
- '(From Date Subject (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . X-Mailer))
"*Headers to be generated or prompted for when mailing a message.
RFC822 required that From, Date, To, Subject and Message-ID be
;;;###autoload
(defvar message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
-If nil, ignore the header. If it is t, use its value, but ignore
-\"poster\". If it is the symbol `ask', query the user whether to
-ignore the \"poster\" value. If it is the symbol `use', always use
-the value.")
+If nil, ignore the header. If it is t, use its value, but query before
+using the \"poster\" value. If it is the symbol `ask', query the user
+whether to ignore the \"poster\" value. If it is the symbol `use',
+always use the value.")
(defvar gnus-post-method)
(defvar gnus-select-method)
(or (mail-fetch-field "to")
(mail-fetch-field "cc")
(mail-fetch-field "bcc")))))
+
+(defun message-next-header ()
+ "Go to the beginning of the next header."
+ (beginning-of-line)
+ (or (eobp) (forward-char 1))
+ (not (if (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))))
+(defun message-sort-headers-1 ()
+ "Sort the buffer as headers using `message-rank' text props."
+ (goto-char (point-min))
+ (sort-subr
+ nil 'message-next-header
+ (lambda ()
+ (message-next-header)
+ (unless (bobp)
+ (forward-char -1)))
+ (lambda ()
+ (or (get-text-property (point) 'message-rank)
+ 0))))
+
+(defun message-sort-headers ()
+ "Sort the headers of the current message according to `message-header-format-alist'."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (let ((max (1+ (length message-header-format-alist)))
+ rank)
+ (message-narrow-to-headers)
+ (while (re-search-forward "^[^ ]+:" nil t)
+ (put-text-property
+ (match-beginning 0) (1+ (match-beginning 0))
+ 'message-rank
+ (if (setq rank (length (memq (assq (intern (buffer-substring
+ (match-beginning 0)
+ (1- (match-end 0))))
+ message-header-format-alist)
+ message-header-format-alist)))
+ (- max rank)
+ (1+ max)))))
+ (message-sort-headers-1))))
+
\f
;;;
(when message-default-news-headers
(insert message-default-news-headers))
(when message-generate-headers-first
- (message-generate-headers message-required-news-headers)))
+ (message-generate-headers
+ (delq 'Lines
+ (copy-sequence message-required-news-headers)))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers))
(when message-generate-headers-first
- (message-generate-headers message-required-mail-headers)))
+ (message-generate-headers
+ (delq 'Lines
+ (copy-sequence message-required-mail-headers)))))
(message-insert-signature)
(message-set-auto-save-file-name)
(save-restriction
(cond
((equal (downcase followup-to) "poster")
(if (or (eq message-use-followup-to 'use)
- (yes-or-no-p "Use Followup-To \"poster\"? "))
+ (y-or-n-p "Use Followup-To \"poster\"? "))
(cons 'To (or reply-to from ""))
(cons 'Newsgroups newsgroups)))
(t
(if (or (equal followup-to newsgroups)
(not (eq message-use-followup-to 'ask))
- (yes-or-no-p
+ (y-or-n-p
(format "Use Followup-To %s? " followup-to)))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(setq case-fold-search t) ;Should ignore case.
t))
-;;; Virtual server functions.
-
-(defun nnheader-set-init-variables (server defs)
- (let ((s server)
- val)
- ;; First we set the server variables in the sequence required. We
- ;; use the definitions from the `defs' list where that is
- ;; possible.
- (while s
- (set (caar s)
- (if (setq val (assq (caar s) defs))
- (nth 1 val)
- (nth 1 (car s))))
- (setq s (cdr s)))
- ;; The we go through the defs list and set any variables that were
- ;; not set in the first sweep.
- (while defs
- (if (not (assq (caar defs) server))
- (set (caar defs)
- (if (and (symbolp (nth 1 (car defs)))
- (not (boundp (nth 1 (car defs)))))
- (nth 1 (car defs))
- (eval (nth 1 (car defs))))))
- (setq defs (cdr defs)))))
-
-(defun nnheader-save-variables (server)
- (let (out)
- (while server
- (push (list (caar server) (symbol-value (caar server))) out)
- (setq server (cdr server)))
- (nreverse out)))
-
-(defun nnheader-restore-variables (state)
- (while state
- (set (caar state) (nth 1 (car state)))
- (setq state (cdr state))))
-
-(defun nnheader-change-server-old (backend server defs)
- (nnheader-init-server-buffer)
- (let ((current-server (intern (format "%s-current-server" backend)))
- (alist (intern (format "%s-server-alist" backend)))
- (variables (intern (format "%s-server-variables" backend))))
-
- (when (and (symbol-value current-server)
- (not (equal server (symbol-value current-server))))
- (set alist
- (cons (list (symbol-value current-server)
- (nnheader-save-variables (symbol-value variables)))
- (symbol-value alist))))
- (let ((state (assoc server (symbol-value alist))))
- (if (not state)
- (nnheader-set-init-variables (symbol-value variables) defs)
- (nnheader-restore-variables (nth 1 state))
- (set alist (delq state (symbol-value alist)))))
- (set current-server server)
- t))
;;; Various functions the backends use.
+(defun nnheader-file-error (file)
+ "Return a string that says what is wrong with FILE."
+ (format
+ (cond
+ ((not (file-exists-p file))
+ "%s does not exist")
+ ((file-directory-p file)
+ "%s is a directory")
+ ((not (file-readable-p file))
+ "%s is not readable"))
+ file))
+
(defun nnheader-insert-head (file)
"Insert the head of the article."
(if (eq nnheader-max-head-length t)
(require 'rmail)
(require 'timezone)
(require 'sendmail)
+(require 'message)
(eval-when-compile (require 'cl))
(defvar nnmail-split-methods
t))
(defun nnmail-message-id ()
- (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
-
-(defvar nnmail-unique-id-char nil)
-
-(defun nnmail-number-base36 (num len)
- (if (if (< len 0) (<= num 0) (= len 0))
- ""
- (concat (nnmail-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-(defun nnmail-unique-id ()
- (setq nnmail-unique-id-char
- (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (if (fboundp 'current-time)
- (current-time) '(12191 46742 287898))))
- (concat
- (nnmail-number-base36 (+ (car tm)
- (lsh (% nnmail-unique-id-char 25) 16)) 4)
- (nnmail-number-base36 (+ (nth 1 tm)
- (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
+ (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
;;;
;;; nnmail duplicate handling
(deffoo nnspool-request-list (&optional server)
"List active newsgroups."
(save-excursion
- (nnspool-find-file nnspool-active-file)))
+ (or (nnspool-find-file nnspool-active-file)
+ (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
(deffoo nnspool-request-list-newsgroups (&optional server)
"List newsgroups (defined in NNTP2)."
(save-excursion
- (nnspool-find-file nnspool-newsgroups-file)))
+ (or (nnspool-find-file nnspool-newsgroups-file)
+ (nnheader-report 'nnspool (nnheader-file-error
+ nnspool-newsgroups-file)))))
(deffoo nnspool-request-list-distributions (&optional server)
"List distributions (defined in NNTP2)."
(save-excursion
- (nnspool-find-file nnspool-distributions-file)))
+ (or (nnspool-find-file nnspool-distributions-file)
+ (nnheader-report 'nnspool (nnheader-file-error
+ nnspool-distributions-file)))))
;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(deffoo nnspool-request-newgroups (date &optional server)
If you'd like to change something depending on the server in this
hook, use the variable `nntp-address'.")
-(defvoo nntp-server-opened-hook nil
+(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
"*Hook used for sending commands to the server at startup.
The default value is `nntp-send-mode-reader', which makes an innd
server spawn an nnrpd server. Another useful function to put in this
((fboundp 'start-itimer)
;; Not sure if this will work or not, only one way to
;; find out
- (eval '(start-itimer "nntp-timeout"
- (lambda ()
- (nntp-kill-command
- (nnoo-current-server 'nntp)))
- nntp-command-timeout nil))))))
+ (start-itimer "nntp-timeout"
+ (lambda ()
+ (nntp-kill-command
+ (nnoo-current-server 'nntp)))
+ nntp-command-timeout nil)))))
(nntp-retry-command t)
result)
(unwind-protect
t))))
result)
(when timer
- (cancel-timer timer)))))
+ (if (fboundp 'run-at-time)
+ (cancel-timer timer)
+ (delete-itimer timer))))))
(defun nntp-kill-command (server)
"Kill and restart the connection to SERVER."
(t ; We couldn't open the server.
(nnheader-report
'nntp (buffer-substring (point-min) (point-max)))))
- (and timer (cancel-timer timer))
+ (when timer
+ (if (fboundp 'run-at-time)
+ (cancel-timer timer)
+ (delete-itimer timer)))
(message "")
(unless status
(nnoo-close-server 'nntp server)
@node Writing New Backends
-@subsection Writing New Backends
+@subsubsection Writing New Backends
The various backends share many similarities. @code{nnml} is just like
@code{nnspool}, but it allows you to edit the articles on the server.
All the backends declare their public variables and functions by using a
package called @code{nnoo}.
-@menu
-* Declaring Backends:: An overview of the @code{nnoo} mechanisms.
-* An Example Backend:: A complete backend.
-@end menu
-
-
-@node Declaring Backends
-@subsubsection Declaring Backends
-
To inherit functions from other backends (and allow other backends to
inherit functions from the current backend), you should use the
following macros:
@end table
-
-@node An Example Backend
-@subsubsection An Example Backend
-
Below is a slightly shortened version of the @code{nndir} backend.
@lisp
projects / gnus / commitdiff