+Fri Nov 17 03:35:58 1995 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus-vis.el ((require 'cl)): Require cl.
+
+ * gnus.el (gnus-active): New macro.
+ (gnus-intern-safe): Ditto.
+ (gnus-set-active): Ditto.
+
+Fri Nov 17 01:33:26 1995 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el (gnus-max-width-function): Totally bugged out.
+
+ * gnus-msg.el (gnus-new-news): Set point on Subject.
+ (gnus-inews-insert-bfcc): Don't narrow to headers.
+
+ * gnus.el (gnus-articles-to-read): `C-u SPC' would have no real
+ effect.
+ (gnus-article-date-ut): Would chop up lines.
+
+ * nnheader.el: Require cl.
+
+Fri Nov 17 00:11:10 1995 Lars Magne Ingebrigtsen <larsi@narfi.ifi.uio.no>
+
+ * gnus.el (gnus-select-newsgroup): Expiry marks would disappear.
+ (gnus-headers-decode-quoted-printable): Use subst-char instead of
+ search/replace.
+ (gnus-remove-thread): Didn't remove properly.
+
+Thu Nov 16 06:28:17 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el: Intern group in active hashtb throughout.
+
Wed Nov 15 06:13:48 1995 Lars Ingebrigtsen <lars@eyesore.no>
+ * gnus.el: 0.13 is released.
+
* gnus-score.el (gnus-score-get): Turned into a defsubst.
(gnus-score-find-bnews): Slightly less funcalling.
(require 'custom)
(require 'gnus-ems)
+(require 'browse-url)
;; The following is just helper functions and data, not ment to be set
;; by the user.
'(progn
(if (string-match "XEmacs\\|Lucid" emacs-version)
()
+
+ (defvar gnus-mouse-face-prop 'mouse-face)
+
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defvar gnus-display-type
(condition-case nil
Type \\[describe-mode] in the buffer to get a list of commands."
(interactive (list t))
(let* ((group (or group gnus-newsgroup-name))
+ (pgroup group)
(to-address
(when group
(gnus-group-get-parameter group 'to-address)))
(when group
(setq group (gnus-group-real-name group)))
(if (or to-group
- (and (gnus-member-of-valid 'post (or group gnus-newsgroup-name))
+ (and (gnus-member-of-valid 'post (or pgroup gnus-newsgroup-name))
(not mailing-list)
(not to-address)))
;; This is news.
(fboundp gnus-post-prepare-function)
(funcall gnus-post-prepare-function group))
(goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (forward-line 1)
- (goto-char (point-max)))
+ (if group
+ (re-search-forward "^Subject: " nil t)
+ (re-search-forward "^Newsgroups: " nil t))
(run-hooks 'gnus-post-prepare-hook)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(defun gnus-inews-insert-bfcc ()
"Insert Bcc and Fcc headers."
(save-excursion
- (save-restriction
- (gnus-inews-narrow-to-headers)
- ;; Handle author copy using BCC field.
- (if (and gnus-mail-self-blind
+ ;; Handle author copy using BCC field.
+ (when (and gnus-mail-self-blind
(not (mail-fetch-field "bcc")))
- (progn
- (mail-position-on-field "Bcc")
- (insert (if (stringp gnus-mail-self-blind)
- gnus-mail-self-blind
- (user-login-name)))))
- ;; Handle author copy using FCC field.
- (if gnus-author-copy
- (progn
- (mail-position-on-field "Fcc")
- (insert gnus-author-copy))))))
+ (mail-position-on-field "Bcc")
+ (insert (if (stringp gnus-mail-self-blind)
+ gnus-mail-self-blind
+ (user-login-name))))
+ ;; Handle author copy using FCC field.
+ (when gnus-author-copy
+ (mail-position-on-field "Fcc")
+ (insert gnus-author-copy))))
(defun gnus-inews-insert-gcc ()
(let* ((group gnus-outgoing-message-group)
(require 'gnus-ems)
(require 'easymenu)
(require 'custom)
+(require 'browse-url)
+(eval-when-compile (require 'cl))
(defvar gnus-group-menu-hook nil
"*Hook run after the creation of the group mode menu.")
(assq (1+ lines) gnus-cite-attribution-alist)))
gnus-button-message-id 3)
;; This is how URLs _should_ be embedded in text...
- ("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
+ ("<URL:\\([^\n\r>]*\\)>" 0 t browse-url-browser-function 1)
;; Next regexp stolen from highlight-headers.el.
;; Modified by Vladimir Alexiev.
- (,gnus-button-url-regexp 0 t gnus-button-url 0))
+ (,gnus-button-url-regexp 0 t browse-url-browser-function 0))
"Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0))
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url-browser-function 0))
"Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
;(eval-when-compile
; (defvar browse-url-browser-function))
-;see gnus-cus.el
-;(defvar gnus-button-url
-; (cond ((boundp 'browse-url-browser-function) browse-url-browser-function)
-; ((fboundp 'w3-fetch) 'w3-fetch)
-; ((eq window-system 'x) 'gnus-netscape-open-url))
-; "*Function to fetch URL.
-;The function will be called with one argument, the URL to fetch.
-;Useful values of this function are:
-
-;w3-fetch:
-; defined in the w3 emacs package by William M. Perry.
-;gnus-netscape-open-url:
-; open url in existing netscape, start netscape if none found.
-;gnus-netscape-start-url:
-; start new netscape with url.")
-
\f
(eval-and-compile
(let* ((beg (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point)))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
- (from (if (get-text-property beg 'mouse-face)
+ (from (if (get-text-property beg gnus-mouse-face-prop)
beg
(1+ (or (next-single-property-change
- beg 'mouse-face nil end)
+ beg gnus-mouse-face-prop nil end)
beg))))
(to (1- (or (next-single-property-change
- from 'mouse-face nil end)
+ from gnus-mouse-face-prop nil end)
end))))
;; If no mouse-face prop on line (e.g. xemacs) we
;; will have to = from = end, so we highlight the
(prog2 (insert (car button)) (point) (insert " "))
(list 'gnus-callback (cdr button)
'face gnus-carpal-button-face
- 'mouse-face 'highlight))))
+ gnus-mouse-face-prop 'highlight))))
(let ((fill-column (- (window-width) 2)))
(fill-region (point-min) (point-max)))
(set-window-point (get-buffer-window (current-buffer))
(add-text-properties
from to
(nconc (and gnus-article-mouse-face
- (list 'mouse-face gnus-article-mouse-face))
+ (list gnus-mouse-face-prop gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data)))))
(progn
(setq info (nth 2 entry))
(gnus-group-insert-group-line
- nil group (gnus-info-group info) (gnus-info-marks info)
+ nil group (gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))
(setq active (gnus-gethash group gnus-active-hashtb))
(or (boundp 'standard-display-table) (setq standard-display-table nil))
(or (boundp 'read-event) (fset 'read-event 'next-command-event))
+ (defvar gnus-mouse-face-prop 'highlight)
+
;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
(defvar gnus-display-type (device-class)
"A symbol indicating the display Emacs is running under.
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.13"
+(defconst gnus-version "September Gnus v0.14"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
gnus-tmp-name))
gnus-tmp-closing-bracket
" " gnus-tmp-subject-or-nil "\n")
- (put-text-property b (+ b 28) 'mouse-face gnus-mouse-face)))
+ (put-text-property b (+ b 28) gnus-mouse-face-prop gnus-mouse-face)))
(defvar gnus-summary-line-format-spec
(gnus-byte-code 'gnus-summary-line-format-spec))
(format "%5s: " gnus-tmp-number-of-unread-unticked))
(let ((b (point)))
(insert gnus-tmp-group "\n")
- (put-text-property b (1- (point)) 'mouse-face gnus-mouse-face)))
+ (put-text-property b (1- (point)) gnus-mouse-face-prop gnus-mouse-face)))
(defvar gnus-group-line-format-spec
(gnus-byte-code 'gnus-group-line-format-spec))
(defmacro gnus-gethash (string hashtable)
"Get hash value of STRING in HASHTABLE."
- ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
- ;;(` (abbrev-expansion (, string) (, hashtable)))
(` (symbol-value (intern-soft (, string) (, hashtable)))))
(defmacro gnus-sethash (string value hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
- ;; We cannot use define-abbrev since it only accepts string as value.
- ;; (set (intern string hashtable) value))
(` (set (intern (, string) (, hashtable)) (, value))))
+(defmacro gnus-intern-safe (string hashtable)
+ "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
+ `(let ((symbol (intern ,string ,hashtable)))
+ (or (boundp symbol)
+ (setq symbol nil))
+ symbol))
+
+(defmacro gnus-active (group)
+ "Get active info on GROUP."
+ `(gnus-gethash ,group gnus-active-hashtb))
+
+(defmacro gnus-set-active (group active)
+ "Set GROUP's active info."
+ `(gnus-sethash ,group ,active gnus-active-hashtb))
+
;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; function `substring' might cut on a middle of multi-octet
;; character.
(save-excursion
(let ((gnus-process-mark 128)
(gnus-group-marked '("dummy.group")))
- (gnus-sethash "dummy.group" '(0 . 0) gnus-active-hashtb)
+ (gnus-set-active "dummy.group" '(0 . 0))
(gnus-set-work-buffer)
(gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil)
(goto-char (point-min))
(defun gnus-mouse-face-function (form)
(` (put-text-property
(point) (progn (insert (, form)) (point))
- 'mouse-face gnus-mouse-face)))
+ ,gnus-mouse-face-prop gnus-mouse-face)))
(defun gnus-max-width-function (el max-width)
(or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
(` (let ((val (eval (, el))))
(if (numberp val)
- (setq val (int-to-string val) val))
+ (setq val (int-to-string val)))
(if (> (length val) (, max-width))
(substring val 0 (, max-width))
val))))
gnus-newsgroup-headers nil
gnus-newsgroup-name nil
gnus-server-alist nil
+ gnus-opened-servers nil
gnus-current-select-method nil)
;; Reset any score variables.
(and gnus-use-scoring (gnus-score-close))
;; one. If no next one can be found, just leave point at the
;; first newsgroup in the buffer.
(if (not (gnus-goto-char
- (text-property-any (point-min) (point-max)
- 'gnus-group (intern group))))
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
(let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
(while (and newsrc
(not (gnus-goto-char
(text-property-any
(point-min) (point-max) 'gnus-group
- (intern (car (car newsrc)))))))
+ (gnus-intern-safe
+ (car (car newsrc)) gnus-active-hashtb)))))
(setq newsrc (cdr newsrc)))
(or newsrc (progn (goto-char (point-max))
(forward-line -1))))))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: " group "\n"))
- (list 'gnus-group (intern group)
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-unread t
'gnus-level level))))
;; This loop is used when listing all groups.
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(setq group (pop groups)) "\n"))
- (list 'gnus-group (intern group)
+ (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-unread t
'gnus-level level))))))
(progn
(setcar (nthcdr 2 entry) info)
(if (and (not (eq (car entry) t))
- (gnus-gethash (gnus-info-group info) gnus-active-hashtb))
+ (gnus-active (gnus-info-group info)))
(let ((marked (gnus-info-marks info)))
(setcar entry (length (gnus-list-of-unread-articles
(car info)))))))
active info)
(if entry
(progn
+ ;; (Un)subscribed group.
(setq info (nth 2 entry))
(gnus-group-insert-group-line
nil group (gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))
- (setq active (gnus-gethash group gnus-active-hashtb))
+ ;; This group is dead.
(gnus-group-insert-group-line
nil group
(if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
- nil (if active (- (1+ (cdr active)) (car active)) 0) nil))))
+ nil
+ (if (setq active (gnus-active group))
+ (- (1+ (cdr active)) (car active)) 0)
+ nil))))
(defun gnus-group-insert-group-line
(gformat gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number
gnus-tmp-method)
(let* ((gformat (or gformat gnus-group-line-format-spec))
- (gnus-tmp-active (gnus-gethash gnus-tmp-group gnus-active-hashtb))
+ (gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
(if gnus-tmp-active
(1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
(eval gformat)
(add-text-properties
- b (1+ b) (list 'gnus-group (intern gnus-tmp-group)
+ b (1+ b) (list 'gnus-group (gnus-intern-safe
+ gnus-tmp-group gnus-active-hashtb)
'gnus-unread (if (numberp gnus-tmp-number)
(string-to-int
gnus-tmp-number-of-unread-unticked)
;; The buffer may be narrowed.
(save-restriction
(widen)
- (let ((ident (intern group))
+ (let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
found buffer-read-only visible)
;; Enter the current status into the dribble buffer.
(gnus-goto-char
(text-property-any
(point-min) (point-max)
- 'gnus-group (intern (car (car entry)))))))
+ 'gnus-group (gnus-intern-safe
+ (car (car entry))
+ gnus-active-hashtb)))))
(setq entry (cdr entry)))
(or entry (goto-char (point-max))))
;; Finally insert the line.
(setq number
(cond ((numberp all) all)
(entry (car entry))
- ((setq active (gnus-gethash group gnus-active-hashtb))
+ ((setq active (gnus-active group))
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
(error "Empty group name"))
(let ((b (text-property-any
- (point-min) (point-max) 'gnus-group (intern group))))
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
(if b
;; Either go to the line in the group buffer...
(goto-char b)
;; ... or insert the line.
(or
- (gnus-gethash group gnus-active-hashtb)
+ (gnus-active group)
(gnus-activate-group group)
(error "%s error: %s" group (gnus-status-message group)))
(gnus-group-update-group group)
(goto-char (text-property-any
- (point-min) (point-max) 'gnus-group (intern group)))))
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
;; Adjust cursor point.
(gnus-group-position-point))
(defun gnus-group-goto-group (group)
"Goto to newsgroup GROUP."
(let ((b (text-property-any (point-min) (point-max)
- 'gnus-group (intern group))))
+ 'gnus-group (gnus-intern-safe
+ group gnus-active-hashtb))))
(and b (goto-char b))))
(defun gnus-group-next-group (n)
(gnus-gethash (gnus-group-group-name)
gnus-newsrc-hashtb))
t)
- (gnus-sethash nname (cons 1 0) gnus-active-hashtb)
+ (gnus-set-active nname (cons 1 0))
(or (gnus-ephemeral-group-p name)
(gnus-dribble-enter
(concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
(gnus-group-update-group group))
((and (stringp group)
(or (not (memq gnus-select-method gnus-have-read-active-file))
- (gnus-gethash group gnus-active-hashtb)))
+ (gnus-active group)))
;; Add new newsgroup.
(gnus-group-change-level
group
(defun gnus-get-new-news-in-group (group)
(when (and group (gnus-activate-group group 'scan))
(gnus-get-unread-articles-in-group
- (gnus-get-info group) (gnus-gethash group gnus-active-hashtb))
+ (gnus-get-info group) (gnus-active group))
(gnus-group-update-group-line)
t))
(mapatoms
(lambda (group)
(and (string-match regexp (symbol-value group))
- (gnus-gethash (symbol-name group) gnus-active-hashtb)
+ (gnus-active (symbol-name group))
(setq groups (cons (symbol-name group) groups))))
gnus-description-hashtb))
(if (not groups)
'(progn
(gnus-summary-skip-intangible)
(or (get-text-property (point) 'gnus-number)
- gnus-newsgroup-end)))
+ (progn
+ (forward-line -1)
+ gnus-newsgroup-end))))
(defmacro gnus-summary-article-header (&optional number)
(` (gnus-data-header (gnus-data-find
;; Save the active value in effect when the group was entered.
(setq gnus-newsgroup-active
(gnus-copy-sequence
- (gnus-gethash gnus-newsgroup-name gnus-active-hashtb)))
+ (gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
(run-hooks 'gnus-select-group-hook)
;; Set any local variables in the group parameters.
sub nil))
(setq sub (cdr sub))))
;; It's an ordinary thread, so we check it.
- (when (member (car sub) headers)
+ (when (eq (car sub) (car headers))
(setq thread sub
threads nil)))
(setq threads (cdr threads)))
(let ((name (intern (format "gnus-newsgroup-%s" (car thing)))))
(set name (copy-sequence (cdr (assq (cdr thing) marked))))))
'((marked . tick) (replied . reply)
- (exirable . expire) (killed . killed)
+ (expirable . expire) (killed . killed)
(bookmarks . bookmark) (dormant . dormant)
(scored . score)))))
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
- (zerop (length gnus-newsgroup-unreads)))
- (if (zerop (length gnus-newsgroup-marked))
- (gnus-uncompress-range
- (gnus-gethash group gnus-active-hashtb))
- gnus-newsgroup-marked)
+ (and (zerop (length gnus-newsgroup-marked))
+ (zerop (length gnus-newsgroup-unreads))))
+ (gnus-uncompress-range (gnus-active group))
(sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
(copy-sequence gnus-newsgroup-unreads))
'<)))
read-all)
(t
(condition-case ()
- (cond ((and (or (<= scored marked)
- (= scored number))
- (numberp gnus-large-newsgroup)
- (> number gnus-large-newsgroup))
- (let ((input
- (read-string
- (format
- "How many articles from %s (default %d): "
- gnus-newsgroup-name number))))
- (if (string-match "^[ \t]*$" input)
- number input)))
- ((and (> scored marked) (< scored number))
- (let ((input
- (read-string
- (format
- "%s %s (%d scored, %d total): "
- "How many articles from"
- group scored number))))
- (if (string-match "^[ \t]*$" input)
- number input)))
- (t number))
+ (cond
+ ((and (or (<= scored marked) (= scored number))
+ (numberp gnus-large-newsgroup)
+ (> number gnus-large-newsgroup))
+ (let ((input
+ (read-string
+ (format
+ "How many articles from %s (default %d): "
+ gnus-newsgroup-name number))))
+ (if (string-match "^[ \t]*$" input) number input)))
+ ((and (> scored marked) (< scored number))
+ (let ((input
+ (read-string
+ (format "%s %s (%d scored, %d total): "
+ "How many articles from"
+ group scored number))))
+ (if (string-match "^[ \t]*$" input)
+ number input)))
+ (t number))
(quit nil))))))
(setq select (if (stringp select) (string-to-number select) select))
(if (or (null select) (zerop select))
(defun gnus-adjust-marked-articles (info &optional active)
"Remove all marked articles that are no longer legal."
(let* ((marked-lists (gnus-info-marks info))
- (active (or active (gnus-gethash (gnus-info-group info)
- gnus-active-hashtb)))
+ (active (or active (gnus-active (gnus-info-group info))))
(min (car active))
m prev)
;; There are many types of marked articles.
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (active (gnus-gethash group gnus-active-hashtb))
+ (active (gnus-active group))
exps expirable range)
;; First peel off all illegal article numbers.
(if active
(set id-dep (list header)))))
(if header
(progn
- (if (boundp (setq ref-dep (intern (or ref "none")
- dependencies)))
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
(setcdr (symbol-value ref-dep)
(nconc (cdr (symbol-value ref-dep))
(list (symbol-value id-dep))))
"Find article ID and insert the summary line for that article."
(let ((header (gnus-read-header id))
number)
- (if (not header)
- () ; We couldn't fetch ID.
+ (when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
(gnus-rebuild-thread (mail-header-id header))
(gnus-summary-goto-subject (setq number (mail-header-number header)))
- (and (> number 0)
- (progn
- ;; We have to update the boundaries, possibly.
- (and (> number gnus-newsgroup-end)
- (setq gnus-newsgroup-end number))
- (and (< number gnus-newsgroup-begin)
- (setq gnus-newsgroup-begin number))
- (setq gnus-newsgroup-unselected
- (delq number gnus-newsgroup-unselected))))
+ (when (> number 0)
+ ;; We have to update the boundaries, possibly.
+ (and (> number gnus-newsgroup-end)
+ (setq gnus-newsgroup-end number))
+ (and (< number gnus-newsgroup-begin)
+ (setq gnus-newsgroup-begin number))
+ (setq gnus-newsgroup-unselected
+ (delq number gnus-newsgroup-unselected)))
;; Report back a success.
number)))
;; the range of active articles.
(defun gnus-list-of-unread-articles (group)
(let* ((read (gnus-info-read (gnus-get-info group)))
- (active (gnus-gethash group gnus-active-hashtb))
+ (active (gnus-active group))
(last (cdr active))
first nlast unread)
;; If none are read, then all are unread.
(defun gnus-list-of-read-articles (group)
(let* ((info (gnus-get-info group))
(marked (gnus-info-marks info))
- (active (gnus-gethash group gnus-active-hashtb)))
+ (active (gnus-active group)))
(and info active
(gnus-set-difference
(gnus-sorted-complement
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
(interactive "sMessage-ID: ")
- (if (or (not (stringp message-id))
- (zerop (length message-id)))
- ()
+ (when (and (stringp message-id)
+ (not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
- (or (string-match "^<" message-id)
- (setq message-id (concat "<" message-id)))
- (or (string-match ">$" message-id)
- (setq message-id (concat message-id ">")))
+ (unless (string-match "^<" message-id)
+ (setq message-id (concat "<" message-id)))
+ (unless (string-match ">$" message-id)
+ (setq message-id (concat message-id ">")))
(let ((header (car (gnus-gethash (downcase message-id)
gnus-newsgroup-dependencies))))
(if header
(gnus-summary-goto-article (mail-header-number header) nil t)
;; We fetch the article
(let ((gnus-override-method gnus-refer-article-method)
- (gnus-ancient-mark gnus-read-mark)
- (tmp-point (window-start
- (get-buffer-window gnus-article-buffer)))
- number tmp-buf)
- (and gnus-refer-article-method
- (gnus-check-server gnus-refer-article-method))
+ number)
+ ;; Start the special refer-article method, if necessary.
+ (when gnus-refer-article-method
+ (gnus-check-server gnus-refer-article-method))
+ ;; Fetch the header, and display the article.
(when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)))))))
(progn
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
- (or (gnus-gethash to-newsgroup gnus-active-hashtb)
+ (or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
(progn
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
- (or (gnus-gethash to-newsgroup gnus-active-hashtb)
+ (or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil)
plist)
- (if (not forward)
- ()
+ (when forward
;; Go to the right position on the line.
(forward-char forward)
;; Replace the old mark with the new mark.
(subst-char-in-region (point) (1+ (point)) (following-char) mark)
;; Optionally update the marks by some user rule.
- (and (eq type 'unread)
- (progn
- (gnus-data-set-mark (gnus-data-find (gnus-summary-article-number))
- mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
+ (when (eq type 'unread)
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(erase-buffer)
;; There may be some overlays that we have to kill...
(insert "i")
- (let ((overlays (overlays-at (point-min))))
+ (let ((overlays (and (fboundp 'overlays-at)
+ (overlays-at (point-min)))))
(while overlays
(delete-overlay (car overlays))
(setq overlays (cdr overlays))))
(defun gnus-headers-decode-quoted-printable ()
"Hack to remove QP encoding from headers."
(let ((case-fold-search t)
+ (inhibit-point-motion-hooks t)
string)
(goto-char (point-min))
- (while (re-search-forward "=?iso-8859-1?q?\\([^ \t\n]*\\)?=" nil t)
- (replace-match (setq string (match-string 1)) t t)
- (narrow-to-region
- (match-beginning 0) (+ (match-beginning 0) (length string)))
- (goto-char (point-min))
- (while (search-forward "_" nil t)
- (replace-match " "))
- (gnus-mime-decode-quoted-printable (point-min) (point-max))
- (widen))))
+ (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
+ (setq string (match-string 1))
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (widen)
+ (goto-char (point-min)))))
(defun gnus-article-de-quoted-unreadable (&optional force)
"Do a naive translation of a quoted-printable-encoded article.
(gnus-headers-decode-quoted-printable)))))
(defun gnus-mime-decode-quoted-printable (from to)
- ;; Decode quoted-printable from region between FROM and TO.
+ "Decode Quoted-Printable in the region between FROM and TO."
(goto-char from)
(while (search-forward "=" to t)
(cond ((eq (following-char) ?\n)
(gnus-narrow-to-headers)
(let ((buffer-read-only nil))
;; Delete any old Date headers.
- (when (zerop (nnheader-remove-header date-regexp t))
+ (if (zerop (nnheader-remove-header date-regexp t))
+ (beginning-of-line)
(goto-char (point-max)))
(insert
(cond
(funcall (gnus-get-function method 'open-server)
(nth 1 method) (nthcdr 2 method))))
;; If this hasn't been opened before, we add it to the list.
- (or elem
- (setq elem (list method nil)
- gnus-opened-servers (cons elem gnus-opened-servers)))
+ (unless elem
+ (setq elem (list method nil)
+ gnus-opened-servers (cons elem gnus-opened-servers)))
;; Set the status of this server.
(setcar (cdr elem) (if result 'ok 'denied))
;; Return the result from the "open" call.
;; The group is already known.
()
(and (symbol-value group-sym)
- (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb))
+ (gnus-set-active group (symbol-value group-sym)))
(let ((do-sub (gnus-matches-options-n group)))
(cond ((eq do-sub 'subscribe)
(setq groups (1+ groups))
(setq gnus-killed-list (cons group gnus-killed-list)))))))
gnus-active-hashtb)
(while groups
- (if (gnus-gethash (car groups) gnus-active-hashtb)
+ (if (gnus-active (car groups))
(gnus-group-change-level
(car groups) gnus-level-default-subscribed gnus-level-killed))
(setq groups (cdr groups)))
(progn
(setq info (cdr entry))
(setq num (car entry)))
- (setq active (gnus-gethash group gnus-active-hashtb))
+ (setq active (gnus-active group))
(setq num
(if active (- (1+ (cdr active)) (car active)) t))
;; Check whether the group is foreign. If so, the
;; Find all bogus newsgroup that are subscribed.
(while newsrc
(setq group (car (car newsrc)))
- (if (or (gnus-gethash group gnus-active-hashtb) ; Active
+ (if (or (gnus-active group) ; Active
(nth 4 (car newsrc)) ; Foreign
(and confirm
(not (gnus-y-or-n-p
(setq killed (symbol-value (car dead-lists)))
(while killed
(setq group (car killed))
- (or (gnus-gethash group gnus-active-hashtb)
+ (or (gnus-active group)
;; The group is bogus.
(set (car dead-lists)
(delete group (symbol-value (car dead-lists)))))
(while newsrc
(setq info (car newsrc)
group (gnus-info-group info)
- active (gnus-gethash group gnus-active-hashtb))
+ active (gnus-active group))
;; Check newsgroups. If the user doesn't want to check them, or
;; they can't be checked (for instance, if the news server can't
(gnus-get-unread-articles-in-group info active)
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
- (gnus-sethash group nil gnus-active-hashtb)
+ (gnus-set-active group nil)
(setcar (gnus-gethash group gnus-newsrc-hashtb) t))
(setq newsrc (cdr newsrc)))
(and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
(progn
(goto-char (match-beginning 1))
- (gnus-sethash
+ (gnus-set-active
group (setq active (cons (read (current-buffer))
- (read (current-buffer))))
- gnus-active-hashtb)
+ (read (current-buffer)))))
;; Return the new active info.
active))))))
UNREAD and TICKED lists.
Note: UNSELECTED has to be sorted over `<'.
Returns whether the updating was successful."
- (let* ((active (or gnus-newsgroup-active
- (gnus-gethash group gnus-active-hashtb)))
+ (let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
(marked (gnus-info-marks info))
(if domarks bookmark (cdr (assq 'bookmark marked)))
(if domarks score (cdr (assq 'score marked))))
;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group
- info (gnus-gethash group gnus-active-hashtb))
+ (gnus-get-unread-articles-in-group info (gnus-active group))
t)))
(defun gnus-make-articles-unread (group articles)
(defvar gnus-backlog-buffer " *Gnus Backlog*")
(defvar gnus-backlog-articles nil)
+(defvar gnus-backlog-hashtb nil)
(defun gnus-backlog-buffer ()
(or (get-buffer gnus-backlog-buffer)
(setq buffer-read-only t)
(gnus-add-current-to-buffer-list))))
+(defun gnus-backlog-setup ()
+ "Initialize backlog variables."
+ (unless gnus-backlog-hashtb
+ (setq gnus-backlog-hashtb (make-vector 1023 0))))
+
(defun gnus-backlog-enter-article (group number buffer)
- (let ((ident (intern (concat group ":" (int-to-string number))))
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
b)
(if (memq ident gnus-backlog-articles)
() ; It's already kept.
(1+ (point)) 'gnus-backlog nil (point-max)))))))
(defun gnus-backlog-request-article (group number buffer)
- (let ((ident (intern (concat group ":" (int-to-string number))))
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
beg end)
(if (not (memq ident gnus-backlog-articles))
() ; It wasn't in the backlog.
;;; Code:
(require 'mail-utils)
+(eval-when-compile (require 'cl))
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
(defvar nntp-current-server nil)
(defvar nntp-server-alist nil)
(defvar nntp-server-variables
- (list
- (list 'nntp-server-hook nntp-server-hook)
- (list 'nntp-server-opened-hook nntp-server-opened-hook)
- (list 'nntp-port-number nntp-port-number)
- (list 'nntp-address nntp-address)
- (list 'nntp-large-newsgroup nntp-large-newsgroup)
- (list 'nntp-buggy-select nntp-buggy-select)
- (list 'nntp-maximum-request nntp-maximum-request)
- (list 'nntp-debug-read nntp-debug-read)
- (list 'nntp-nov-is-evil nntp-nov-is-evil)
- (list 'nntp-xover-commands nntp-xover-commands)
- (list 'nntp-connection-timeout nntp-connection-timeout)
- (list 'nntp-news-default-headers nntp-news-default-headers)
- (list 'nntp-prepare-server-hook nntp-prepare-server-hook)
- (list 'nntp-async-number nntp-async-number)
- '(nntp-async-process nil)
- '(nntp-async-buffer nil)
- '(nntp-async-articles nil)
- '(nntp-async-fetched nil)
- '(nntp-async-group-alist nil)
- '(nntp-server-process nil)
- '(nntp-status-string nil)
- '(nntp-server-xover try)
- '(nntp-server-list-active-group try)
- '(nntp-current-group "")))
+ `((nntp-server-hook ,nntp-server-hook)
+ (nntp-server-opened-hook ,nntp-server-opened-hook)
+ (nntp-port-number ,nntp-port-number)
+ (nntp-address ,nntp-address)
+ (nntp-large-newsgroup ,nntp-large-newsgroup)
+ (nntp-buggy-select ,nntp-buggy-select)
+ (nntp-maximum-request ,nntp-maximum-request)
+ (nntp-debug-read ,nntp-debug-read)
+ (nntp-nov-is-evil ,nntp-nov-is-evil)
+ (nntp-xover-commands ,nntp-xover-commands)
+ (nntp-connection-timeout ,nntp-connection-timeout)
+ (nntp-news-default-headers ,nntp-news-default-headers)
+ (nntp-prepare-server-hook ,nntp-prepare-server-hook)
+ (nntp-async-number ,nntp-async-number)
+ (nntp-async-process nil)
+ (nntp-async-buffer nil)
+ (nntp-async-articles nil)
+ (nntp-async-fetched nil)
+ (nntp-async-group-alist nil)
+ (nntp-server-process nil)
+ (nntp-status-string nil)
+ (nntp-server-xover try)
+ (nntp-server-list-active-group try)
+ (nntp-current-group "")))
\f
;;; Interface functions.
-(defun nntp-retrieve-headers (sequence &optional newsgroup server fetch-old)
- "Retrieve the headers to the articles in SEQUENCE."
- (nntp-possibly-change-server newsgroup server)
+(defun nntp-retrieve-headers (articles &optional group server fetch-old)
+ "Retrieve the headers of ARTICLES."
+ (nntp-possibly-change-server group server)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
(if (and (not gnus-nov-is-evil)
(not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover sequence fetch-old))
+ (nntp-retrieve-headers-with-xover articles fetch-old))
+ ;; We successfully retrieved the headers via XOVER.
'nov
- (let ((number (length sequence))
+ ;; XOVER didn't work, so we do it the hard, slow and inefficient
+ ;; way.
+ (let ((number (length articles))
(count 0)
(received 0)
(last-point (point-min)))
;; Send HEAD command.
- (while sequence
+ (while articles
(nntp-send-strings-to-server
- "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence))
- (car sequence)))
- (setq sequence (cdr sequence)
+ "HEAD" (if (numberp (car articles))
+ (int-to-string (car articles))
+ ;; `articles' is either a list of article numbers
+ ;; or a list of article IDs.
+ (car articles)))
+ (setq articles (cdr articles)
count (1+ count))
- ;; Every 400 header requests we have to read stream in order
- ;; to avoid deadlock.
- (if (or (null sequence) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (progn
- (nntp-accept-response)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (message "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response)))))
+ ;; Every 400 header requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (message "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
+ (nntp-accept-response))))
;; Wait for text of last command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
- (if (looking-at "^[23]")
- (while (progn
- (goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(message "NNTP: Receiving headers...done"))
- ;; Now all of replies are received.
- (setq received number)
- ;; First, fold continuation lines.
+ ;; Now all of replies are received. Fold continuation lines.
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " "))
- ;; Remove all "\r"'s
+ (replace-match " " t t))
+ ;; Remove all "\r"'s.
(goto-char (point-min))
(while (search-forward "\r" nil t)
- (replace-match ""))
+ (replace-match "" t t))
'headers))))
(defun nntp-retrieve-groups (groups &optional server)
+ "Retrieve group info on GROUPS."
(nntp-possibly-change-server nil server)
(save-excursion
(set-buffer nntp-server-buffer)
- (and (eq nntp-server-list-active-group 'try)
- (nntp-try-list-active (car groups)))
+ ;; The first time this is run, this variable is `try'. So we
+ ;; try.
+ (when (eq nntp-server-list-active-group 'try)
+ (nntp-try-list-active (car groups)))
(erase-buffer)
(let ((count 0)
(received 0)
(last-point (point-min))
- (command (if nntp-server-list-active-group
- "LIST ACTIVE" "GROUP")))
+ (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
(while groups
+ ;; Send the command to the server.
(nntp-send-strings-to-server command (car groups))
(setq groups (cdr groups))
(setq count (1+ count))
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
- (if (or (null groups) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (progn
- (nntp-accept-response)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
- (nntp-accept-response)))))
+ (when (or (null groups) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (nntp-accept-response)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (nntp-accept-response))))
;; Wait for the reply from the final command.
- (if nntp-server-list-active-group
- (progn
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (if (looking-at "^[23]")
- (while (progn
- (goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))))
+ (when nntp-server-list-active-group
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response))))
;; Now all replies are received. We remove CRs.
(goto-char (point-min))
(while (search-forward "\r" nil t)
(replace-match "" t t))
- (if nntp-server-list-active-group
- (progn
- ;; We have read active entries, so we just delete the
- ;; superfluos gunk.
- (goto-char (point-min))
- (while (re-search-forward "^[.2-5]" nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- 'active)
- 'group))))
+ (if (not nntp-server-list-active-group)
+ 'group
+ ;; We have read active entries, so we just delete the
+ ;; superfluos gunk.
+ (goto-char (point-min))
+ (while (re-search-forward "^[.2-5]" nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ 'active))))
(defun nntp-open-server (server &optional defs)
(nnheader-init-server-buffer)
;; Empty message if nothing.
(or nntp-status-string "")))
-(defun nntp-request-article (id &optional newsgroup server buffer)
- "Request article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
+(defun nntp-request-article (id &optional group server buffer)
+ "Request article ID (Message-ID or number)."
+ (nntp-possibly-change-server group server)
(let (found)
;; First we see whether we can get the article from the async buffer.
- (if (and (numberp id)
- nntp-async-articles
- (memq id nntp-async-fetched))
- (save-excursion
- (set-buffer nntp-async-buffer)
- (let ((opoint (point))
- (art (if (numberp id) (int-to-string id) id))
- beg end)
- (if (and (or (re-search-forward (concat "^2.. +" art) nil t)
+ (when (and (numberp id)
+ nntp-async-articles
+ (memq id nntp-async-fetched))
+ (save-excursion
+ (set-buffer nntp-async-buffer)
+ (let ((opoint (point))
+ (art (if (numberp id) (int-to-string id) id))
+ beg end)
+ (when (and (or (re-search-forward (concat "^2.. +" art) nil t)
(progn
(goto-char (point-min))
(re-search-forward (concat "^2.. +" art) opoint t)))
(beginning-of-line)
(setq beg (point)
end (re-search-forward "^\\.\r?\n" nil t))))
- (progn
- (setq found t)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (insert-buffer-substring nntp-async-buffer beg end)
- (let ((nntp-server-buffer (current-buffer)))
- (nntp-decode-text)))
- (delete-region beg end)
- (and nntp-async-articles
- (nntp-async-fetch-articles id)))))))
+ (setq found t)
+ (save-excursion
+ (set-buffer (or buffer nntp-server-buffer))
+ (erase-buffer)
+ (insert-buffer-substring nntp-async-buffer beg end)
+ (let ((nntp-server-buffer (current-buffer)))
+ (nntp-decode-text)))
+ (delete-region beg end)
+ (when nntp-async-articles
+ (nntp-async-fetch-articles id))))))
(if found
id
(nntp-find-group-and-number)))
(nntp-decode-text)
(and nntp-async-articles (nntp-async-fetch-articles id)))))
- (if buffer (set-process-buffer
- nntp-server-process nntp-server-buffer))))))
+ (when buffer
+ (set-process-buffer nntp-server-process nntp-server-buffer))))))
-(defun nntp-request-body (id &optional newsgroup server)
- "Request body of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
+(defun nntp-request-body (id &optional group server)
+ "Request body of article ID (Message-ID or number)."
+ (nntp-possibly-change-server group server)
(prog1
;; If NEmacs, end of message may look like: "\256\215" (".^M")
(nntp-send-command
"^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
(nntp-decode-text)))
-(defun nntp-request-head (id &optional newsgroup server)
- "Request head of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
+(defun nntp-request-head (id &optional group server)
+ "Request head of article ID (Message-ID or number)."
+ (nntp-possibly-change-server group server)
(prog1
(and (nntp-send-command
"^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id))
(nntp-find-group-and-number)))
(nntp-decode-text)))
-(defun nntp-request-stat (id &optional newsgroup server)
- "Request STAT of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
+(defun nntp-request-stat (id &optional group server)
+ "Request STAT of article ID (Message-ID or number)."
+ (nntp-possibly-change-server group server)
(nntp-send-command
"^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
(defun nntp-request-group (group &optional server dont-check)
"Select GROUP."
- (nntp-send-command "^.*\r?\n" "GROUP" group)
- (setq nntp-current-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (looking-at "[23]")))
+ (setq nntp-current-group
+ (when (nntp-send-command "^2.*\r?\n" "GROUP" group)
+ group)))
(defun nntp-request-asynchronous (group &optional server articles)
- (and nntp-async-articles (nntp-async-request-group group))
- (and
- nntp-async-number
- (if (not (or (nntp-async-server-opened)
- (nntp-async-open-server)))
- (progn
- (message "Can't open second connection to %s" nntp-address)
- (ding)
- (setq nntp-async-articles nil)
- (sit-for 2))
- (setq nntp-async-articles articles)
- (setq nntp-async-fetched nil)
- (save-excursion
- (set-buffer nntp-async-buffer)
- (erase-buffer))
- (nntp-async-send-strings "GROUP" group)
- t)))
+ "Enable pre-fetch in GROUP."
+ (when nntp-async-articles
+ (nntp-async-request-group group))
+ (when nntp-async-number
+ (if (not (or (nntp-async-server-opened)
+ (nntp-async-open-server)))
+ ;; Couldn't open the second connection
+ (progn
+ (message "Can't open second connection to %s" nntp-address)
+ (ding)
+ (setq nntp-async-articles nil)
+ (sit-for 2))
+ ;; We opened the second connection (or it was opened already).
+ (setq nntp-async-articles articles)
+ (setq nntp-async-fetched nil)
+ ;; Clear any old data.
+ (save-excursion
+ (set-buffer nntp-async-buffer)
+ (erase-buffer))
+ ;; Select the correct current group on this server.
+ (nntp-async-send-strings "GROUP" group)
+ t)))
(defun nntp-list-active-group (group &optional server)
+ "Return the active info on GROUP (which can be a regexp."
+ (nntp-possibly-change-server group server)
(nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
(defun nntp-request-group-description (group &optional server)
- "Get description of GROUP."
- (if (nntp-possibly-change-server nil server)
- (prog1
- (nntp-send-command "^.*\r?\n" "XGTITLE" group)
- (nntp-decode-text))))
+ "Get the description of GROUP."
+ (nntp-possibly-change-server nil server)
+ (prog1
+ (nntp-send-command "^.*\r?\n" "XGTITLE" group)
+ (nntp-decode-text)))
(defun nntp-close-group (group &optional server)
+ "Close GROUP."
(setq nntp-current-group nil)
t)
(defun nntp-request-list (&optional server)
- "List active groups."
+ "List all active groups."
(nntp-possibly-change-server nil server)
(prog1
(nntp-send-command "^\\.\r?\n" "LIST")
(nntp-decode-text)))
(defun nntp-request-list-newsgroups (&optional server)
- "List groups."
+ "Get descriptions on all groups on SERVER."
(nntp-possibly-change-server nil server)
(prog1
(nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS")
(nntp-decode-text)))
(defun nntp-request-newgroups (date &optional server)
- "List new groups."
+ "List groups that have arrived since DATE."
(nntp-possibly-change-server nil server)
(let* ((date (timezone-parse-date date))
(time-string
(nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS")
(nntp-decode-text)))
-(defun nntp-request-last (&optional newsgroup server)
+(defun nntp-request-last (&optional group server)
"Decrease the current article pointer."
- (nntp-possibly-change-server newsgroup server)
+ (nntp-possibly-change-server group server)
(nntp-send-command "^[23].*\r?\n" "LAST"))
-(defun nntp-request-next (&optional newsgroup server)
+(defun nntp-request-next (&optional group server)
"Advance the current article pointer."
- (nntp-possibly-change-server newsgroup server)
+ (nntp-possibly-change-server group server)
(nntp-send-command "^[23].*\r?\n" "NEXT"))
(defun nntp-request-post (&optional server)
"Post the current buffer."
(nntp-possibly-change-server nil server)
- (if (nntp-send-command "^[23].*\r?\n" "POST")
- (progn
- (nntp-encode-text)
- (nntp-send-region-to-server (point-min) (point-max))
- ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
- ;; appended to end of the status message.
- (nntp-wait-for-response "^[23].*\n"))))
+ (when (nntp-send-command "^[23].*\r?\n" "POST")
+ (nntp-encode-text)
+ (nntp-send-region-to-server (point-min) (point-max))
+ ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+ ;; appended to end of the status message.
+ (nntp-wait-for-response "^[23].*\n")))
;;; Internal functions.
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (and (file-exists-p "~/.nntp-authinfo")
- (save-excursion
- (set-buffer (get-buffer-create " *tull*"))
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point)
- (progn (end-of-line) (point))))
- (kill-buffer (current-buffer)))))
+ (when (file-exists-p "~/.nntp-authinfo")
+ (save-excursion
+ (set-buffer (get-buffer-create " *authinfo*"))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents "~/.nntp-authinfo")
+ (goto-char (point-min))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command
+ "^.*\r?\n" "AUTHINFO PASS"
+ (buffer-substring (point) (progn (end-of-line) (point))))
+ (kill-buffer (current-buffer)))))
(defun nntp-default-sentinel (proc status)
"Default sentinel function for NNTP server process."
(car servers))))))
(setq servers (cdr servers)))
(setq server (car (car servers))))
- (and server
- nntp-warn-about-losing-connection
- (progn
- (message "nntp: Connection closed to server %s" server)
- (ding)))))
+ (when (and server
+ nntp-warn-about-losing-connection)
+ (message "nntp: Connection closed to server %s" server)
+ (ding))))
(defun nntp-kill-connection (server)
+ "Choke the connection to SERVER."
(let ((proc (nth 1 (assq 'nntp-server-process
(assoc server nntp-server-alist)))))
- (and proc (delete-process (process-name proc)))
+ (when proc
+ (delete-process (process-name proc)))
(nntp-close-server server)
(setq nntp-status-string
(message "Connection timed out to server %s." server))
(goto-char (point-max))
(or (bolp) (insert "\n"))
;; Delete status line.
- (goto-char (point-min))
- (delete-region (point) (progn (forward-line 1) (point)))
- ;; Delete `^M' at the end of lines.
- (while (not (eobp))
- (end-of-line)
- (and (= (preceding-char) ?\r)
- (delete-char -1))
- (forward-line 1))
+ (delete-region (goto-char (point-min)) (progn (forward-line 1) (point)))
+ ;; Delete `^M's.
+ (while (search-forward "\r" nil t)
+ (replace-match "" t t))
;; Delete `.' at end of the buffer (end of text mark).
(goto-char (point-max))
(forward-line -1)
- (if (looking-at "^\\.\n")
- (delete-region (point) (progn (forward-line 1) (point))))
+ (when (looking-at "^\\.\n")
+ (delete-region (point) (progn (forward-line 1) (point))))
;; Replace `..' at beginning of line with `.'.
(goto-char (point-min))
;; (replace-regexp "^\\.\\." ".")
1. Insert `.' at beginning of line.
2. Insert `.' at end of buffer (end of text mark)."
(save-excursion
- ;; Insert newline at end of buffer.
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
;; Replace `.' at beginning of line with `..'.
(goto-char (point-min))
- ;; (replace-regexp "^\\." "..")
(while (search-forward "\n." nil t)
(insert "."))
- ;; Insert `.' at end of buffer (end of text mark).
(goto-char (point-max))
+ ;; Insert newline at end of buffer.
+ (or (bolp) (insert "\n"))
+ ;; Insert `.' at end of buffer (end of text mark).
(insert ".\r\n")))
\f
;;;
-;;; Synchronous Communication with NNTP Server.
+;;; Synchronous Communication with NNTP servers.
;;;
(defun nntp-send-command (response cmd &rest args)
(end-of-line)
(setq nntp-status-string
(buffer-substring (point-min) (point)))
- (if status
- (progn
- (setq wait t)
- (while wait
- (goto-char (point-max))
- (forward-line -1) ;(beginning-of-line)
- ;;(message (buffer-substring
- ;; (point)
- ;; (save-excursion (end-of-line) (point))))
- (if (looking-at regexp)
- (setq wait nil)
- (if nntp-debug-read
- (let ((newnum (/ (buffer-size) dotsize)))
- (if (not (= dotnum newnum))
- (progn
- (setq dotnum newnum)
- (message "NNTP: Reading %s"
- (make-string dotnum ?.))))))
- (nntp-accept-response)))
- ;; Remove "...".
- (if (and nntp-debug-read (> dotnum 0))
- (message ""))
- ;; Successfully received server response.
- t)))))
+ (when status
+ (setq wait t)
+ (while wait
+ (goto-char (point-max))
+ (forward-line -1)
+ (if (looking-at regexp)
+ (setq wait nil)
+ (when nntp-debug-read
+ (let ((newnum (/ (buffer-size) dotsize)))
+ (if (not (= dotnum newnum))
+ (progn
+ (setq dotnum newnum)
+ (message "NNTP: Reading %s"
+ (make-string dotnum ?.))))))
+ (nntp-accept-response)))
+ ;; Remove "...".
+ (when (and nntp-debug-read (> dotnum 0))
+ (message ""))
+ ;; Successfully received server response.
+ t))))
\f
(string-match (format "\\([^ :]+\\):%d" number) xref))
(substring xref (match-beginning 1) (match-end 1)))
(t "")))
- (and (string-match "\r" group)
- (setq group (substring group 0 (match-beginning 0))))
+ (when (string-match "\r" group)
+ (setq group (substring group 0 (match-beginning 0))))
(cons group number)))))
-(defun nntp-retrieve-headers-with-xover (sequence &optional fetch-old)
+(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
(erase-buffer)
(cond
(nntp-send-xover-command
(if fetch-old
(if (numberp fetch-old)
- (max 1 (- (car sequence) fetch-old))
+ (max 1 (- (car articles) fetch-old))
1)
- (car sequence))
- (nntp-last-element sequence) 'wait)
+ (car articles))
+ (nntp-last-element articles) 'wait)
(goto-char (point-min))
- (if (looking-at "[1-5][0-9][0-9] ")
- (delete-region (point) (progn (forward-line 1) (point))))
+ (when (looking-at "[1-5][0-9][0-9] ")
+ (delete-region (point) (progn (forward-line 1) (point))))
(while (search-forward "\r" nil t)
(replace-match "" t t))
(goto-char (point-max))
(forward-line -1)
- (if (looking-at "\\.")
- (delete-region (point) (progn (forward-line 1) (point)))))
+ (when (looking-at "\\.")
+ (delete-region (point) (progn (forward-line 1) (point)))))
;; We do it the hard way. For each gap, an XOVER command is sent
;; to the server. We do not wait for a reply from the server, we
;; We have to check `nntp-server-xover'. If it gets set to nil,
;; that means that the server does not understand XOVER, but we
;; won't know that until we try.
- (while (and nntp-server-xover sequence)
- (setq first (car sequence))
+ (while (and nntp-server-xover articles)
+ (setq first (car articles))
;; Search forward until we find a gap, or until we run out of
;; articles.
- (while (and (cdr sequence)
- (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap))
- (setq sequence (cdr sequence)))
+ (while (and (cdr articles)
+ (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
+ (setq articles (cdr articles)))
- (if (not (nntp-send-xover-command first (car sequence)))
- ()
- (setq sequence (cdr sequence)
+ (when (nntp-send-xover-command first (car articles))
+ (setq articles (cdr articles)
count (1+ count))
;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks.
- (if (or (null sequence) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (progn
- (accept-process-output)
- ;; On some Emacs versions the preceding function has
- ;; a tendency to change the buffer. Perhaps. It's
- ;; quite difficult to reporduce, because it only
- ;; seems to happen once in a blue moon.
- (set-buffer buf)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
- (accept-process-output)
- (set-buffer buf))))))
-
- (if (not nntp-server-xover)
- ()
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (accept-process-output)
+ ;; On some Emacs versions the preceding function has
+ ;; a tendency to change the buffer. Perhaps. It's
+ ;; quite difficult to reporduce, because it only
+ ;; seems to happen once in a blue moon.
+ (set-buffer buf)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output)
+ (set-buffer buf)))))
+
+ (when nntp-server-xover
;; Wait for the reply from the final command.
(goto-char (point-max))
(re-search-backward "^[0-9][0-9][0-9] " nil t)
- (if (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))
+ (when (looking-at "^[23]")
+ (while (progn
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (looking-at "^\\.\r?\n")))
+ (nntp-accept-response)))
;; We remove any "." lines and status lines.
(goto-char (point-min))
nntp-server-xover)
(defun nntp-send-xover-command (beg end &optional wait-for-reply)
+ "Send the XOVER command to the server."
(let ((range (format "%d-%d" beg end)))
(if (stringp nntp-server-xover)
;; If `nntp-server-xover' is a string, then we just send this
(if wait-for-reply
(nntp-send-command "^\\.\r?\n" nntp-server-xover range)
;; We do not wait for the reply.
- (progn
- (nntp-send-strings-to-server nntp-server-xover range)
- t))
+ (nntp-send-strings-to-server nntp-server-xover range))
(let ((commands nntp-xover-commands))
;; `nntp-xover-commands' is a list of possible XOVER commands.
;; We try them all until we get at positive response.
(setq nntp-server-xover (car commands))))
(setq commands (cdr commands)))
;; If none of the commands worked, we disable XOVER.
- (if (eq nntp-server-xover 'try)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq nntp-server-xover nil)))
+ (when (eq nntp-server-xover 'try)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (setq nntp-server-xover nil)))
nntp-server-xover))))
(defun nntp-send-strings-to-server (&rest strings)
- "Send list of STRINGS to news server as command and its arguments."
+ "Send STRINGS to the server."
(let ((cmd (concat (mapconcat 'identity strings " ") "\r\n")))
;; We open the nntp server if it is down.
(or (nntp-server-opened nntp-current-server)
(nntp-open-server nntp-current-server)
(error (nntp-status-message)))
;; Send the strings.
- (process-send-string nntp-server-process cmd)))
+ (process-send-string nntp-server-process cmd)
+ t))
(defun nntp-send-region-to-server (begin end)
- "Send current buffer region (from BEGIN to END) to news server."
+ "Send the current buffer region (from BEGIN to END) to the server."
(save-excursion
- ;; We have to work in the buffer associated with NNTP server
- ;; process because of NEmacs hack.
- (copy-to-buffer nntp-server-buffer begin end)
- (set-buffer nntp-server-buffer)
- (setq begin (point-min))
- (setq end (point-max))
- ;; `process-send-region' does not work if text to be sent is very
- ;; large. I don't know maximum size of text sent correctly.
- (let ((last nil)
+ ;; If we're not the the nntp server buffer, we copy the region
+ ;; over to that buffer.
+ (if (eq (get-buffer nntp-server-buffer) (current-buffer))
+ (let ((orig (current-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring orig begin end))
+ ;; We are in the nntp buffer, so we just narrow it.
+ (narrow-to-region begin end))
+ ;; `process-send-region' does not work if the text to be sent is very
+ ;; large, so we send it piecemeal.
+ (let ((last (point-min))
(size 100)) ;Size of text sent at once.
- (save-restriction
- (narrow-to-region begin end)
- (goto-char begin)
- (while (not (eobp))
- ;;(setq last (min end (+ (point) size)))
- ;; NEmacs gets confused if character at `last' is Kanji.
- (setq last (save-excursion
- (goto-char (min end (+ (point) size)))
- (or (eobp) (forward-char 1)) ;Adjust point
- (point)))
- (process-send-region nntp-server-process (point) last)
- ;; I don't know whether the next codes solve the known
- ;; problem of communication error of GNU Emacs.
- (accept-process-output)
- ;;(sit-for 0)
- (goto-char last))))
- ;; We cannot erase buffer, because reply may be received.
- (delete-region begin end)))
+ (while (/= last (point-max))
+ (process-send-region
+ nntp-server-process last (setq last (min (+ last size) (point-max))))
+ ;; Read any output from the server. May be unnecessary.
+ (accept-process-output)))
+ ;; Delete the area we sent.
+ (delete-region (point-min) (point-max))
+ (widen)))
(defun nntp-open-server-semi-internal (server &optional service)
"Open SERVER.
(setq list (cdr list)))
(car list))
-(defun nntp-possibly-change-server (newsgroup server)
- ;; We see whether it is necessary to change the newsgroup.
- (and newsgroup
+(defun nntp-possibly-change-server (group server)
+ ;; We see whether it is necessary to change the group.
+ (and group
(progn
- (not (equal newsgroup nntp-current-group))
- (nntp-request-group newsgroup server)))
+ (not (equal group nntp-current-group))
+ (nntp-request-group group server)))
(and server
(or (nntp-server-opened server)
(nntp-open-server server))))
projects / gnus / commitdiff