+Wed Jul 31 21:38:08 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-load.el (gnus-suppress-keymap): New function.
+
+Wed Jul 31 01:20:58 1996 Sudish Joseph <sudish@mindspring.com>
+
+ * gnus-picon.el (gnus-group-display-picons): Delete just the live
+ extents.
+
+Wed Jul 31 21:15:01 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el ((load)): Only eval splash when loading.
+
+ * gnus-group.el (gnus-group-quit): Always kill group buffer.
+
+ * nntp.el (nntp-open-connection): Escape errors.
+
+Wed Jul 31 16:09:22 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nnml.el (nnml-request-rename-group): Would move subgroups as
+ well.
+ * nnmh.el: Ditto.
+
+ * gnus-group.el (gnus-group-rename-group): Use current group name
+ as default.
+ (gnus-group-rename-group): Added doc string.
+
+ * gnus-sum.el (gnus-general-simplify-subject): Renamed.
+
+Wed Jul 31 16:05:06 1996 Paul Franklin <paul@transmeta.com>
+
+ * gnus-sum.el (gnus-pdf-simplify-subject): New version.
+
+Wed Jul 31 15:59:04 1996 Raja R. Harinath <harinath@cs.umn.edu>
+
+ * nntp.el (nntp-retrieve-headers-with-xover): `last' returns cdr.
+
+Wed Jul 31 15:18:33 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nntp.el (nntp-retrieve-headers-with-xover): Put the result in
+ the right buffer.
+ (nntp-request-body): Decode.
+
+ * gnus.el (gnus-no-server): Would bug out when gnus-start wasn't
+ loaded.
+
+ * gnus-art.el (gnus-article-edit-mode): New command.
+ (gnus-article-edit-mode-hook): New variable.
+ (gnus-article-edit-mode-map): New variable.
+
+Wed Jul 31 15:18:26 1996 François Pinard <pinard@progiciels-bpi.ca>
+
+ * gnus-art.el (gnus-article-edit-full-stops): New command.
+
+Wed Jul 31 13:03:48 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-sum.el (gnus-summary-edit-wash): New command and keystroke.
+
+ * message.el (message-sort-headers-1): Sort properly on totally
+ empty headers.
+
+ * article.el (article-hide-boring-headers): Didn't hide completely
+ empty headers.
+
+ * nntp.el (nntp-encode-text): Rescued.
+ (nntp-send-buffer): New function.
+ (nntp-request-post): New function.
+
+ * gnus-util.el (gnus-define-keys-safe): New macro.
+ (gnus-define-keys-1): Accept `safe' param.
+
+ * gnus-load.el (gnus-summary-mode-map): Define the main three
+ keymaps prematurely here.
+
+Wed Jul 31 12:48:23 1996 Steven L. Baur <steve@miranova.com>
+
+ * gnus-load.el (gnus-default-nntp-server): Moved.
+
+Wed Jul 31 03:15:02 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nndoc.el (nndoc-add-type): Remove old type definition.
+
+ * article.el: Changed variable names back to `gnus-'.
+
+Tue Jul 30 23:07:04 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * nntp.el (nntp-connection-alist): Define as oo.
+
+ * nndoc.el (nndoc-add-type): Wrong number of args.
+ (nndoc-set-delims): Free var.
+
+Tue Jul 30 23:02:51 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.1 is released.
+
Tue Jul 30 22:34:11 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* nntp.el (nntp-find-connection-buffer): New function.
(require 'gnus-util)
(require 'message)
-(defvar article-ignored-headers
+(defvar gnus-ignored-headers
"^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
"*All headers that match this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `article-visible-headers' is non-nil, this variable will be ignored.")
-(defvar article-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
+(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
"*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `article-ignored-headers' will be ignored.")
-(defvar article-sorted-header-list
+(defvar gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
"^Cc:" "^Date:" "^Organization:")
"*This variable is a list of regular expressions.
be placed first in the article buffer in the sequence specified by
this list.")
-(defvar article-boring-article-headers
+(defvar gnus-boring-article-headers
'(empty followup-to reply-to)
"*Headers that are only to be displayed if they have interesting data.
Possible values in this list are `empty', `newsgroups', `followup-to',
`reply-to', and `date'.")
-(defvar article-signature-separator "^-- *$"
- "Regexp matching signature separator.")
-
(defvar gnus-signature-separator "^-- *$"
"Regexp matching signature separator.")
-(defvar article-signature-limit nil
+(defvar gnus-signature-limit nil
"Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
that number. If it is a function, the function will be called without
buffer. If it is a string, it will be used as a regexp. If it
matches, the text in question is not a signature.")
-(defvar article-hidden-properties '(invisible t intangible t)
+(defvar gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text.")
-(defvar article-x-face-command
+(defvar gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
"String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command.")
-(defvar article-x-face-too-ugly nil
+(defvar gnus-article-x-face-too-ugly nil
"Regexp matching posters whose face shouldn't be shown automatically.")
-(defvar article-emphasis-alist
+(defvar gnus-emphasis-alist
'(("_\\(\\w+\\)_" 0 1 'underline)
("\\W\\(/\\(\\w+\\)/\\)\\W" 1 2 'italic)
("\\(_\\*\\|\\*_\\)\\(\\w+\\)\\(_\\*\\|\\*_\\)" 0 2 'bold-underline)
;;; Internal variables.
-(defvar article-inhibit-hiding nil)
+(defvar gnus-inhibit-hiding nil)
(defvar gnus-newsgroup-name)
(defsubst article-hide-text (b e props)
(defsubst article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
- (remove-text-properties b e article-hidden-properties)
- (when (memq 'intangible article-hidden-properties)
+ (remove-text-properties b e gnus-hidden-properties)
+ (when (memq 'intangible gnus-hidden-properties)
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
(defun article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
(article-hide-text
- b e (cons 'article-type (cons type article-hidden-properties))))
+ b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun article-unhide-text-type (b e type)
"Hide text of TYPE between B and E."
(remove-text-properties
- b e (cons 'article-type (cons type article-hidden-properties)))
- (when (memq 'intangible article-hidden-properties)
+ b e (cons 'article-type (cons type gnus-hidden-properties)))
+ (when (memq 'intangible gnus-hidden-properties)
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
(defsubst article-header-rank ()
"Give the rank of the string HEADER as given by `article-sorted-header-list'."
- (let ((list article-sorted-header-list)
+ (let ((list gnus-sorted-header-list)
(i 0))
(while list
(when (looking-at (car list))
;; Show boring headers as well.
(article-show-hidden-text 'boring-headers)
;; This function might be inhibited.
- (unless article-inhibit-hiding
+ (unless gnus-inhibit-hiding
(save-excursion
(save-restriction
(let ((buffer-read-only nil)
(props (nconc (list 'article-type 'headers)
- article-hidden-properties))
- (max (1+ (length article-sorted-header-list)))
- (ignored (when (not (stringp article-visible-headers))
- (cond ((stringp article-ignored-headers)
- article-ignored-headers)
- ((listp article-ignored-headers)
- (mapconcat 'identity article-ignored-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)
+ ((listp gnus-ignored-headers)
+ (mapconcat 'identity gnus-ignored-headers
"\\|")))))
(visible
- (cond ((stringp article-visible-headers)
- article-visible-headers)
- ((and article-visible-headers
- (listp article-visible-headers))
- (mapconcat 'identity article-visible-headers "\\|"))))
+ (cond ((stringp gnus-visible-headers)
+ gnus-visible-headers)
+ ((and gnus-visible-headers
+ (listp gnus-visible-headers))
+ (mapconcat 'identity gnus-visible-headers "\\|"))))
(inhibit-point-motion-hooks t)
want-list beg)
;; First we narrow to just the headers.
(point)
(progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
;; Then we use the two regular expressions
- ;; `article-ignored-headers' and `article-visible-headers' to
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' to
;; select which header lines is to remain visible in the
;; article buffer.
(goto-char (point-min))
(while (re-search-forward "^[^ \t]*:" nil t)
(beginning-of-line)
- ;; We add the headers we want to keep to a list and delete
- ;; them from the buffer.
+ ;; Mark the rank of the header.
(put-text-property
(point) (1+ (point)) 'message-rank
(if (or (and visible (looking-at visible))
(save-excursion
(save-restriction
(let ((buffer-read-only nil)
- (list article-boring-article-headers)
+ (list gnus-boring-article-headers)
(inhibit-point-motion-hooks t)
elem)
(nnheader-narrow-to-headers)
(cond
;; Hide empty headers.
((eq elem 'empty)
- (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
+ (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t)
(forward-line -1)
(article-hide-text-type
(progn (beginning-of-line) (point))
(nnheader-narrow-to-headers)
(setq from (message-fetch-field "from"))
(goto-char (point-min))
- (when (and article-x-face-command
+ (when (and gnus-article-x-face-command
(or force
;; Check whether this face is censored.
- (not article-x-face-too-ugly)
- (and article-x-face-too-ugly from
- (not (string-match article-x-face-too-ugly
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
from))))
;; Has to be present.
(re-search-forward "^X-Face: " nil t))
(let ((beg (point))
(end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
;; We display the face.
- (if (symbolp article-x-face-command)
+ (if (symbolp gnus-article-x-face-command)
;; The command is a lisp function, so we call it.
- (if (gnus-functionp article-x-face-command)
- (funcall article-x-face-command beg end)
- (error "%s is not a function" article-x-face-command))
+ (if (gnus-functionp gnus-article-x-face-command)
+ (funcall gnus-article-x-face-command beg end)
+ (error "%s is not a function" gnus-article-x-face-command))
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(let ((process-connection-type nil))
(process-kill-without-query
(start-process
"article-x-face" nil shell-file-name shell-command-switch
- article-x-face-command))
+ gnus-article-x-face-command))
(process-send-region "article-x-face" beg end)
(process-send-eof "article-x-face")))))))))
-(defalias 'article-headers-decode-quoted-printable 'article-decode-rfc1522)
(defun article-decode-rfc1522 ()
"Hack to remove QP encoding from headers."
(let ((case-fold-search t)
(narrow-to-region (match-beginning 0) (match-end 0))
(delete-region (point-min) (point-max))
(insert string)
- (article-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
+ (article-mime-decode-quoted-printable
+ (goto-char (point-min)) (point-max))
(subst-char-in-region (point-min) (point-max) ?_ ? )
(widen)
(goto-char (point-min))))))
(point-max))
(error nil))))
(goto-char (point-max))
- (when (re-search-backward article-signature-separator nil t)
+ (when (re-search-backward gnus-signature-separator nil t)
(forward-line 1)
- (when (or (null article-signature-limit)
- (and (numberp article-signature-limit)
- (< (- (point-max) (point)) article-signature-limit))
- (and (gnus-functionp article-signature-limit)
- (funcall article-signature-limit))
- (and (stringp article-signature-limit)
- (not (re-search-forward article-signature-limit nil t))))
+ (when (or (null gnus-signature-limit)
+ (and (numberp gnus-signature-limit)
+ (< (- (point-max) (point)) gnus-signature-limit))
+ (and (gnus-functionp gnus-signature-limit)
+ (funcall gnus-signature-limit))
+ (and (stringp gnus-signature-limit)
+ (not (re-search-forward gnus-signature-limit nil t))))
(narrow-to-region (point) (point-max))
t)))
(setq beg (point))
(forward-char)
(if hide
- (article-hide-text beg (point) article-hidden-properties)
+ (article-hide-text beg (point) gnus-hidden-properties)
(article-unhide-text beg (point)))
(setq beg (point)))
t)))
(article-unhide-text (point-min) (point-max)))))
(defun article-emphasize (&optional arg)
- "Empasize text according to `article-emphasis-alist'."
+ "Empasize text according to `gnus-emphasis-alist'."
(interactive (article-hidden-arg))
(unless (article-check-hidden-text 'emphasis arg)
(save-excursion
- (let ((alist article-emphasis-alist)
+ (let ((alist gnus-emphasis-alist)
(buffer-read-only nil)
(props (append '(article-type emphasis)
- article-hidden-properties))
+ gnus-hidden-properties))
regexp elem beg invisible visible face)
(goto-char (point-min))
(search-forward "\n\n" nil t)
;;; Code:
(require 'cl)
-(setq load-path (cons "." load-path))
+(push "." load-path)
(setq custom-file "/THIS FILE DOES NOT eXiST!")
`always', there the user will be prompted once for a file name for
each invocation of the saving commands.")
-(defvar gnus-saved-headers article-visible-headers
+(defvar gnus-saved-headers gnus-visible-headers
"*Headers to keep if `gnus-save-all-headers' is nil.
If `gnus-save-all-headers' is non-nil, this variable will be ignored.
If that variable is nil, however, all headers that match this regexp
"Save the currently selected article."
(unless gnus-save-all-headers
;; Remove headers accoring to `gnus-saved-headers'.
- (let ((article-visible-headers
- (or gnus-saved-headers article-visible-headers))
+ (let ((gnus-visible-headers
+ (or gnus-saved-headers gnus-visible-headers))
(gnus-article-buffer save-buffer))
(gnus-article-hide-headers 1 t)))
(save-window-excursion
;;; Gnus article mode
;;;
-(defvar gnus-article-mode-map nil)
(put 'gnus-article-mode 'mode-class 'special)
-(if gnus-article-mode-map
- nil
- (setq gnus-article-mode-map (make-keymap))
- (suppress-keymap gnus-article-mode-map)
-
+(when t
(gnus-define-keys gnus-article-mode-map
" " gnus-article-goto-next-page
"\177" gnus-article-goto-prev-page
"Hide unwanted headers if `gnus-have-all-headers' is nil.
Provided for backwards compatibility."
(or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
- article-inhibit-hiding
+ gnus-inhibit-hiding
(gnus-article-hide-headers)))
;;; Article savers.
(set-buffer gnus-article-buffer)
(article-date-ut type highlight headers))))
+;;;
+;;; Article editing
+;;;
+
+(defvar gnus-article-edit-mode-hook nil
+ "*Hook run in article edit mode buffers.")
+
+(defvar gnus-article-edit-mode-map nil)
+
+(unless gnus-article-edit-mode-map
+ (setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
+
+ (gnus-define-keys gnus-article-edit-mode-map
+ "\C-c\C-c" 'gnus-summary-edit-article-done)
+
+ (gnus-define-keys (gnus-article-edit-wash-map
+ "\C-c\C-w" gnus-article-edit-mode-map)
+ "f" gnus-article-edit-full-stops))
+
+(defun gnus-article-edit-mode ()
+ "Major mode for editing articles.
+This is an extended text-mode.
+
+\\{gnus-article-edit-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'gnus-article-edit-mode)
+ (setq mode-name "Article Edit")
+ (make-local-variable 'minor-mode-alist)
+ (use-local-map gnus-article-edit-mode-map)
+ (run-hooks 'text-mode 'gnus-article-edit-mode-hook))
+
+(defun gnus-article-edit-full-stops ()
+ "Interactively repair spacing at end of sentences."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward-regexp "^$" nil t)
+ (let ((case-fold-search nil))
+ (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
+
(provide 'gnus-art)
;;; gnus-art.el ends here
(require 'gnus-sum)
(require 'nntp)
-(defvar gnus-use-article-prefetch 5
+(defvar gnus-use-article-prefetch 30
"*If non-nil, prefetch articles in groups that allow this.
If a number, prefetch only that many articles forward;
if t, prefetch as many articles as possible.")
(search-forward "\n\n" nil t)
(push (cons (point-marker) "") marks)
(goto-char (point-max))
- (re-search-backward article-signature-separator nil t)
+ (re-search-backward gnus-signature-separator nil t)
(push (cons (point-marker) "") marks)
(setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
(let* ((omarks marks))
(marks (gnus-dissect-cited-text))
(inhibit-point-motion-hooks t)
(props (nconc (list 'gnus-type 'cite)
- article-hidden-properties))
+ gnus-hidden-properties))
beg end)
(while marks
(setq beg nil
(funcall
(if (text-property-any
(car region) (1- (cdr region))
- (car article-hidden-properties) (cadr article-hidden-properties))
+ (car gnus-hidden-properties) (cadr gnus-hidden-properties))
'remove-text-properties 'gnus-add-text-properties)
- (car region) (cdr region) article-hidden-properties)))
+ (car region) (cdr region) gnus-hidden-properties)))
(defun gnus-article-hide-citation-maybe (&optional arg force)
"Toggle hiding of cited text that has an attribution line.
(hiden 0)
total)
(goto-char (point-max))
- (re-search-backward article-signature-separator nil t)
+ (re-search-backward gnus-signature-separator nil t)
(setq total (count-lines start (point)))
(while atts
(setq hiden (+ hiden (length (cdr (assoc (cdar atts)
(gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'gnus-type 'cite)
- article-hidden-properties)))))))))))
+ gnus-hidden-properties)))))))))))
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
(case-fold-search t)
(max (save-excursion
(goto-char (point-max))
- (re-search-backward article-signature-separator nil t)
+ (re-search-backward gnus-signature-separator nil t)
(point)))
alist entry start begin end numbers prefix)
;; Get all potential prefixes in `alist'.
(goto-line number)
(cond ((get-text-property (point) 'invisible)
(remove-text-properties (point) (progn (forward-line 1) (point))
- article-hidden-properties))
+ gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
(gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'gnus-type 'cite)
- article-hidden-properties))))))))
+ gnus-hidden-properties))))))))
(defun gnus-cite-find-prefix (line)
;; Return citation prefix for LINE.
;;; Gnus group mode
;;;
-(defvar gnus-group-mode-map nil)
(put 'gnus-group-mode 'mode-class 'special)
-(unless gnus-group-mode-map
- (setq gnus-group-mode-map (make-keymap))
- (suppress-keymap gnus-group-mode-map)
-
+(when t
(gnus-define-keys gnus-group-mode-map
" " gnus-group-read-group
"=" gnus-group-select-group
"V" gnus-version
"s" gnus-group-save-newsrc
"z" gnus-group-suspend
-; "Z" gnus-group-clear-dribble
+ ; "Z" gnus-group-clear-dribble
"q" gnus-group-exit
"Q" gnus-group-quit
"?" gnus-group-describe-briefly
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
- (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
- (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
- "s" gnus-group-sort-groups
- "a" gnus-group-sort-groups-by-alphabet
- "u" gnus-group-sort-groups-by-unread
- "l" gnus-group-sort-groups-by-level
- "v" gnus-group-sort-groups-by-score
- "r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
-
- (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
- "k" gnus-group-list-killed
- "z" gnus-group-list-zombies
- "s" gnus-group-list-groups
- "u" gnus-group-list-all-groups
- "A" gnus-group-list-active
- "a" gnus-group-apropos
- "d" gnus-group-description-apropos
- "m" gnus-group-list-matching
- "M" gnus-group-list-all-matching
- "l" gnus-group-list-level)
-
- (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
- "f" gnus-score-flush-cache)
-
- (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "f" gnus-group-fetch-faq)
-
- (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
- "l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
- "k" gnus-group-kill-group
- "y" gnus-group-yank-group
- "w" gnus-group-kill-region
- "\C-k" gnus-group-kill-level
- "z" gnus-group-kill-all-zombies))
+ (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
+ "b" gnus-group-brew-soup
+ "w" gnus-soup-save-areas
+ "s" gnus-soup-send-replies
+ "p" gnus-soup-pack-packet
+ "r" nnsoup-pack-replies)
+
+ (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
+ "s" gnus-group-sort-groups
+ "a" gnus-group-sort-groups-by-alphabet
+ "u" gnus-group-sort-groups-by-unread
+ "l" gnus-group-sort-groups-by-level
+ "v" gnus-group-sort-groups-by-score
+ "r" gnus-group-sort-groups-by-rank
+ "m" gnus-group-sort-groups-by-method)
+
+ (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
+ "k" gnus-group-list-killed
+ "z" gnus-group-list-zombies
+ "s" gnus-group-list-groups
+ "u" gnus-group-list-all-groups
+ "A" gnus-group-list-active
+ "a" gnus-group-apropos
+ "d" gnus-group-description-apropos
+ "m" gnus-group-list-matching
+ "M" gnus-group-list-all-matching
+ "l" gnus-group-list-level)
+
+ (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
+ "f" gnus-score-flush-cache)
+
+ (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
+ "f" gnus-group-fetch-faq)
+
+ (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
+ "l" gnus-group-set-current-level
+ "t" gnus-group-unsubscribe-current-group
+ "s" gnus-group-unsubscribe-group
+ "k" gnus-group-kill-group
+ "y" gnus-group-yank-group
+ "w" gnus-group-kill-region
+ "\C-k" gnus-group-kill-level
+ "z" gnus-group-kill-all-zombies))
(defun gnus-group-mode ()
"Major mode for reading news.
(gnus-group-position-point)))
(defun gnus-group-rename-group (group new-name)
+ "Rename group from GROUP to NEW-NAME.
+When used interactively, GROUP is the group under point
+and NEW-NAME will be prompted for."
(interactive
(list
(gnus-group-group-name)
(progn
- (or (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))
- (error "This backend does not support renaming groups"))
- (read-string "New group name: "))))
-
- (or (gnus-check-backend-function 'request-rename-group group)
- (error "This backend does not support renaming groups"))
-
- (or group (error "No group to rename"))
- (and (string-match "^[ \t]*$" new-name)
- (error "Not a valid group name"))
+ (unless (gnus-check-backend-function
+ 'request-rename-group (gnus-group-group-name))
+ (error "This backend does not support renaming groups"))
+ (read-string "New group name: " (gnus-group-group-name)))))
+
+ (unless (gnus-check-backend-function 'request-rename-group group)
+ (error "This backend does not support renaming groups"))
+ (unless group
+ (error "No group to rename"))
+ (when (string-match "^[ \t]*$" new-name)
+ (error "Not a valid group name"))
+ (when (equal group new-name)
+ (error "Can't rename to the same name"))
;; We find the proper prefixed name.
(setq new-name
(gnus-dribble-save)
(gnus-close-backends)
(gnus-clear-system)
+ (gnus-kill-buffer gnus-group-buffer)
;; Allow the user to do things after cleaning up.
(run-hooks 'gnus-after-exiting-gnus-hook)))
;; Site dependent variables. These variables should be defined in
;; paths.el.
+(defvar gnus-default-nntp-server nil
+ "Specify a default NNTP server.
+This variable should be defined in paths.el, and should never be set
+by the user.
+If you want to change servers, you should use `gnus-select-method'.
+See the documentation to that variable.")
+
;; Don't touch this variable.
(defvar gnus-nntp-service "nntp"
"*NNTP service name (\"nntp\" or 119).
(setq gnus-secondary-select-methods '((nnml \"\")))")
-(defvar gnus-default-nntp-server nil
- "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
-
(defvar gnus-backup-default-subscribed-newsgroups
'("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
"Default default new newsgroups the first time Gnus is run.
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
gnus-decode-rfc1522 gnus-article-show-all-headers)
- ("gnus-start" gnus-newsrc-parse-options gnus-1)
+ ("gnus-int" gnus-request-type)
+ ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1)
("gnus-range" gnus-copy-sequence)
("gnus-vm" gnus-vm-mail-setup)
("gnus-logic" gnus-score-advanced)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
- gnus-async-prefetch-article)
+ gnus-async-prefetch-article gnus-async-prefetch-remove-group)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm))))
+;;;
+;;; Skeleton keymaps
+;;;
+
+(defun gnus-suppress-keymap (keymap)
+ (suppress-keymap keymap)
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (while keys
+ (define-key keymap (pop keys) 'undefined))))
+
+(defvar gnus-article-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-article-mode-map)
+(defvar gnus-summary-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-summary-mode-map)
+(defvar gnus-group-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-group-mode-map)
+
+;;; Function aliases later to be redefined for XEmacs usage.
+
(defalias 'gnus-make-overlay 'make-overlay)
(defalias 'gnus-overlay-put 'overlay-put)
(defalias 'gnus-move-overlay 'move-overlay)
(require 'gnus-load)
(require 'gnus-score)
-;(require 'parse-time)
(require 'gnus-util)
;;; Internal variables.
("head" nil gnus-advanced-body)
("body" nil gnus-advanced-body)
("all" nil gnus-advanced-body)))
+
+(eval-and-compile
+ (autoload 'parse-time-string "parse-time"))
(defun gnus-score-advanced (rule &optional trace)
"Apply advanced scoring RULE to all the articles in the current group."
(unless (eolp)
(push (make-annotation "\n" (point) 'text)
gnus-group-annotations)))
- (cond
+ (cond
((listp gnus-group-annotations)
- (mapcar 'delete-annotation gnus-group-annotations)
+ (mapc #'(lambda (ext) (if (extent-live-p ext) (delete-annotation ext)))
+ gnus-group-annotations)
(setq gnus-group-annotations nil))
((annotationp gnus-group-annotations)
(delete-annotation gnus-group-annotations)
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
-;;;###autoload
+(defun gnus-no-server-1 (&optional arg slave)
+ "Read network news.
+If ARG is a positive number, Gnus will use that as the
+startup level. If ARG is nil, Gnus will be started at level 2.
+If ARG is non-nil and not a positive number, Gnus will
+prompt the user for the name of an NNTP server to use.
+As opposed to `gnus', this command will not connect to the local server."
+ (interactive "P")
+ (let ((val (or arg (1- gnus-level-default-subscribed))))
+ (gnus val t slave)
+ (make-local-variable 'gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels val)))
+
(defun gnus-1 (&optional arg dont-connect slave)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
;;; Gnus summary mode
;;;
-(defvar gnus-summary-mode-map nil)
-
(put 'gnus-summary-mode 'mode-class 'special)
-(unless gnus-summary-mode-map
- (setq gnus-summary-mode-map (make-keymap))
- (suppress-keymap gnus-summary-mode-map)
-
+(when t
;; Non-orthogonal keys
(gnus-define-keys gnus-summary-mode-map
(goto-char (point-min))
(run-hooks 'gnus-summary-prepare-hook)))
-(defsubst gnus-pdf-simplify-subject (whole-subject)
- "Simplify subject by the same rules as gnus-gather-threads-by-subject."
- (let* ((sub nil)
- (subject
- (cond
- ;; Truncate the subject.
- ((numberp gnus-summary-gather-subject-limit)
- (setq sub (gnus-simplify-subject-re whole-subject))
- (if (> (length sub) gnus-summary-gather-subject-limit)
- (substring sub 0 gnus-summary-gather-subject-limit)
- sub))
- ;; Fuzzily simplify it.
- ((eq 'fuzzy gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-fuzzy whole-subject))
- ;; Just remove the leading "Re:".
- (t
- (gnus-simplify-subject-re whole-subject)))))
-
- (if (and gnus-summary-gather-exclude-subject
- (string-match gnus-summary-gather-exclude-subject
- subject))
- nil ; This article shouldn't be gathered
- subject)))
+(defsubst gnus-general-simplify-subject (subject)
+ "Simply subject by the same rules as gnus-gather-threads-by-subject."
+ (setq subject
+ (cond
+ ;; Truncate the subject.
+ ((numberp gnus-summary-gather-subject-limit)
+ (setq subject (gnus-simplify-subject-re subject))
+ (if (> (length subject) gnus-summary-gather-subject-limit)
+ (substring subject 0 gnus-summary-gather-subject-limit)
+ subject))
+ ;; Fuzzily simplify it.
+ ((eq 'fuzzy gnus-summary-gather-subject-limit)
+ (gnus-simplify-subject-fuzzy subject))
+ ;; Just remove the leading "Re:".
+ (t
+ (gnus-simplify-subject-re subject))))
+
+ (if (and gnus-summary-gather-exclude-subject
+ (string-match gnus-summary-gather-exclude-subject subject))
+ nil ; This article shouldn't be gathered
+ subject))
(defun gnus-summary-simplify-subject-query ()
"Query where the respool algorithm would put this article."
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article)
- (message (gnus-pdf-simplify-subject (gnus-summary-article-subject))))
+ (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-gather-threads-by-subject (threads)
"Gather threads by looking at Subject headers."
(result threads)
subject hthread whole-subject)
(while threads
- (setq subject (gnus-pdf-simplify-subject
+ (setq subject (gnus-general-simplify-subject
(setq whole-subject (mail-header-subject
(caar threads)))))
(if subject
(select-window (get-buffer-window gnus-article-buffer))
(gnus-message 6 "C-c C-c to end edits")
(setq buffer-read-only nil)
- (text-mode)
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ (gnus-article-edit-mode)
(buffer-enable-undo)
(widen)
(goto-char (point-min))
(and (gnus-visual-p 'summary-highlight 'highlight)
(run-hooks 'gnus-visual-mark-article-hook)))
+(defun gnus-summary-edit-wash (key)
+ "Perform editing command in the article buffer."
+ (interactive
+ (list
+ (progn
+ (message "%s" (concat (this-command-keys) "- "))
+ (read-char))))
+ (message "")
+ (gnus-summary-edit-article)
+ (execute-kbd-macro (concat (this-command-keys) key))
+ (gnus-summary-edit-article-done))
+
+;;; Respooling
+
(defun gnus-summary-respool-query ()
"Query where the respool algorithm would put this article."
(interactive)
"Define all keys in PLIST in KEYMAP."
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
+(defmacro gnus-define-keys-safe (keymap &rest plist)
+ "Define all keys in PLIST in KEYMAP without overwriting previous definitions."
+ `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
+
(put 'gnus-define-keys 'lisp-indent-function 1)
(put 'gnus-define-keys 'lisp-indent-hook 1)
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-(put 'gnus-define-keymap 'lisp-indent-hook 1)
+(put 'gnus-define-keys-safe 'lisp-indent-function 1)
+(put 'gnus-define-keys-safe 'lisp-indent-hook 1)
+(put 'gnus-local-set-keys 'lisp-indent-function 1)
+(put 'gnus-local-set-keys 'lisp-indent-hook 1)
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
`(gnus-define-keys-1 ,keymap (quote ,plist)))
-(defun gnus-define-keys-1 (keymap plist)
+(defun gnus-define-keys-1 (keymap plist &optional safe)
(when (null keymap)
(error "Can't set keys in a null keymap"))
(cond ((symbolp keymap)
(while plist
(when (symbolp (setq key (pop plist)))
(setq key (symbol-value key)))
- (define-key keymap key (pop plist)))))
+ (if (or (not safe)
+ (eq (lookup-key keymap key) 'undefined))
+ (define-key keymap key (pop plist))
+ (pop plist)))))
(defun gnus-completing-read (default prompt &rest args)
;; Like `completing-read', except that DEFAULT is the default argument.
(defun gnus-article-highlight-signature ()
"Highlight the signature in an article.
It does this by highlighting everything after
-`article-signature-separator' using `gnus-signature-face'."
+`gnus-signature-separator' using `gnus-signature-face'."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
'face gnus-signature-face)
(widen)
- (re-search-backward article-signature-separator nil t)
+ (re-search-backward gnus-signature-separator nil t)
(let ((start (match-beginning 0))
(end (set-marker (make-marker) (1+ (match-end 0)))))
(gnus-article-add-button start (1- end) 'gnus-signature-toggle
(inhibit-point-motion-hooks t))
(if (get-text-property end 'invisible)
(article-unhide-text end (point-max))
- (article-hide-text end (point-max) article-hidden-properties)))))
+ (article-hide-text end (point-max) gnus-hidden-properties)))))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
(cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist))
"Colors used for the Gnus logo.")
-(defvar article-x-face-command
+(defvar gnus-article-x-face-command
(if (featurep 'xface)
'gnus-xmas-article-display-xface
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.1"
+(defconst gnus-version-number "0.2"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
"*If non-nil, the startup message will not be displayed.")
(defun gnus-splash ()
- (switch-to-buffer gnus-group-buffer)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (unless gnus-inhibit-startup-message
- (gnus-group-startup-message)
- (sit-for 0))))
+ (save-excursion
+ (switch-to-buffer gnus-group-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (unless gnus-inhibit-startup-message
+ (gnus-group-startup-message)
+ (sit-for 0)))))
(defun gnus-indent-rigidly (start end arg)
"Indent rigidly using only spaces and no tabs."
(setq mode-line-buffer-identification gnus-version)
(set-buffer-modified-p t))
-;(unless (string-match "xemacs" (emacs-version))
- (gnus-splash)
-;)
+(eval-when (load)
+ (gnus-splash))
;;; Do the rest.
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
+ (gnus-no-server-1 arg slave))
;;;###autoload
(defun gnus-slave (&optional arg)
(forward-char -1)))
(lambda ()
(or (get-text-property (point) 'message-rank)
- 0))))
+ 10000))))
(defun message-sort-headers ()
"Sort the headers of the current message according to `message-header-format-alist'."
(set (pop vars) nil)))
(let (defs)
;; Guess away until we find the real file type.
- (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist))
- guess (assq 'guess defs))
+ (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
+ nndoc-type-alist))))
(setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
;; Set the nndoc variables.
(while defs
as the last checked definition, if t or `first', add as the
first definition, and if any other symbol, add after that
symbol in the alist."
+ ;; First remove any old instances.
+ (setq nndoc-type-alist
+ (delq (assq (car definition) nndoc-type-alist)
+ nndoc-type-alist))
+ ;; Then enter the new definition in the proper place.
(cond
((or (null position) (eq position 'last))
(setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
((or (eq position t) (eq position 'first))
(push definition nndoc-type-alist))
(t
- (let ((list (memq (assq position nndoc-type-alist))))
+ (let ((list (memq (assq position nndoc-type-alist)
+ nndoc-type-alist)))
(unless list
(error "No such position: %s" position))
(setcdr list (cons definition (cdr list)))))))
;; No output => movemail won
(push inbox nnmail-moved-inboxes)
(set-buffer errors)
- (subst-char-in-region (point-min) (point-max) ?\n ?\ )
- (goto-char (point-max))
- (skip-chars-backward " \t")
- (delete-region (point) (point-max))
+ ;; There may be a warning about older revisions. We
+ ;; ignore those.
(goto-char (point-min))
- (if (looking-at "movemail: ")
- (delete-region (point-min) (match-end 0)))
- (error (concat "movemail: " (buffer-string)))
- (setq tofile nil))))))
+ (if (search-forward "older revision" nil t)
+ (push inbox nnmail-moved-inboxes)
+ ;; Probably a real error.
+ (subst-char-in-region (point-min) (point-max) ?\n ?\ )
+ (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (if (looking-at "movemail: ")
+ (delete-region (point-min) (match-end 0)))
+ (error (concat "movemail: " (buffer-string)))
+ (setq tofile nil)))))))
(and errors
(buffer-name errors)
(kill-buffer errors))
(require 'nnheader)
(require 'nnmail)
-(require 'gnus)
+(require 'gnus-start)
(require 'nnoo)
-(eval-and-compile (require 'cl))
+(require 'cl)
(nnoo-declare nnmh)
(deffoo nnmh-request-rename-group (group new-name &optional server)
(nnmh-possibly-change-directory group server)
- ;; Rename directory.
- (and (file-writable-p nnmh-current-directory)
- (condition-case ()
- (progn
- (rename-file
- (directory-file-name nnmh-current-directory)
- (directory-file-name
- (nnmail-group-pathname new-name nnmh-directory)))
- t)
- (error nil))
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnmh-group-alist)))
- (and entry (setcar entry new-name))
- (setq nnmh-current-directory nil)
- t)))
+ (let ((new-dir (nnmail-group-pathname new-name nnmh-directory))
+ (old-dir (nnmail-group-pathname group nnmh-directory)))
+ (when (condition-case ()
+ (progn
+ (make-directory new-dir t)
+ t)
+ (error nil))
+ ;; We move the articles file by file instead of renaming
+ ;; the directory -- there may be subgroups in this group.
+ ;; One might be more clever, I guess.
+ (let ((files (nnheader-article-to-file-alist old-dir)))
+ (while files
+ (rename-file
+ (concat old-dir (cdar files))
+ (concat new-dir (cdar files)))
+ (pop files)))
+ (when (<= (length (directory-files old-dir)) 2)
+ (condition-case ()
+ (delete-directory old-dir)
+ (error nil)))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnmh-group-alist)))
+ (and entry (setcar entry new-name))
+ (setq nnmh-current-directory nil)
+ t))))
\f
;;; Internal functions.
(deffoo nnml-request-rename-group (group new-name &optional server)
(nnml-possibly-change-directory group server)
- ;; Rename directory.
- (and (file-writable-p nnml-current-directory)
- (condition-case ()
- (let ((parent
- (file-name-directory
- (directory-file-name
- (nnmail-group-pathname new-name nnml-directory)))))
- (unless (file-exists-p parent)
- (make-directory parent t))
- (rename-file
- (directory-file-name nnml-current-directory)
- (directory-file-name
- (nnmail-group-pathname new-name nnml-directory)))
- t)
- (error nil))
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnml-group-alist)))
- (and entry (setcar entry new-name))
- (setq nnml-current-directory nil
- nnml-current-group nil)
- ;; Save the new group alist.
- (nnmail-save-active nnml-group-alist nnml-active-file)
- t)))
+ (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
+ (old-dir (nnmail-group-pathname group nnml-directory)))
+ (when (condition-case ()
+ (progn
+ (make-directory new-dir t)
+ t)
+ (error nil))
+ ;; We move the articles file by file instead of renaming
+ ;; the directory -- there may be subgroups in this group.
+ ;; One might be more clever, I guess.
+ (let ((files (nnheader-article-to-file-alist old-dir)))
+ (while files
+ (rename-file
+ (concat old-dir (cdar files))
+ (concat new-dir (cdar files)))
+ (pop files)))
+ (when (<= (length (directory-files old-dir)) 2)
+ (condition-case ()
+ (delete-directory old-dir)
+ (error nil)))
+ ;; That went ok, so we change the internal structures.
+ (let ((entry (assoc group nnml-group-alist)))
+ (and entry (setcar entry new-name))
+ (setq nnml-current-directory nil
+ nnml-current-group nil)
+ ;; Save the new group alist.
+ (nnmail-save-active nnml-group-alist nnml-active-file)
+ t))))
\f
;;; Internal functions.
;;; Internal variables.
(defvoo nntp-server-type nil)
-(defvar nntp-connection-alist nil)
-(defvar nntp-status-string "")
+(defvoo nntp-connection-alist nil)
+(defvoo nntp-status-string "")
(defconst nntp-version "nntp 5.0")
-(defvar nntp-inhibit-erase nil)
+(defvoo nntp-inhibit-erase nil)
-(defvar nntp-server-xover 'try)
-(defvar nntp-server-list-active-group 'try)
+(defvoo nntp-server-xover 'try)
+(defvoo nntp-server-list-active-group 'try)
\f
(deffoo nntp-request-body (article &optional group server)
(nntp-possibly-change-group group server)
- (nntp-send-command
+ (nntp-send-command-and-decode
"\r\n\\.\r\n" "BODY"
(if (numberp article) (int-to-string article) article)))
(deffoo nntp-request-list (&optional server)
(nntp-possibly-change-group nil server)
- (nntp-send-command "\r\n\\.\r\n" "LIST"))
+ (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST")
+ (nntp-decode-text t)))
(deffoo nntp-request-list-newsgroups (&optional server)
(nntp-possibly-change-group nil server)
- (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS"))
+ (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS")
+ (nntp-decode-text t)))
(deffoo nntp-request-newgroups (date &optional server)
(nntp-possibly-change-group nil server)
(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
(nntp-decode-text))))
-
(deffoo nntp-asynchronous-p ()
t)
+
+(deffoo nntp-request-post (&optional server)
+ (nntp-possibly-change-group nil server)
+ (when (nntp-send-command "^[23].*\r?\n" "POST")
+ (nntp-send-buffer "^[23].*\n")))
;;; Hooky functions.
nntp-address nntp-port-number nntp-server-buffer
wait-for nnheader-callback-function t))
+(defun nntp-send-buffer (wait-for)
+ "Send the current buffer to server and wait until WAIT-FOR returns."
+ (unless nnheader-callback-function
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)))
+ (nntp-encode-text)
+ (process-send-region (nntp-find-connection nntp-server-buffer)
+ (point-min) (point-max))
+ (nntp-retrieve-data
+ nil nntp-address nntp-port-number nntp-server-buffer
+ wait-for nnheader-callback-function))
+
(defun nntp-find-connection (buffer)
"Find the connection delivering to BUFFER."
(let ((alist nntp-connection-alist)
(buffer-name (get-buffer buffer)))))
(buffer-disable-undo (current-buffer))
(current-buffer)))
- (process (funcall nntp-open-connection-function pbuffer)))
+ (process
+ (condition-case ()
+ (funcall nntp-open-connection-function pbuffer)
+ (error nil))))
(when process
(process-kill-without-query process)
(nntp-wait-for process "^.*\r\n" buffer)
(save-excursion
(set-buffer (process-buffer process))
(erase-buffer)))
- (nntp-send-string process command)
+ (when command
+ (nntp-send-string process command))
(cond
((eq callback 'ignore)
t)
(while (search-forward "\n.." nil t)
(delete-char -1))))
+(defun nntp-encode-text ()
+ "Encode the text in the current buffer."
+ (save-excursion
+ ;; Replace "." at beginning of line with "..".
+ (goto-char (point-min))
+ (while (re-search-forward "^\\." nil t)
+ (insert "."))
+ (goto-char (point-max))
+ ;; Insert newline at the end of the buffer.
+ (unless (bolp)
+ (insert "\n"))
+ ;; Insert `.' at end of buffer (end of text mark).
+ (goto-char (point-max))
+ (insert "." nntp-end-of-line)))
+
(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(erase-buffer)
(cond
(max 1 (- (car articles) fetch-old))
1)
(car articles))
- (last articles) 'wait)
+ (car (last articles)) 'wait)
(goto-char (point-min))
(when (looking-at "[1-5][0-9][0-9] ")
(delete-char -1))
(goto-char (point-min))
(delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
- ;(save-excursion
- ; (set-buffer nntp-server-buffer)
- ; (insert-buffer-substring buf))
- ;(erase-buffer)
- ))))
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))))))
nntp-server-xover)
(defvar parse-time-syntax (make-char-table 'parse-time-syntax))
(defvar parse-time-digits (make-char-table 'parse-time-syntax))
+;; Byte-compiler warnings
+(defvar elt)
+(defvar val)
+
(unless (aref parse-time-digits ?0)
(loop for i from ?0 to ?9
do (set-char-table-range parse-time-digits i (- i ?0))))
+Wed Jul 31 15:37:44 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi: Fix
+
Mon Jul 29 10:12:24 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Misc Article): Addition.
@vindex gnus-subscribe-hierarchically
Subscribe all new groups hierarchically. The difference between this
function and @code{gnus-subscribe-alphabetically} is slight.
-{gnus-subscribe-alphabetically} will subscribe new groups in a strictly
+@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly
alphabetical fashion, while this function will enter groups into it's
hierarchy. So if you want to have the @samp{rec} hierarchy before the
@samp{comp} hierarchy, this function will not mess that configuration
simple scoring, and the match types are also the same.
-@node Advanced Scoring Example
-@subsection Advanced Scoring Example
+@node Advanced Scoring Examples
+@subsection Advanced Scoring Examples
Let's say you want to increase the score of articles written by Lars
when he's talking about Gnus:
-@samp
+@example
((&
("from" "Lars Ingebrigtsen")
("subject" "Gnus"))
1000)
-@end samp
+@end example
Quite simple, huh?
When he writes long articles, he sometimes has something nice to say:
-@samp
+@example
((&
("from" "Lars Ingebrigtsen")
(|
("subject" "Gnus")
("lines" 100 >)))
1000)
-@end samp
+@end example
However, when he responds to things written by Reig Eigil Logge, you
really don't want to read what he's written:
-@samp
+@example
((&
("from" "Lars Ingebrigtsen")
(1- ("from" "Reig Eigir Logge")))
-100000)
-@end samp
+@end example
Everybody that follows up Redmondo when he writes about disappearing
socks should have their scores raised, but only when they talk about
white socks. However, when Lars talks about socks, it's usually not
very interesting:
-@samp
+@example
((&
(1-
(&
- ("from" "redmondo@.*no" r)
+ ("from" "redmondo@@.*no" r)
("body" "disappearing.*socks" t)))
(! ("from" "Lars Ingebrigtsen"))
("body" "white.*socks"))
1000)
-@end samp
+@end example
The possibilities are endless.
arguments work on previous generations of the thread. If you say
something like:
-@samp
+@example
...
(1-
(1-
("from" "lars")))
...
-@end samp
+@end example
Then that means "score on the from header of the grandparent of the
current article". An indirection is quite fast, but it's better to say:
-@samp
+@example
(1-
(&
("from" "Lars")
("subject" "Gnus")))
-@end samp
+@end example
than it is to say:
-@samp
+@example
(&
(1- ("from" "Lars"))
(1- ("subject" "Gnus")))
-@end samp
+@end example