*** pub/sgnus/lisp/gnus-cache.el Thu Jan 18 03:06:24 1996 --- sgnus/lisp/gnus-cache.el Sat Jan 20 07:37:52 1996 *************** *** 269,275 **** (gnus-cache-braid-heads group cached) type))))) ! (defun gnus-cache-enter-article (n) "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles entered." --- 269,275 ---- (gnus-cache-braid-heads group cached) type))))) ! (defun gnus-cache-enter-article (&optional n) "Enter the next N articles into the cache. If not given a prefix, use the process marked articles instead. Returns the list of articles entered." *************** *** 447,466 **** (defun gnus-jog-cache () "Go through all groups and put the articles into the cache." (interactive) ! (let ((newsrc (cdr gnus-newsrc-alist)) ! (gnus-cache-enter-articles '(unread)) ! (gnus-mark-article-hook nil) (gnus-expert-user t) (nnmail-spool-file nil) (gnus-use-dribble-file nil) (gnus-novice-user nil) (gnus-large-newsgroup nil)) ! (while newsrc ! (gnus-summary-read-group (car (pop newsrc)) nil t) ! (when (eq major-mode 'gnus-summary-mode) ! (while gnus-newsgroup-unreads ! (gnus-summary-select-article t t nil (pop gnus-newsgroup-unreads))) ! (kill-buffer (current-buffer)))))) (defun gnus-cache-read-active (&optional force) "Read the cache active file." --- 447,471 ---- (defun gnus-jog-cache () "Go through all groups and put the articles into the cache." (interactive) ! (let ((gnus-mark-article-hook nil) (gnus-expert-user t) (nnmail-spool-file nil) (gnus-use-dribble-file nil) (gnus-novice-user nil) (gnus-large-newsgroup nil)) ! ;; Start Gnus. ! (gnus) ! ;; Go through all groups... ! (gnus-group-mark-buffer) ! (gnus-group-universal-argument ! nil nil ! (lambda () ! (gnus-summary-read-group nil nil t) ! ;; ... and enter the articles into the cache. ! (when (eq major-mode 'gnus-summary-mode) ! (gnus-uu-mark-buffer) ! (gnus-cache-enter-article) ! (kill-buffer (current-buffer))))))) (defun gnus-cache-read-active (&optional force) "Read the cache active file." *** pub/sgnus/lisp/gnus-cite.el Thu Jan 18 03:06:24 1996 --- sgnus/lisp/gnus-cite.el Sat Jan 20 01:56:31 1996 *************** *** 33,38 **** --- 33,44 ---- ;;; Customization: + (defvar gnus-cited-text-button-line-format "%(%{[...]%}%)" + "Format of cited text buttons.") + + (defvar gnus-cited-lines-visible nil + "The number of lines of hidden cited text to remain visible.") + (defvar gnus-cite-parse-max-size 25000 "Maximum article size (in bytes) where parsing citations is allowed. Set it to nil to parse all articles.") *************** *** 134,139 **** --- 140,151 ---- ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a SuperCite tag, if any. + (defvar gnus-cited-text-button-line-format-alist + `((?b beg ?d) + (?e end ?d) + (?l (- end beg) ?d))) + (defvar gnus-cited-text-button-line-format-spec nil) + ;;; Commands: (defun gnus-article-highlight-citation (&optional force) *************** *** 207,223 **** skip (gnus-cite-find-prefix number)) (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-article-fill-cited-article (&optional force) ! "Do word wrapping in the current article." ! (interactive (list t)) (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) ! (let ((buffer-read-only nil) ! (alist gnus-cite-prefix-alist) ! (inhibit-point-motion-hooks t) ! prefix numbers number marks ! (adaptive-fill-mode nil)) ;; Loop through citation prefixes. (while alist (setq numbers (pop alist) --- 219,231 ---- skip (gnus-cite-find-prefix number)) (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-dissect-cited-text () ! "Dissect the article buffer looking for cited text." (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe) ! (let ((alist gnus-cite-prefix-alist) ! prefix numbers number marks) ;; Loop through citation prefixes. (while alist (setq numbers (pop alist) *************** *** 253,259 **** (push (car omarks) marks)) (setq omarks (cdr omarks))) (push (car omarks) marks) ! (setq marks (nreverse marks))) (save-restriction (while (cdr marks) (widen) --- 261,277 ---- (push (car omarks) marks)) (setq omarks (cdr omarks))) (push (car omarks) marks) ! (nreverse marks))))) ! ! (defun gnus-article-fill-cited-article (&optional force) ! "Do word wrapping in the current article." ! (interactive (list t)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (marks (gnus-dissect-cited-text)) ! (adaptive-fill-mode nil)) (save-restriction (while (cdr marks) (widen) *************** *** 261,268 **** (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdr (car marks))) " *")) ! (fill-prefix (cdr (car marks))) ! ) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) --- 279,285 ---- (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdr (car marks))) " *")) ! (fill-prefix (cdr (car marks)))) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) *************** *** 274,299 **** If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (list current-prefix-arg 'force)) (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) ! (alist gnus-cite-prefix-alist) (inhibit-point-motion-hooks t) (props (nconc (list 'gnus-type 'cite) gnus-hidden-properties)) ! numbers number) ! (while alist ! (setq numbers (cdr (car alist)) ! alist (cdr alist)) ! (while numbers ! (setq number (car numbers) ! numbers (cdr numbers)) ! (goto-line number) ! (or (assq number gnus-cite-attribution-alist) ! (add-text-properties ! (point) (progn (forward-line 1) (point)) props)))))))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. --- 291,343 ---- If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (list current-prefix-arg 'force)) + (setq gnus-cited-text-button-line-format-spec + (gnus-parse-format gnus-cited-text-button-line-format + gnus-cited-text-button-line-format-alist t)) (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) ! (marks (gnus-dissect-cited-text)) (inhibit-point-motion-hooks t) (props (nconc (list 'gnus-type 'cite) gnus-hidden-properties)) ! beg end) ! (while marks ! (setq beg nil ! end nil) ! (while (and marks (string= (cdar marks) "")) ! (setq marks (cdr marks))) ! (when marks ! (setq beg (caar marks))) ! (while (and marks (not (string= (cdar marks) ""))) ! (setq marks (cdr marks))) ! (when marks ! (setq end (caar marks))) ! ;; Skip past lines we want to leave visible. ! (when (and beg gnus-cited-lines-visible) ! (goto-char beg) ! (forward-line gnus-cited-lines-visible) ! (if (> (point) end) ! (setq beg nil) ! (setq beg (point)))) ! (when (and beg end) ! (add-text-properties beg end props) ! (goto-char beg) ! (put-text-property beg end 'gnus-type 'cite) ! (gnus-article-add-button ! (point) ! (progn (eval gnus-cited-text-button-line-format-spec) (point)) ! `gnus-article-toggle-cited-text (cons beg end)))))))) ! ! (defun gnus-article-toggle-cited-text (region) ! "Toggle hiding the text in REGION." ! (funcall ! (if (text-property-any ! (car region) (cdr region) ! (car gnus-hidden-properties) (cadr gnus-hidden-properties)) ! 'remove-text-properties 'add-text-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. *** pub/sgnus/lisp/gnus-ems.el Thu Jan 18 03:06:24 1996 --- sgnus/lisp/gnus-ems.el Sun Jan 21 01:17:34 1996 *************** *** 29,34 **** --- 29,35 ---- (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) + (defalias 'gnus-overlay-end 'overlay-end) (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") *************** *** 175,180 **** --- 176,191 ---- (append nnheader-file-name-translation-alist '((?: . ?_) (?+ . ?-)))))))) + + (defvar gnus-tmp-unread) + (defvar gnus-tmp-replied) + (defvar gnus-tmp-score-char) + (defvar gnus-tmp-indentation) + (defvar gnus-tmp-opening-bracket) + (defvar gnus-tmp-lines) + (defvar gnus-tmp-name) + (defvar gnus-tmp-closing-bracket) + (defvar gnus-tmp-subject-or-nil) (defun gnus-ems-redefine () (cond *** pub/sgnus/lisp/gnus-mh.el Thu Jan 18 03:06:24 1996 --- sgnus/lisp/gnus-mh.el Sat Jan 20 05:12:32 1996 *************** *** 88,94 **** (save-excursion (goto-char (point-min)) (insert "In-Reply-To: " in-reply-to "\n"))) ! (setq mh-sent-from-folder gnus-article-copy) (setq mh-sent-from-msg 1) (setq gnus-mail-buffer (buffer-name (current-buffer))) (use-local-map (copy-keymap (current-local-map))) --- 88,94 ---- (save-excursion (goto-char (point-min)) (insert "In-Reply-To: " in-reply-to "\n"))) ! (setq mh-sent-from-folder gnus-original-article-buffer) (setq mh-sent-from-msg 1) (setq gnus-mail-buffer (buffer-name (current-buffer))) (use-local-map (copy-keymap (current-local-map))) *** pub/sgnus/lisp/gnus-msg.el Thu Jan 18 03:06:26 1996 --- sgnus/lisp/gnus-msg.el Sat Jan 20 07:37:32 1996 *************** *** 1495,1501 **** "Return the \"real\" user address. This function tries to ignore all user modifications, and give as trustworthy answer as possible." ! (concat (user-login-name) "@" (gnus-inews-full-address))) (defun gnus-inews-login-name () "Return login name." --- 1495,1501 ---- "Return the \"real\" user address. This function tries to ignore all user modifications, and give as trustworthy answer as possible." ! (concat (user-login-name) "@" (system-name))) (defun gnus-inews-login-name () "Return login name." *************** *** 1692,1699 **** (gnus-summary-select-article) (gnus-copy-article-buffer) (if post ! (gnus-forward-using-post gnus-article-copy) ! (gnus-mail-forward gnus-article-copy))) (defun gnus-summary-resend-message (address) "Resend the current article to ADDRESS." --- 1692,1699 ---- (gnus-summary-select-article) (gnus-copy-article-buffer) (if post ! (gnus-forward-using-post gnus-original-article-buffer) ! (gnus-mail-forward gnus-original-article-buffer))) (defun gnus-summary-resend-message (address) "Resend the current article to ADDRESS." *************** *** 2671,2679 **** --- 2671,2685 ---- ((stringp var) ;; Just a single group. (list var)) + ((null var) + ;; We don't want this. + nil) ((and (listp var) (stringp (car var))) ;; A list of groups. var) + ((gnus-functionp var) + ;; A function. + (funcall var gnus-newsgroup-name)) (t ;; An alist of regexps/functions/forms. (while (and var *** pub/sgnus/lisp/gnus-salt.el Thu Jan 18 03:06:26 1996 --- sgnus/lisp/gnus-salt.el Sun Jan 21 02:38:42 1996 *************** *** 24,29 **** --- 24,30 ---- ;;; Code: (require 'gnus) + (eval-when-compile (require 'cl)) ;;; ;;; gnus-pick-mode *************** *** 287,293 **** (when (setq win (get-buffer-window buf)) (select-window win) (when gnus-selected-tree-overlay ! (goto-char (overlay-end gnus-selected-tree-overlay))) (gnus-tree-minimize)))) (defun gnus-tree-select-article (article) --- 288,294 ---- (when (setq win (get-buffer-window buf)) (select-window win) (when gnus-selected-tree-overlay ! (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) (gnus-tree-minimize)))) (defun gnus-tree-select-article (article) *************** *** 322,344 **** (defun gnus-tree-recenter () "Center point in the tree window." ! (when (get-buffer-window (current-buffer)) ! (save-selected-window ! (select-window (get-buffer-window (current-buffer))) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) ! (t 2))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) ! (point))) ! (window (get-buffer-window (current-buffer)))) ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! window (min bottom (save-excursion ! (forward-line (- top)) (point)))))))) (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." --- 323,348 ---- (defun gnus-tree-recenter () "Center point in the tree window." ! (let ((selected (selected-window)) ! (cur-window (get-buffer-window (current-buffer) t))) ! (when cur-window ! (select-window cur-window) ! (when gnus-selected-tree-overlay ! (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) ! (t 2))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) ! (point)))) ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start ! cur-window (min bottom (save-excursion ! (forward-line (- top)) (point))))) ! (select-window selected)))) (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." *************** *** 362,370 **** (wh (and win (1- (window-height win))))) (when (and win (not (eq tot wh))) ! (save-selected-window (select-window win) ! (enlarge-window (- tot wh))))))) ;;; Generating the tree. --- 366,375 ---- (wh (and win (1- (window-height win))))) (when (and win (not (eq tot wh))) ! (let ((selected (selected-window))) (select-window win) ! (enlarge-window (- tot wh)) ! (select-window selected)))))) ;;; Generating the tree. *************** *** 452,458 **** (goto-char (point-min)) (gnus-tree-minimize) (gnus-tree-recenter) ! (gnus-horizontal-recenter)))) (defun gnus-generate-horizontal-tree (thread level &optional dummyp) "Generate a horizontal tree." --- 457,466 ---- (goto-char (point-min)) (gnus-tree-minimize) (gnus-tree-recenter) ! (let ((selected (selected-window))) ! (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) ! (gnus-horizontal-recenter) ! (select-window selected))))) (defun gnus-generate-horizontal-tree (thread level &optional dummyp) "Generate a horizontal tree." *************** *** 582,598 **** region) (set-buffer gnus-tree-buffer) (when (setq region (gnus-tree-article-region article)) ! (unless gnus-selected-tree-overlay ;; Create a new overlay. (gnus-overlay-put ! (setq gnus-selected-tree-overlay (gnus-make-overlay 1 1)) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. (gnus-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) ! (gnus-horizontal-recenter)) ;; If we remove this save-excursion, it updates the wrong mode lines?!? (save-excursion (set-buffer gnus-tree-buffer) --- 590,611 ---- region) (set-buffer gnus-tree-buffer) (when (setq region (gnus-tree-article-region article)) ! (when (or (not gnus-selected-tree-overlay) ! (and (fboundp 'extent-detached-p) ! (extent-detached-p gnus-selected-tree-overlay))) ;; Create a new overlay. (gnus-overlay-put ! (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. (gnus-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) ! (let ((selected (selected-window))) ! (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) ! (gnus-horizontal-recenter) ! (select-window selected))) ;; If we remove this save-excursion, it updates the wrong mode lines?!? (save-excursion (set-buffer gnus-tree-buffer) *************** *** 604,609 **** (set-buffer (gnus-get-tree-buffer)) (let (region) (when (setq region (gnus-tree-article-region article)) ! (put-text-property (car region) (cdr region) 'face face))))) ;;; gnus-salt.el ends here --- 617,630 ---- (set-buffer (gnus-get-tree-buffer)) (let (region) (when (setq region (gnus-tree-article-region article)) ! (put-text-property (car region) (cdr region) 'face face) ! (set-window-point ! (get-buffer-window (current-buffer) t) (cdr region)))))) ! ! ! ;;; Allow redefinition of functions. ! (gnus-ems-redefine) ! ! (provide 'gnus-salt) ;;; gnus-salt.el ends here *** pub/sgnus/lisp/gnus-score.el Thu Jan 18 03:06:27 1996 --- sgnus/lisp/gnus-score.el Sat Jan 20 08:50:57 1996 *************** *** 211,216 **** --- 211,222 ---- (defvar gnus-score-default-duration nil "*The default score duration to use on when entering a score rule interactively.") + (defun gnus-score-kill-help-buffer () + (when (get-buffer "*Score Help*") + (kill-buffer "*Score Help*") + (and gnus-score-help-winconf + (set-window-configuration gnus-score-help-winconf)))) + (defun gnus-summary-increase-score (&optional score) "Make a score entry based on the current article. The user will be prompted for header to score on, match type, *************** *** 250,256 **** (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! hchar entry temporary tchar pchar end type match) ;; First we read the header to score. (while (not hchar) --- 256,265 ---- (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! (hchar gnus-score-default-header) ! (tchar gnus-score-default-type) ! (pchar gnus-score-default-duration) ! entry temporary end type match) ;; First we read the header to score. (while (not hchar) *************** *** 262,393 **** (mapconcat (lambda (s) (char-to-string (car s))) char-to-header ""))) (setq hchar (read-char)) ! (if (not (or (= hchar ??) (= hchar ?\C-h))) ! () (setq hchar nil) (gnus-score-insert-help "Match on header" char-to-header 1))) ! (and (get-buffer "*Score Help*") ! (progn ! (kill-buffer "*Score Help*") ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)))) ! ! (or (setq entry (assq (downcase hchar) char-to-header)) ! (progn ! (ding) ! (setq end t) ! (if mimic (message "%c %c" prefix hchar) (message "")))) ! (if (or end (/= (downcase hchar) hchar)) ! (progn ! ;; This was a majuscle, so we end reading and set the defaults. ! (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq type gnus-score-default-type ! temporary (and gnus-score-default-duration ! (assq ! (aref (symbol-name gnus-score-default-duration) ! 0) ! char-to-perm)))) ! ! ;; We continue reading - the type. ! (while (not tchar) ! (if mimic ! (progn ! (sit-for 1) ! (message "%c %c-" prefix hchar)) ! (message "%s header '%s' with match type (%s?): " ! (if increase "Increase" "Lower") ! (nth 1 entry) ! (mapconcat (lambda (s) ! (if (eq (nth 4 entry) ! (nth 3 s)) ! (char-to-string (car s)) ! "")) ! char-to-type ""))) ! (setq tchar (read-char)) ! (if (not (or (= tchar ??) (= tchar ?\C-h))) ! () ! (setq tchar nil) ! (gnus-score-insert-help "Match type" char-to-type 2))) ! ! (and (get-buffer "*Score Help*") ! (progn ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)) ! (kill-buffer "*Score Help*"))) ! ! (or (setq type (nth 1 (assq (downcase tchar) char-to-type))) (progn ! (ding) ! (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq end t))) ! (if (or end (/= (downcase tchar) tchar)) (progn ! ;; It was a majuscle, so we end reading and the the default. ! (if mimic (message "%c %c %c" prefix hchar tchar) ! (message "")) ! (setq temporary ! (and gnus-score-default-duration ! (assq ! (aref (symbol-name gnus-score-default-duration) ! 0) ! char-to-perm)))) ! ! ;; We continue reading. ! (while (not pchar) ! (if mimic ! (progn ! (sit-for 1) ! (message "%c %c %c-" prefix hchar tchar)) ! (message "%s permanence (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-perm ""))) ! (setq pchar (read-char)) ! (if (not (or (= pchar ??) (= pchar ?\C-h))) ! () ! (setq pchar nil) ! (gnus-score-insert-help "Match permanence" char-to-perm 2))) ! ! (and (get-buffer "*Score Help*") ! (progn ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)) ! (kill-buffer "*Score Help*"))) ! ! (if mimic (message "%c %c %c" prefix hchar tchar pchar) ! (message "")) ! (if (setq temporary (nth 1 (assq pchar char-to-perm))) ! () ! (ding) ! (setq end t) ! (if mimic ! (message "%c %c %c %c" prefix hchar tchar pchar) ! (message ""))))) ;; We have all the data, so we enter this score. ! (if end ! () ! (setq match (if (string= (nth 2 entry) "") "" ! (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) ! ;; Modify the match, perhaps. ! (cond ! ((equal (nth 1 entry) "xref") ! (when (string-match "^Xref: *" match) ! (setq match (substring match (match-end 0)))) ! (when (string-match "^[^:]* +" match) ! (setq match (substring match (match-end 0)))))) ! ! (gnus-summary-score-entry ! (nth 1 entry) ; Header ! match ; Match ! type ; Type ! (if (eq 's score) nil score) ; Score ! (if (eq 'perm temporary) ; Temp ! nil ! temporary) ! (not (nth 3 entry))) ; Prompt ! ))) (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) --- 271,362 ---- (mapconcat (lambda (s) (char-to-string (car s))) char-to-header ""))) (setq hchar (read-char)) ! (when (or (= hchar ??) (= hchar ?\C-h)) (setq hchar nil) (gnus-score-insert-help "Match on header" char-to-header 1))) ! (gnus-score-kill-help-buffer) ! (unless (setq entry (assq (downcase hchar) char-to-header)) ! (if mimic (error "%c %c" prefix hchar) (error ""))) ! ! (when (/= (downcase hchar) hchar) ! ;; This was a majuscle, so we end reading and set the defaults. ! (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq tchar (or gnus-score-default-type ?s) ! pchar (or gnus-score-default-duration ?t))) ! ! ;; We continue reading - the type. ! (while (not tchar) ! (if mimic (progn ! (sit-for 1) (message "%c %c-" prefix hchar)) ! (message "%s header '%s' with match type (%s?): " ! (if increase "Increase" "Lower") ! (nth 1 entry) ! (mapconcat (lambda (s) ! (if (eq (nth 4 entry) ! (nth 3 s)) ! (char-to-string (car s)) ! "")) ! char-to-type ""))) ! (setq tchar (read-char)) ! (when (or (= tchar ??) (= tchar ?\C-h)) ! (setq tchar nil) ! (gnus-score-insert-help "Match type" char-to-type 2))) ! ! (gnus-score-kill-help-buffer) ! (unless (setq type (nth 1 (assq (downcase tchar) char-to-type))) ! (if mimic (error "%c %c" prefix hchar) (error ""))) ! ! (when (/= (downcase tchar) tchar) ! ;; It was a majuscle, so we end reading and the the default. ! (if mimic (message "%c %c %c" prefix hchar tchar) ! (message "")) ! (setq pchar (or gnus-score-default-duration ?p))) ! ! ;; We continue reading. ! (while (not pchar) ! (if mimic (progn ! (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) ! (message "%s permanence (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-perm ""))) ! (setq pchar (read-char)) ! (when (or (= pchar ??) (= pchar ?\C-h)) ! (setq pchar nil) ! (gnus-score-insert-help "Match permanence" char-to-perm 2))) ! ! (gnus-score-kill-help-buffer) ! (if mimic (message "%c %c %c" prefix hchar tchar pchar) ! (message "")) ! (unless (setq temporary (assq pchar char-to-perm)) ! (if mimic ! (error "%c %c %c %c" prefix hchar tchar pchar) ! (error ""))) ;; We have all the data, so we enter this score. ! (setq match (if (string= (nth 2 entry) "") "" ! (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) ! ;; Modify the match, perhaps. ! (cond ! ((equal (nth 1 entry) "xref") ! (when (string-match "^Xref: *" match) ! (setq match (substring match (match-end 0)))) ! (when (string-match "^[^:]* +" match) ! (setq match (substring match (match-end 0)))))) ! ! (gnus-summary-score-entry ! (nth 1 entry) ; Header ! match ; Match ! type ; Type ! (if (eq 's score) nil score) ; Score ! (if (eq 'perm temporary) ; Temp ! nil ! (nth 1 temporary)) ! (not (nth 3 entry))) ; Prompt ! )) (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) *** pub/sgnus/lisp/gnus-soup.el Thu Jan 18 03:06:27 1996 --- sgnus/lisp/gnus-soup.el Sat Jan 20 00:17:38 1996 *************** *** 358,364 **** (string-to-int (gnus-soup-field)))) areas)) (if (eq (preceding-char) ?\t) ! (beginning-of-line 2)))) areas)) (defun gnus-soup-parse-replies (file) --- 358,365 ---- (string-to-int (gnus-soup-field)))) areas)) (if (eq (preceding-char) ?\t) ! (beginning-of-line 2))) ! (kill-buffer (current-buffer))) areas)) (defun gnus-soup-parse-replies (file) *** pub/sgnus/lisp/gnus-srvr.el Thu Jan 18 03:06:27 1996 --- sgnus/lisp/gnus-srvr.el Fri Jan 19 23:25:30 1996 *************** *** 175,180 **** --- 175,182 ---- (when gnus-carpal (gnus-carpal-setup-buffer 'server))))) + (fset 'gnus-server-position-point 'gnus-goto-colon) + (defun gnus-server-prepare () (setq gnus-server-mode-line-format-spec (gnus-parse-format gnus-server-mode-line-format *** pub/sgnus/lisp/gnus-uu.el Thu Jan 18 03:06:29 1996 --- sgnus/lisp/gnus-uu.el Sat Jan 20 08:50:15 1996 *************** *** 1142,1148 **** (setq state 'first-and-last) (setq state 'last))) ! (message "Getting article %d, %s" article (gnus-uu-part-number article)) (gnus-summary-display-article article) ;; Push the article to the processing function. --- 1142,1150 ---- (setq state 'first-and-last) (setq state 'last))) ! (let ((part (gnus-uu-part-number article))) ! (message "Getting article %d%s..." ! article (if (string= part "") "" (concat ", " part)))) (gnus-summary-display-article article) ;; Push the article to the processing function. *** pub/sgnus/lisp/gnus-vis.el Thu Jan 18 03:06:29 1996 --- sgnus/lisp/gnus-vis.el Sat Jan 20 07:37:59 1996 *************** *** 329,334 **** --- 329,335 ---- ["Unmark all" gnus-group-unmark-all-groups t] ["Mark regexp" gnus-group-mark-regexp t] ["Mark region" gnus-group-mark-region t] + ["Mark buffer" gnus-group-mark-buffer t] ["Execute command" gnus-group-universal-argument t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] *************** *** 1300,1313 **** (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) ! (goto-char (point-max)) ! (and (re-search-backward gnus-signature-separator nil t) ! gnus-signature-face ! (let ((start (match-beginning 0)) ! (end (match-end 0))) ! (gnus-article-add-button start end 'gnus-signature-toggle end) ! (gnus-overlay-put (gnus-make-overlay end (point-max)) ! 'face gnus-signature-face)))))) (defun gnus-article-add-buttons (&optional force) "Find external references in the article and make buttons of them. --- 1301,1317 ---- (set-buffer gnus-article-buffer) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) ! (save-restriction ! (when (and gnus-signature-face ! (gnus-narrow-to-signature)) ! (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) ! 'face gnus-signature-face) ! (widen) ! (re-search-backward gnus-signature-separator nil t) ! (let ((start (match-beginning 0)) ! (end (match-end 0))) ! (gnus-article-add-button start end 'gnus-signature-toggle ! end))))))) (defun gnus-article-add-buttons (&optional force) "Find external references in the article and make buttons of them. *** pub/sgnus/lisp/gnus-xmas.el Thu Jan 18 03:06:29 1996 --- sgnus/lisp/gnus-xmas.el Sun Jan 21 02:29:31 1996 *************** *** 25,30 **** --- 25,31 ---- ;;; Code: (require 'text-props) + (eval-when-compile (require 'cl)) (defvar menu-bar-mode t) (defvar gnus-xmas-glyph-directory nil *************** *** 168,173 **** --- 169,179 ---- (defun gnus-xmas-move-overlay (extent start end &optional buffer) (set-extent-endpoints extent start end)) + (defun gnus-xmas-make-overlay (from to &optional buf) + (let ((extent (make-extent from to buf))) + (set-extent-property extent 'detachable nil) + extent)) + ;; Fixed by Christopher Davis . (defun gnus-xmas-article-add-button (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." *************** *** 186,191 **** --- 192,215 ---- (defun gnus-xmas-window-top-edge (&optional window) (nth 1 (window-pixel-edges window))) + (defun gnus-xmas-tree-minimize () + (when (and gnus-tree-minimize-window + (not (one-window-p))) + (let* ((window-min-height 2) + (height (1+ (count-lines (point-min) (point-max)))) + (min (max (1- window-min-height) height)) + (tot (if (numberp gnus-tree-minimize-window) + (min gnus-tree-minimize-window min) + min)) + (win (get-buffer-window (current-buffer))) + (wh (and win (1- (window-height win))))) + (when (and win + (not (eq tot wh))) + (let ((selected (selected-window))) + (select-window win) + (enlarge-window (- tot wh)) + (select-window selected)))))) + ;; Select the lowest window on the frame. (defun gnus-xmas-appt-select-lowest-window () (let* ((lowest-window (selected-window)) *************** *** 231,237 **** (while (not (key-press-event-p event)) (setq event (next-event))) (cons (and (key-press-event-p event) ! (numberp (event-key event)) (event-to-character event)) event))) --- 255,261 ---- (while (not (key-press-event-p event)) (setq event (next-event))) (cons (and (key-press-event-p event) ! ; (numberp (event-key event)) (event-to-character event)) event))) *************** *** 265,273 **** (or (face-differs-from-default-p 'underline) (funcall (intern "set-face-underline-p") 'underline t)) ! (fset 'gnus-make-overlay 'make-extent) (fset 'gnus-overlay-put 'set-extent-property) (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) (fset 'set-text-properties 'gnus-xmas-set-text-properties) --- 289,298 ---- (or (face-differs-from-default-p 'underline) (funcall (intern "set-face-underline-p") 'underline t)) ! (fset 'gnus-make-overlay 'gnus-xmas-make-overlay) (fset 'gnus-overlay-put 'set-extent-property) (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) + (fset 'gnus-overlay-end 'extent-end-position) (fset 'set-text-properties 'gnus-xmas-set-text-properties) *************** *** 356,361 **** --- 381,387 ---- (fset 'set-text-properties 'gnus-xmas-set-text-properties) (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) + (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) (or (fboundp 'appt-select-lowest-window) (fset 'appt-select-lowest-window *** pub/sgnus/lisp/gnus.el Thu Jan 18 03:06:30 1996 --- sgnus/lisp/gnus.el Sun Jan 21 03:00:38 1996 *************** *** 187,192 **** --- 187,193 ---- (defvar gnus-group-faq-directory '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" ; "/ftp@ftp.uu.net:/usenet/news.answers/" + "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/" "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" *************** *** 213,218 **** --- 214,220 ---- ftp.seas.gwu.edu /pub/rtfm rtfm.mit.edu /pub/usenet/news.answers Europe: ftp.uni-paderborn.de /pub/FAQ + src.doc.ic.ac.uk /usenet/news-FAQS ftp.sunet.se /pub/usenet Asia: nctuccca.edu.tw /USENET/FAQ hwarang.postech.ac.kr /pub/usenet/news.answers *************** *** 480,487 **** (defvar gnus-build-sparse-threads nil "*If non-nil, fill in the gaps in threads. If `some', only fill in the gaps that are needed to tie loose threads ! together. If non-nil and non-`some', fill in all gaps that Gnus ! manages to guess.") (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject "Function used for gathering loose threads. --- 482,489 ---- (defvar gnus-build-sparse-threads nil "*If non-nil, fill in the gaps in threads. If `some', only fill in the gaps that are needed to tie loose threads ! together. If `more', fill in all leaf nodes that Gnus can find. If ! non-nil and non-`some', fill in all gaps that Gnus manages to guess.") (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject "Function used for gathering loose threads. *************** *** 1320,1325 **** --- 1322,1330 ---- (say) one week. (This only goes for mail groups and the like, of course.)") + (defvar gnus-group-uncollapsed-levels 1 + "Number of group name elements to leave alone when making a short group name.") + (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") *************** *** 1653,1659 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.29" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1658,1664 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.30" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 1991,1997 **** ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) ("gnus-uu" :interactive t gnus-uu-digest-mail-forward gnus-uu-digest-post-forward ! gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-by-regexp gnus-uu-mark-all gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu gnus-uu-decode-uu-and-save gnus-uu-decode-unshar --- 1996,2002 ---- ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) ("gnus-uu" :interactive t gnus-uu-digest-mail-forward gnus-uu-digest-post-forward ! gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer gnus-uu-mark-by-regexp gnus-uu-mark-all gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu gnus-uu-decode-uu-and-save gnus-uu-decode-unshar *************** *** 2014,2020 **** gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-bug) ! ("gnus-picon" gnus-article-display-picons) ("gnus-vm" gnus-vm-mail-setup) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm gnus-yank-article)))) --- 2019,2026 ---- gnus-summary-reply gnus-summary-reply-with-original gnus-summary-mail-forward gnus-summary-mail-other-window gnus-bug) ! ("gnus-picon" :interactive t gnus-article-display-picons ! gnus-group-display-picons) ("gnus-vm" gnus-vm-mail-setup) ("gnus-vm" :interactive t gnus-summary-save-in-vm gnus-summary-save-article-vm gnus-yank-article)))) *************** *** 3260,3266 **** (cond ((null split) t) ! ((not (or (eq type 'horizontal) (eq type 'vertical))) (let ((buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer))))) win buf) --- 3266,3272 ---- (cond ((null split) t) ! ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame))) (let ((buffer (cond ((stringp type) type) (t (cdr (assq type gnus-window-to-buffer))))) win buf) *************** *** 3268,3274 **** (error "Illegal buffer type: %s" type)) (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer) buffer))) ! (setq win (get-buffer-window buf))) (when win (if (memq 'point split) win --- 3274,3280 ---- (error "Illegal buffer type: %s" type)) (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer) buffer))) ! (setq win (get-buffer-window buf t))) (when win (if (memq 'point split) win *************** *** 3910,3915 **** --- 3916,3922 ---- "m" gnus-group-mark-group "u" gnus-group-unmark-group "w" gnus-group-mark-region + "m" gnus-group-mark-buffer "r" gnus-group-mark-regexp "U" gnus-group-unmark-all-groups) *************** *** 4130,4136 **** (let ((history load-history) feature) (while history ! (and (string-match "^gnus" (car (car history))) (setq feature (cdr (assq 'provide (car history)))) (unload-feature feature 'force)) (setq history (cdr history))))) --- 4137,4143 ---- (let ((history load-history) feature) (while history ! (and (string-match "^\\(gnus\\|nn\\)" (caar history)) (setq feature (cdr (assq 'provide (car history)))) (unload-feature feature 'force)) (setq history (cdr history))))) *************** *** 4817,4822 **** --- 4824,4835 ---- (goto-char beg) (- num (gnus-group-mark-group num unmark))))) + (defun gnus-group-mark-buffer (unmark) + "Mark all groups in the buffer. + If UNMARK, remove the mark instead." + (interactive "P") + (gnus-group-mark-region unmark (point-min) (point-max))) + (defun gnus-group-mark-regexp (regexp) "Mark all groups that match some regexp." (interactive "sMark (regexp): ") *************** *** 5516,5540 **** (interactive (list gnus-group-sort-function current-prefix-arg)) (let ((func (cond ! ((not (listp func)) ! func) ! ((= 1 (length func)) ! (car func)) ! (t ! `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse func))))))) ;; We peel off the dummy group from the alist. ! (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") ! (pop gnus-newsrc-alist)) ! ;; Do the sorting. ! (setq gnus-newsrc-alist ! (sort gnus-newsrc-alist func)) ! (when reverse ! (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! ;; Regenerate the hash table. ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups))) (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. --- 5529,5552 ---- (interactive (list gnus-group-sort-function current-prefix-arg)) (let ((func (cond ! ((not (listp func)) func) ! ((null func) func) ! ((= 1 (length func)) (car func)) ! (t `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse func))))))) ;; We peel off the dummy group from the alist. ! (when func ! (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") ! (pop gnus-newsrc-alist)) ! ;; Do the sorting. ! (setq gnus-newsrc-alist ! (sort gnus-newsrc-alist func)) ! (when reverse ! (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! ;; Regenerate the hash table. ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups)))) (defun gnus-group-sort-groups-by-alphabet (&optional reverse) "Sort the group buffer alphabetically by group name. *************** *** 6584,6589 **** --- 6596,6602 ---- "i" gnus-summary-raise-thread "T" gnus-summary-toggle-threads "t" gnus-summary-rethread-current + "^" gnus-summary-reparent-thread "s" gnus-summary-show-thread "S" gnus-summary-show-all-threads "h" gnus-summary-hide-thread *************** *** 7725,7731 **** (defun gnus-sort-threads (threads) "Sort THREADS." ! (when gnus-thread-sort-functions (let ((func (if (= 1 (length gnus-thread-sort-functions)) (car gnus-thread-sort-functions) `(lambda (t1 t2) --- 7738,7745 ---- (defun gnus-sort-threads (threads) "Sort THREADS." ! (if (not gnus-thread-sort-functions) ! threads (let ((func (if (= 1 (length gnus-thread-sort-functions)) (car gnus-thread-sort-functions) `(lambda (t1 t2) *************** *** 9111,9129 **** window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. ! (gnus-summary-position-point) ! (gnus-horizontal-recenter)))) (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." (if (< (current-column) (/ (window-width) 2)) ! (set-window-hscroll (get-buffer-window (current-buffer)) 0) (let* ((orig (point)) ! (end (window-end)) (max 0)) ;; Find the longest line currently displayed in the window. (goto-char (window-start)) ! (while (< (point) end) (end-of-line) (setq max (max max (current-column))) (forward-line 1)) --- 9125,9147 ---- window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. ! (let ((selected (selected-window))) ! (select-window (get-buffer-window (current-buffer) t)) ! (gnus-summary-position-point) ! (gnus-horizontal-recenter) ! (select-window selected))))) (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." (if (< (current-column) (/ (window-width) 2)) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0) (let* ((orig (point)) ! (end (window-end (get-buffer-window (current-buffer) t))) (max 0)) ;; Find the longest line currently displayed in the window. (goto-char (window-start)) ! (while (and (not (eobp)) ! (< (point) end)) (end-of-line) (setq max (max max (current-column))) (forward-line 1)) *************** *** 9131,9146 **** ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) (set-window-hscroll ! (get-buffer-window (current-buffer)) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) ! (set-window-hscroll (get-buffer-window (current-buffer)) 0)) max))) ! ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") (foreign "") (depth 0) (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) --- 9149,9167 ---- ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) (set-window-hscroll ! (get-buffer-window (current-buffer) t) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) max))) ! ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") ! (foreign "") ! (depth 0) ! (skip 1) (levels (or levels (progn (while (string-match "\\." group skip) *************** *** 9151,9157 **** (setq foreign (substring group 0 (match-end 0)) group (substring group (match-end 0)))) (while group ! (if (and (string-match "\\." group) (> levels 0)) (setq name (concat name (substring group 0 1)) group (substring group (match-end 0)) levels (- levels 1) --- 9172,9179 ---- (setq foreign (substring group 0 (match-end 0)) group (substring group (match-end 0)))) (while group ! (if (and (string-match "\\." group) ! (> levels (- gnus-group-uncollapsed-levels 1))) (setq name (concat name (substring group 0 1)) group (substring group (match-end 0)) levels (- levels 1) *************** *** 10258,10264 **** (defun gnus-cut-threads (threads) "Cut off all uninteresting articles from the beginning of threads." (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some)) (let ((th threads)) (while th (setcar th (gnus-cut-thread (car th))) --- 10280,10287 ---- (defun gnus-cut-threads (threads) "Cut off all uninteresting articles from the beginning of threads." (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some) ! (eq gnus-build-sparse-threads 'more)) (let ((th threads)) (while th (setcar th (gnus-cut-thread (car th))) *************** *** 10275,10280 **** --- 10298,10304 ---- (not (eq gnus-fetch-old-headers 'some)) (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) + (not (eq gnus-build-sparse-threads 'more)) (null gnus-thread-expunge-below))) () ; Do nothing. (push gnus-newsgroup-limit gnus-newsgroup-limits) *************** *** 10291,10299 **** gnus-thread-expunge-below)) (gnus-expunge-thread (pop nodes)) (setq thread (pop nodes)) - ;(when (or (eq gnus-fetch-old-headers 'some) - ; (eq gnus-build-sparse-threads 'some)) - ; (setq thread (gnus-cut-thread thread))) (gnus-summary-limit-children thread)))))) gnus-newsgroup-dependencies) ;; If this limitation resulted in an empty group, we might --- 10315,10320 ---- *************** *** 10329,10335 **** (zerop children)) ;; If this is a sparsely inserted article with no children, ;; we don't want it. ! (and gnus-build-sparse-threads (memq number gnus-newsgroup-sparse) (zerop children)) ;; If we use expunging, and this article is really --- 10350,10356 ---- (zerop children)) ;; If this is a sparsely inserted article with no children, ;; we don't want it. ! (and (eq gnus-build-sparse-threads 'some) (memq number gnus-newsgroup-sparse) (zerop children)) ;; If we use expunging, and this article is really *************** *** 10592,10598 **** (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) articles d) ! (or (fboundp func) (error "%s is not a valid header" header)) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... --- 10613,10620 ---- (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search (not not-case-fold)) articles d) ! (or (fboundp (intern (concat "mail-header-" header))) ! (error "%s is not a valid header" header)) (while data (setq d (car data)) (and (or (not unread) ; We want all articles... *************** *** 10799,10804 **** --- 10821,10828 ---- (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) + (when (equal to-newsgroup gnus-newsgroup-name) + (error "Can't %s to the same group you're already in" action)) ;; Check the method we are to move this article to... (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) *************** *** 10892,10898 **** (intern (format "gnus-newsgroup-%s" (caar marks))))) (gnus-add-marked-articles ! (gnus-info-group info) (cadr marks) (list to-article) info)) (setq marks (cdr marks))))) --- 10916,10922 ---- (intern (format "gnus-newsgroup-%s" (caar marks))))) (gnus-add-marked-articles ! (gnus-info-group info) (caar marks) (list to-article) info)) (setq marks (cdr marks))))) *************** *** 11887,11892 **** --- 11911,11963 ---- (gnus-rebuild-thread id) (gnus-summary-goto-subject article))) + (defun gnus-summary-reparent-thread () + "Make current article child of the marked (or previous) article. + + Note that the re-threading will only work if `gnus-thread-ignore-subject' + is non-nil or the Subject: of both articles are the same. + + The change will not be visible until the next group retrieval." + (interactive) + (or (not (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing.")) + (or (<= (length gnus-newsgroup-processable) 1) + (error "No more than one article may be marked.")) + (save-window-excursion + (let ((gnus-article-buffer " *reparent*") + (current-article (gnus-summary-article-number)) + ; first grab the marked article, otherwise one line up. + (parent-article (if (not (null gnus-newsgroup-processable)) + (car gnus-newsgroup-processable) + (save-excursion + (if (eq (forward-line -1) 0) + (gnus-summary-article-number) + (error "Beginning of summary buffer.")))))) + (or (not (eq current-article parent-article)) + (error "An article may not be self-referential.")) + (let ((message-id (mail-header-id + (gnus-summary-article-header parent-article)))) + (or (and message-id (not (equal message-id ""))) + (error "No message-id in desired parent.")) + (gnus-summary-select-article t t nil current-article) + (set-buffer gnus-article-buffer) + (setq buffer-read-only nil) + (let ((buf (buffer-substring-no-properties (point-min) (point-max)))) + (erase-buffer) + (insert buf)) + (goto-char (point-min)) + (if (search-forward-regexp "^References: " nil t) + (insert message-id " " ) + (insert "References: " message-id "\n")) + (or (gnus-request-replace-article current-article + (car gnus-article-current) + gnus-article-buffer) + (error "Couldn't replace article.")) + (set-buffer gnus-summary-buffer) + (gnus-summary-unmark-all-processable) + (message "Article %d is now the child of article %d." + current-article parent-article))))) + (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. If ARG is positive number, turn showing conversation threads on." *************** *** 12564,12578 **** (add-text-properties b e (list 'gnus-number gnus-reffed-article-number gnus-mouse-face-prop gnus-mouse-face)) ! (gnus-data-enter after-article ! gnus-reffed-article-number ! gnus-unread-mark ! b ! (car pslist) ! 0 ! (- e b)) ! (setq gnus-newsgroup-unreads ! (cons gnus-reffed-article-number gnus-newsgroup-unreads)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) --- 12635,12644 ---- (add-text-properties b e (list 'gnus-number gnus-reffed-article-number gnus-mouse-face-prop gnus-mouse-face)) ! (gnus-data-enter ! after-article gnus-reffed-article-number ! gnus-unread-mark b (car pslist) 0 (- e b)) ! (push gnus-reffed-article-number gnus-newsgroup-unreads) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) *************** *** 13400,13413 **** (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-max)) ! (and (re-search-backward gnus-signature-separator nil t) ! gnus-signature-face ! (add-text-properties ! (match-end 0) (point-max) ! (nconc (list 'gnus-type 'signature) ! gnus-hidden-properties))))))) (defun gnus-article-check-hidden-text (type arg) "Return nil if hiding is necessary." --- 13466,13502 ---- (unless (gnus-article-check-hidden-text 'signature arg) (save-excursion (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil)) ! (when (gnus-narrow-to-signature) ! (add-text-properties ! (point-min) (point-max) ! (nconc (list 'gnus-type 'signature) ! gnus-hidden-properties)))))))) ! ! (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 ! any parameters, and if it returns nil, there is no signature in the ! buffer. If it is a string, it will be used as a regexp. If it ! matches, the text in question is not a signature.") ! ! (defun gnus-narrow-to-signature () ! "Narrow to the signature." ! (widen) ! (goto-char (point-max)) ! (when (re-search-backward gnus-signature-separator nil t) ! (forward-line 1) ! (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))) (defun gnus-article-check-hidden-text (type arg) "Return nil if hiding is necessary." *************** *** 14242,14248 **** (if (not (gnus-check-backend-function 'request-update-mark (car method))) mark (funcall (gnus-get-function method 'request-update-mark) ! (gnus-group-real-name group) article)))) (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. --- 14331,14337 ---- (if (not (gnus-check-backend-function 'request-update-mark (car method))) mark (funcall (gnus-get-function method 'request-update-mark) ! (gnus-group-real-name group) article mark)))) (defun gnus-request-article (article group &optional buffer) "Request the ARTICLE in GROUP. *************** *** 14296,14301 **** --- 14385,14394 ---- (nth 1 method) accept-function last))) (defun gnus-request-accept-article (group &optional last method) + ;; Make sure there's a newline at the end of the article. + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) (let ((func (if (symbolp group) group (car (or method (gnus-find-method-for-group group)))))) (funcall (intern (format "%s-request-accept-article" func)) *** pub/sgnus/lisp/nnatp.el Fri Jan 19 23:22:59 1996 --- sgnus/lisp/nnatp.el Fri Jan 19 23:26:52 1996 *************** *** 0 **** --- 1,667 ---- + ;;; nntp.el --- nntp access for Gnus + ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to + ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'rnews) + (require 'sendmail) + (require 'nnheader) + + (eval-and-compile + (unless (fboundp 'open-network-stream) + (require 'tcp))) + + (eval-when-compile (require 'cl)) + + (defvar nntp-address nil + "Address of the physical nntp server.") + + (defvar nntp-port-number "nntp" + "Port number on the physical nntp server.") + + (defvar nntp-server-hook nil + "*Hooks for the NNTP server. + If the kanji code of the NNTP server is different from the local kanji + code, the correct kanji code of the buffer associated with the NNTP + server must be specified as follows: + + \(setq nntp-server-hook + (lambda () + ;; Server's Kanji code is EUC (NEmacs hack). + (make-local-variable 'kanji-fileio-code) + (setq kanji-fileio-code 0))) + + If you'd like to change something depending on the server in this + hook, use the variable `nntp-address'.") + + (defvar nntp-server-opened-hook nil + "*Hook used for sending commands to the server at startup. + The default value is `nntp-send-mode-reader', which makes an innd + server spawn an nnrpd server. Another useful function to put in this + hook might be `nntp-send-authinfo', which will prompt for a password + to allow posting from the server. Note that this is only necessary to + do on servers that use strict access control.") + (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) + + (defvar nntp-server-action-alist + '(("nntpd 1\\.5\\.11t" + (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))) + "Alist of regexps to match on server types and actions to be taken. + For instance, if you want Gnus to beep every time you connect + to innd, you could say something like: + + \(setq nntp-server-action-alist + '((\"innd\" (ding)))) + + You probably don't want to do that, though.") + + (defvar nntp-open-connection-function 'nntp-open-network-stream + "*Function used for connecting to a remote system. + It will be called with the address of the remote system. + + Two pre-made functions are `nntp-open-network-stream', which is the + default, and simply connects to some port or other on the remote + system (see nntp-port-number). The other is `nntp-open-rlogin', which + does an rlogin on the remote system, and then does a telnet to the + NNTP server available there (see nntp-rlogin-parameters).") + + (defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") + "*Parameters to `nntp-open-login'. + That function may be used as `nntp-open-server-function'. In that + case, this list will be used as the parameter list given to rsh.") + + (defvar nntp-rlogin-user-name nil + "*User name on remote system when using the rlogin connect method.") + + (defvar nntp-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. + If the number of the articles is greater than the value, verbose + messages will be shown to indicate the current status.") + + (defvar nntp-maximum-request 400 + "*The maximum number of the requests sent to the NNTP server at one time. + If Emacs hangs up while retrieving headers, set the variable to a + lower value.") + + (defvar nntp-nov-is-evil nil + "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") + + (defvar nntp-xover-commands '("XOVER" "XOVERVIEW") + "*List of strings that are used as commands to fetch NOV lines from a server. + The strings are tried in turn until a positive response is gotten. If + none of the commands are successful, nntp will just grab headers one + by one.") + + (defvar nntp-nov-gap 20 + "*Maximum allowed gap between two articles. + If the gap between two consecutive articles is bigger than this + variable, split the XOVER request into two requests.") + + (defvar nntp-connection-timeout nil + "*Number of seconds to wait before an nntp connection times out. + If this variable is nil, which is the default, no timers are set.") + + (defvar nntp-news-default-headers nil + "*If non-nil, override `mail-default-headers' when posting news.") + + (defvar nntp-prepare-server-hook nil + "*Hook run before a server is opened. + If can be used to set up a server remotely, for instance. Say you + have an account at the machine \"other.machine\". This machine has + access to an NNTP server that you can't access locally. You could + then use this hook to rsh to the remote machine and start a proxy NNTP + server there that you can connect to.") + + (defvar nntp-warn-about-losing-connection t + "*If non-nil, beep when a server closes connection.") + + + + ;;; Internal variables. + + (defvar nntp-connection-alist nil) + (defvar nntp-status-string "") + (defconst nntp-version "nntp 5.0") + (defvar nntp-inhibit-erase nil) + + (defvar nntp-server-xover 'try) + (defvar nntp-server-list-active-group 'try) + + ;; Virtual server defs. + (defvar nntp-current-server nil) + (defvar nntp-server-alist nil) + (defvar nntp-server-variables + `((nntp-address ,nntp-address) + (nntp-open-connection-function ,nntp-open-connection-function) + (nntp-port-number ,nntp-port-number) + (nntp-status-string ,nntp-status-string) + (nntp-connection-alist nil))) + + + + ;;; Interface functions. + + (defun nntp-retrieve-headers (articles &optional group server fetch-old) + "Retrieve the headers of ARTICLES." + (nntp-possibly-change-group 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 articles fetch-old)) + ;; We successfully retrieved the headers via XOVER. + 'nov + ;; 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 articles + (nntp-send-command + nil + "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 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) + (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. Fold continuation lines. + (nnheader-fold-continuation-lines) + ;; Remove all "\r"'s. + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (replace-match "" t t)) + 'headers)))) + + (defun nntp-request-article (article &optional group server buffer) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (nntp-possibly-change-group group server) + (nntp-send-command-and-decode + "\r\n\\.\r\n" "ARTICLE" + (if (numberp article) (int-to-string article) article)))) + + (defun nntp-request-body (article &optional group server) + (nntp-possibly-change-group group server) + (nntp-send-command + "\r\n\\.\r\n" "BODY" + (if (numberp article) (int-to-string article) article))) + + (defun nntp-request-group (group &optional server dont-check) + (nntp-possibly-change-group nil server) + (when (nntp-send-command "^2.*\r\n" "GROUP" group) + (let ((entry (nntp-find-connection-entry nntp-server-buffer))) + (setcar (cddr entry) group)))) + + (defun nntp-close-group (group &optional server) + t) + + (defun nntp-server-opened (server) + (and (equal server nntp-current-server) + nntp-server-buffer + (buffer-name nntp-server-buffer))) + + (defun nntp-open-server (server &optional defs connectionless) + (nnheader-init-server-buffer) + (if (nntp-server-opened server) + t + (when (or (stringp (car defs)) + (numberp (car defs))) + (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) + (unless (assq 'nntp-address defs) + (setq defs (append defs (list (list 'nntp-address server))))) + (nnheader-change-server 'nntp server defs) + (or (nntp-find-connection nntp-server-buffer) + (nntp-open-connection nntp-server-buffer)))) + + (defun nntp-close-server (&optional server) + (nntp-possibly-change-group nil server t) + (let (process) + (while (setq process (car (pop nntp-connection-alist))) + (when (memq (process-status process) '(open run)) + (set-process-sentinel process nil) + (set-process-filter process nil) + (nntp-send-string process "QUIT")) + (when (buffer-name (process-buffer process)) + (kill-buffer (process-buffer process)))))) + + (defun nntp-request-list (&optional server) + (nntp-possibly-change-group nil server) + (nntp-send-command "\r\n\\.\r\n" "LIST")) + + (defun nntp-request-list-newsgroups (&optional server) + (nntp-possibly-change-group nil server) + (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS")) + + (defun nntp-asynchronous-p () + t) + + + ;;; Hooky functions. + + (defun nntp-send-mode-reader () + "Send the MODE READER command to the nntp server. + This function is supposed to be called from `nntp-server-opened-hook'. + It will make innd servers spawn an nnrpd process to allow actual article + reading." + (nntp-send-command "^.*\r\n" "MODE READER")) + + (defun nntp-send-nosy-authinfo () + "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." + (nntp-send-command "^.*\r\n" "AUTHINFO USER" + (read-string "NNTP user name: ")) + (nntp-send-command "^.*\r\n" "AUTHINFO PASS" + (read-string "NNTP password: "))) + + (defun nntp-send-authinfo () + "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." + (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name)) + (nntp-send-command "^.*\r\n" "AUTHINFO PASS" + (read-string "NNTP password: "))) + + (defun nntp-send-authinfo-from-file () + "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." + (when (file-exists-p "~/.nntp-authinfo") + (save-excursion + (set-buffer (get-buffer-create " *authinfo*")) + (buffer-disable-undo (current-buffer)) + (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))))) + + ;;; Internal functions. + + (defun nntp-send-command (wait-for &rest strings) + "Send STRINGS to server and wait until WAIT-FOR returns." + (nntp-retrieve-data + (mapconcat 'identity strings " ") + nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function)) + + (defun nntp-send-command-and-decode (wait-for &rest strings) + "Send STRINGS to server and wait until WAIT-FOR returns." + (nntp-retrieve-data + (mapconcat 'identity strings " ") + nntp-address nntp-port-number nntp-server-buffer + wait-for nnheader-callback-function t)) + + (defun nntp-find-connection (buffer) + "Find the connection delivering to BUFFER." + (let ((alist nntp-connection-alist) + process entry) + (while (setq entry (pop alist)) + (when (eq buffer (cadr entry)) + (setq process (car entry) + alist nil))) + (when process + (if (memq (process-status process) '(open run)) + process + (when (buffer-name (process-buffer process)) + (kill-buffer (process-buffer process))) + (setq nntp-connection-alist (delq entry nntp-connection-alist)) + nil)))) + + (defun nntp-find-connection-entry (buffer) + "Return the entry for the connection to BUFFER." + (assq (nntp-find-connection buffer) nntp-connection-alist)) + + (defun nntp-open-connection (buffer) + "Open a connection to PORT on ADDRESS delivering output to BUFFER." + (let* ((pbuffer (save-excursion + (set-buffer + (generate-new-buffer + (format " *nntpd %s %s %s*" + nntp-address nntp-port-number + (buffer-name (get-buffer buffer))))) + (buffer-disable-undo (current-buffer)) + (current-buffer))) + (process (funcall nntp-open-connection-function pbuffer))) + (when process + (process-kill-without-query process) + (nntp-wait-for process "^.*\r\n" buffer) + (if (memq (process-status process) '(open run)) + (caar (push (list process buffer nil) + nntp-connection-alist)) + (when (buffer-name (process-buffer process)) + (kill-buffer (process-buffer process))) + nil)))) + + (defun nntp-open-network-stream (buffer) + (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) + + (defvar nntp-tmp-first) + (defvar nntp-tmp-wait-for) + (defvar nntp-tmp-callback) + (defvar nntp-tmp-buffer) + + (defun nntp-make-process-filter (wait-for callback buffer decode) + `(lambda (proc string) + (let ((nntp-tmp-wait-for ,wait-for) + (nntp-tmp-callback ,callback) + (nntp-tmp-buffer ,buffer)) + (nntp-process-filter proc string)))) + + (defun nntp-process-filter (proc string) + (let ((old-buffer (current-buffer))) + (unwind-protect + (let (point) + (set-buffer (process-buffer proc)) + ;; Insert the text, moving the process-marker. + (setq point (goto-char (process-mark proc))) + (insert string) + (set-marker (process-mark proc) (point)) + (if (and (= point (point-min)) + (string-match "^45" string)) + (progn + (nntp-snarf-error-message) + (funcall nntp-tmp-callback nil) + (set-process-filter proc nil)) + (setq nntp-tmp-first nil) + (if (re-search-backward nntp-tmp-wait-for nil t) + (progn + (if (buffer-name (get-buffer nntp-tmp-buffer)) + (save-excursion + (set-buffer (get-buffer nntp-tmp-buffer)) + (insert-buffer-substring (process-buffer proc)))) + (funcall nntp-tmp-callback t) + (set-process-filter proc nil) + (erase-buffer))))) + (set-buffer old-buffer)))) + + (defun nntp-retrieve-data (command address port buffer + &optional wait-for callback decode) + "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." + (let ((process (or (nntp-find-connection buffer) + (nntp-open-connection buffer)))) + (if (not process) + (nnheader-report 'nntp "Couldn't open connection to %a" address) + (unless nntp-inhibit-erase + (save-excursion + (set-buffer (process-buffer process)) + (erase-buffer))) + (nntp-send-string process command) + (cond + ((eq callback 'ignore) + t) + ((and callback wait-for) + (set-process-filter + process (nntp-make-process-filter wait-for callback buffer decode)) + t) + (wait-for + (nntp-wait-for process wait-for buffer decode)) + (t t))))) + + (defun nntp-send-string (process string) + "Send STRING to PROCESS." + (process-send-string process (concat string "\r\n"))) + + (defun nntp-wait-for (process wait-for buffer &optional decode) + "Wait for WAIT-FOR to arrive from PROCESS." + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-min)) + (while (not (looking-at "[2345]")) + (nntp-accept-process-output process) + (goto-char (point-min))) + (prog1 + (if (looking-at "[345]") + (progn + (nntp-snarf-error-message) + nil) + (goto-char (point-max)) + (while (not (re-search-backward wait-for nil t)) + (nntp-accept-process-output process)) + (nntp-decode-text (not decode)) + (save-excursion + (set-buffer buffer) + (insert-buffer-substring (process-buffer process)) + t)) + (erase-buffer)))) + + (defun nntp-snarf-error-message () + "Save the error message in the current buffer." + (setq nntp-status-string (buffer-string))) + + (defun nntp-accept-process-output (process) + "Wait for output from PROCESS and message some dots." + (message "Reading%s" (make-string (/ (point-max) 1000) ?.)) + (accept-process-output process)) + + (defun nntp-accept-response () + "Wait for output from the process that outputs to BUFFER." + (nntp-accept-process-output (nntp-find-connection nntp-server-buffer))) + + (defun nntp-possibly-change-group (group server &optional connectionless) + (when server + (or (nntp-server-opened server) + (nntp-open-server server nil connectionless))) + + (or (nntp-find-connection nntp-server-buffer) + (nntp-open-connection nntp-server-buffer)) + + (when group + (let ((entry (nntp-find-connection-entry nntp-server-buffer))) + (when (not (equal group (caddr entry))) + (nntp-request-group group))))) + + (defun nntp-decode-text (&optional cr-only) + "Decode the text in the current buffer." + (goto-char (point-min)) + (while (search-forward "\r" nil t) + (delete-char -1)) + (unless cr-only + (goto-char (point-max)) + (forward-line -1) + (when (looking-at ".\n") + (delete-char 2)) + (goto-char (point-min)) + (delete-region (point) (progn (forward-line 1) (point))) + (while (search-forward "\n.." nil t) + (delete-char -1)))) + + (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) + (erase-buffer) + (cond + + ;; This server does not talk NOV. + ((not nntp-server-xover) + nil) + + ;; We don't care about gaps. + ((or (not nntp-nov-gap) + fetch-old) + (nntp-send-xover-command + (if fetch-old + (if (numberp fetch-old) + (max 1 (- (car articles) fetch-old)) + 1) + (car articles)) + (last articles) 'wait) + + (goto-char (point-min)) + (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) + (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 + ;; just send them off as fast as we can. That means that we have + ;; to count the number of responses we get back to find out when we + ;; have gotten all we asked for. + ((numberp nntp-nov-gap) + (let ((count 0) + (received 0) + (last-point (point-min)) + (buf nntp-server-buffer) ;(process-buffer (nntp-find-connection (current-buffer)))) + first) + ;; 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 articles) + (setq first (car articles)) + ;; Search forward until we find a gap, or until we run out of + ;; articles. + (while (and (cdr articles) + (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) + (setq articles (cdr articles))) + + (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. + (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 reproduce, 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) + (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)) + (while (search-forward "\r" nil t) + (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) + )))) + + 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)) + (nntp-inhibit-erase t)) + (if (stringp nntp-server-xover) + ;; If `nntp-server-xover' is a string, then we just send this + ;; command. + (if wait-for-reply + (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range) + ;; We do not wait for the reply. + (nntp-send-command "\r\n\\.\r\n" 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. + (while (and commands (eq nntp-server-xover 'try)) + (nntp-send-command "\r\n\\.\r\n" (car commands) range) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (and (looking-at "[23]") ; No error message. + ;; We also have to look at the lines. Some buggy + ;; servers give back simple lines with just the + ;; article number. How... helpful. + (progn + (forward-line 1) + (looking-at "[0-9]+\t...")) ; More text after number. + (setq nntp-server-xover (car commands)))) + (setq commands (cdr commands))) + ;; If none of the commands worked, we disable XOVER. + (when (eq nntp-server-xover 'try) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (setq nntp-server-xover nil))) + nntp-server-xover)))) + + (provide 'nntp) + + ;;; nntp.el ends here *** pub/sgnus/lisp/nnheader.el Thu Jan 18 03:06:31 1996 --- sgnus/lisp/nnheader.el Fri Jan 19 23:56:56 1996 *************** *** 142,147 **** --- 142,149 ---- (defvar news-reply-yank-from nil) (defvar news-reply-yank-message-id nil) + (defvar nnheader-callback-function nil) + (defun nnheader-init-server-buffer () "Initialize the Gnus-backend communication buffer." (save-excursion *************** *** 191,196 **** --- 193,216 ---- (while state (set (car (car state)) (nth 1 (car state))) (setq state (cdr state)))) + + (defun nnheader-change-server (backend server defs) + (let ((current-server (intern (format "%s-current-server" backend))) + (alist (intern (format "%s-server-alist" backend))) + (variables (intern (format "%s-server-variables" backend)))) + + (when (and (symbol-value current-server) + (not (equal server (symbol-value current-server)))) + (set alist + (cons (list (symbol-value current-server) + (nnheader-save-variables (symbol-value variables))) + (symbol-value alist)))) + (let ((state (assoc server (symbol-value alist)))) + (if (not state) + (nnheader-set-init-variables (symbol-value variables) defs) + (nnheader-restore-variables (nth 1 state)) + (set alist (delq state (symbol-value alist))))) + (set current-server server))) ;;; Various functions the backends use. *** pub/sgnus/lisp/nnmail.el Thu Jan 18 03:06:31 1996 --- sgnus/lisp/nnmail.el Sat Jan 20 06:14:04 1996 *************** *** 460,466 **** group)) (defun nnmail-process-babyl-mail-format (func) ! (let (start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) (re-search-forward --- 460,467 ---- group)) (defun nnmail-process-babyl-mail-format (func) ! (let ((case-fold-search t) ! start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) (re-search-forward *************** *** 523,529 **** (goto-char end)))) (defun nnmail-process-unix-mail-format (func) ! (let ((delim (concat "^" rmail-unix-mail-delimiter)) start message-id content-length end skip head-end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) --- 524,531 ---- (goto-char end)))) (defun nnmail-process-unix-mail-format (func) ! (let ((case-fold-search t) ! (delim (concat "^" rmail-unix-mail-delimiter)) start message-id content-length end skip head-end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) *************** *** 598,603 **** --- 600,606 ---- (defun nnmail-process-mmdf-mail-format (func) (let ((delim "^\^A\^A\^A\^A$") + (case-fold-search t) start message-id end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) *** pub/sgnus/lisp/nntp.el Thu Jan 18 03:06:31 1996 --- sgnus/lisp/nntp.el Fri Jan 19 23:26:58 1996 *************** *** 370,376 **** (cons (list nntp-current-server (nnheader-save-variables nntp-server-variables)) nntp-server-alist))) ! (let ((state (assoc server nntp-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) --- 370,376 ---- (cons (list nntp-current-server (nnheader-save-variables nntp-server-variables)) nntp-server-alist))) ! (let ((state (assoc server nntp-server-alist))) (if state (progn (nnheader-restore-variables (nth 1 state)) *** pub/sgnus/lisp/nnvirtual.el Thu Jan 18 03:06:31 1996 --- sgnus/lisp/nnvirtual.el Fri Jan 19 23:27:00 1996 *************** *** 377,397 **** (mapcar (lambda (g) (let* ((active (or (gnus-active g) (gnus-activate-group g))) ! (unreads (gnus-list-of-unread-articles g)) (marks (gnus-uncompress-marks (gnus-info-marks (gnus-get-info g))))) - (when gnus-use-cache - (push (cons 'cache (gnus-cache-articles-in-group g)) - marks)) (when active ! (setq div (/ (float (car active)) ! (if (zerop (cdr active)) ! 1 (cdr active)))) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (nnvirtual-marks n marks))) ! (gnus-uncompress-range active))))) nnvirtual-component-groups)) (lambda (m1 m2) (< (car m1) (car m2))))) --- 377,399 ---- (mapcar (lambda (g) (let* ((active (or (gnus-active g) (gnus-activate-group g))) ! (unreads (and active (gnus-list-of-unread-articles ! g))) (marks (gnus-uncompress-marks (gnus-info-marks (gnus-get-info g))))) (when active ! (when gnus-use-cache ! (push (cons 'cache (gnus-cache-articles-in-group g)) ! marks)) ! (when active ! (setq div (/ (float (car active)) ! (if (zerop (cdr active)) ! 1 (cdr active)))) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (nnvirtual-marks n marks))) ! (gnus-uncompress-range active)))))) nnvirtual-component-groups)) (lambda (m1 m2) (< (car m1) (car m2))))) *** pub/sgnus/lisp/ChangeLog Thu Jan 18 03:06:39 1996 --- sgnus/lisp/ChangeLog Sun Jan 21 03:00:40 1996 *************** *** 1,3 **** --- 1,130 ---- + Sun Jan 21 01:59:13 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-recenter): Recenter horizontally. + + Sun Jan 21 01:08:58 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-horizontal-recenter): Would infloop. + (gnus-cut-threads): Cut off `more' threads. + + * gnus-xmas.el (gnus-xmas-move-overlay): Handle detached extents. + (gnus-xmas-make-overlay): New function. + + * gnus-salt.el (gnus-tree-recenter): Search all frames. + + * gnus.el (gnus-all-windows-visible-p): Be `frame' aware. + + * gnus-salt.el (gnus-salt): Provide. + + * gnus-xmas.el (gnus-xmas-tree-minimize): New function. + + * gnus-salt.el (gnus-tree-read-summary-keys): Don't use + `overlay-end'. + + * gnus-xmas.el (gnus-xmas-define): Redefine overlay-end. + + * gnus-ems.el (gnus-overlay-end): New alias. + + * gnus-salt.el (gnus-tree-minimize): Don't use + `save-selected-window'. + + Sat Jan 20 08:40:46 1996 Lars Ingebrigtsen + + * gnus-uu.el (gnus-uu-grab-articles): Give a better message. + + Sat Jan 20 08:19:29 1996 Colin Rafferty + + * gnus.el (gnus-summary-reparent-thread): New command and + keystroke. + + Sat Jan 20 04:12:17 1996 Lars Ingebrigtsen + + * gnus-score.el (gnus-score-kill-help-buffer): New function. + (gnus-summary-increase-score): Use the default values. + + * gnus-cache.el (gnus-jog-cache): Make sure Gnus is started. + (gnus-jog-cache): New implementation. + + * gnus.el (gnus-unload): Also unload nn*. + (gnus-group-mark-region): New command and keystroke. + + * nnmail.el (nnmail-process-babyl-mail-format): Fold case. + (nnmail-process-unix-mail-format): Ditto. + (nnmail-process-mmdf-mail-format): Ditto. + + * gnus.el (gnus-group-faq-directory): New default. + + * gnus-mh.el (gnus-mh-mail-setup): Use original article buffer. + + * gnus-salt.el (gnus-tree-highlight-article): Move point. + + Sat Jan 20 03:32:17 1996 Kai Grossjohann + + * gnus.el (gnus-summary-find-matching): Typo. + + Sat Jan 20 00:54:13 1996 Lars Ingebrigtsen + + * gnus.el (gnus-build-sparse-threads): Allow `more' as a value. + (gnus-request-update-mark): Wrong number of parameters. + + * gnus-vis.el (gnus-article-highlight-signature): Use new function. + + * gnus.el (gnus-group-uncollapsed-levels): New variable. + (gnus-short-group-name): Use it. + (gnus-narrow-to-signature): New function. + (gnus-article-hide-signature): Use it. + + * gnus-msg.el (gnus-inews-insert-archive-gcc): Allow disabling + archiving. + (gnus-inews-insert-archive-gcc): Allow var to be a function. + (gnus-inews-real-user-address): Always use `system-name'. + + * gnus.el (gnus-sort-threads): Would choke when no sorting + functions were specified. + (gnus-group-sort-groups): Ditto. + + * gnus-cite.el (gnus-dissect-cited-text): New function. + (gnus-article-toggle-cited-text): New function. + (gnus-cited-text-button-line-format): New variable. + (gnus-article-hide-citation): Add buttons. + (gnus-cited-lines-visible): New variable. + + * gnus.el (gnus-summary-move-article): Don't allow moving to the + current group. + + Sat Jan 20 00:50:36 1996 Kai Grossjohann + + * gnus.el (gnus-summary-move-article): Didn't update marks. + + Sat Jan 20 00:16:44 1996 Lars Ingebrigtsen + + * gnus.el (gnus-request-accept-article): Make sure there's a + newline at the end of the article. + + * gnus-soup.el (gnus-soup-parse-areas): Kill buffer after + parsing. + + Thu Jan 18 11:50:06 1996 Wes Hardaker + + * gnus.el (auto-load): Added gnus-group-display-picons to the + gnus-picon auto-load list. Also made the refernce(s) interactive. + + Fri Jan 19 04:20:16 1996 Lars Magne Ingebrigtsen + + * gnus-xmas.el (gnus-xmas-read-event-char): Don't force event keys + to be numbers. + + Fri Jan 19 04:11:39 1996 Lars Magne Ingebrigtsen + + * gnus-srvr.el (gnus-server-position-point): Define. + + * gnus-salt.el (gnus-tree-recenter): Don't use + `save-selected-window'. + + Thu Jan 18 03:08:40 1996 Lars Magne Ingebrigtsen + + * gnus.el: 0.29 is released. + Wed Jan 17 17:00:55 1996 Steven L. Baur * gnus-msg.el (gnus-inews-domain-name): mail-host-address may not *** pub/sgnus/texi/gnus.texi Thu Jan 18 03:06:41 1996 --- sgnus/texi/gnus.texi Sat Jan 20 08:50:53 1996 *************** *** 1251,1257 **** used. @item c ! Short (collapsed) group name. @item u User defined specifier. The next character in the format string should --- 1251,1260 ---- used. @item c ! @vindex gnus-group-uncollapsed-levels ! Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels} ! variable says how many levels to leave at the end of the group name. ! The default is @samp{1}. @item u User defined specifier. The next character in the format string should *************** *** 1741,1746 **** --- 1744,1754 ---- @findex gnus-group-mark-region Mark all groups between point and mark (@code{gnus-group-mark-region}). + @item M b + @kindex M b (Group) + @findex gnus-group-mark-buffer + Mark all groups in the buffer (@code{gnus-group-mark-buffer}). + @item M r @kindex M r (Group) @findex gnus-group-mark-regexp *************** *** 6155,6161 **** lines. If you select a gap, Gnus will try to fetch the article in question.) If this variable is @code{t}, Gnus will display all these "gaps" without regard for whether they are useful for completing the ! thread or not. This variable is @code{nil} by default. @item gnus-summary-gather-subject-limit @vindex gnus-summary-gather-subject-limit --- 6163,6171 ---- lines. If you select a gap, Gnus will try to fetch the article in question.) If this variable is @code{t}, Gnus will display all these "gaps" without regard for whether they are useful for completing the ! thread or not. Finally, if this variable is @code{more}, Gnus won't cut ! off sparse leaf nodes that don't lead anywhere. This variable is ! @code{nil} by default. @item gnus-summary-gather-subject-limit @vindex gnus-summary-gather-subject-limit *************** *** 6370,6382 **** @findex gnus-summary-hide-all-threads Hide all threads (@code{gnus-summary-hide-all-threads}). ! @item T R ! @kindex T R (Summary) @findex gnus-summary-rethread-current Re-thread the thread the current article is part of (@code{gnus-summary-rethread-current}). This works even when the summary buffer is otherwise unthreaded. @end table The following commands are thread movement commands. They all --- 6380,6399 ---- @findex gnus-summary-hide-all-threads Hide all threads (@code{gnus-summary-hide-all-threads}). ! @item T t ! @kindex T t (Summary) @findex gnus-summary-rethread-current Re-thread the thread the current article is part of (@code{gnus-summary-rethread-current}). This works even when the summary buffer is otherwise unthreaded. + @item T ^ + @kindex T ^ (Summary) + @findex gnus-summary-reparent-thread + Make the current article the child of the marked (or previous) article + (@code{gnus-summary-reparent-thread}. The change will not be visible + until the next group retrieval. + @end table The following commands are thread movement commands. They all *************** *** 7512,7518 **** @item W W c @kindex W W c (Summary) @findex gnus-article-hide-citation ! Hide citation (@code{gnus-article-hide-citation}). Two variables for customizing the hiding: @table @code --- 7529,7535 ---- @item W W c @kindex W W c (Summary) @findex gnus-article-hide-citation ! Hide citation (@code{gnus-article-hide-citation}). Some variables for customizing the hiding: @table @code *************** *** 7527,7532 **** --- 7544,7568 ---- The cited text must be have at least this length (default 10) before it is hidden. + @item gnus-cited-text-button-line-format + @vindex gnus-cited-text-button-line-format + Gnus adds buttons show where the cited text has been hidden, and to + allow toggle hiding the text. The format of the variable is specified + by this format-like variable. These specs are legal: + + @table @samp + @item b + Start point of the hidden text. + @item e + End point of the hidden text. + @item l + Length of the hidden text. + @end table + + @item gnus-cited-lines-visible + @vindex gnus-cited-lines-visible + The number of lines at the beginning of the cited text to leave shown. + @end table @item W W C *************** *** 7545,7550 **** --- 7581,7594 ---- Also see @xref{Article Highlighting} for further variables for citation customization. + + @vindex gnus-signature-limit + @code{gnus-signature-limit} provides 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 any parameters, and if it returns @code{nil}, there is no + signature in the buffer. If it is a string, it will be used as a + regexp. If it matches, the text in question is not a signature. @node Article Washing *** pub/sgnus/texi/ChangeLog Thu Jan 18 03:06:40 1996 --- sgnus/texi/ChangeLog Sat Jan 20 08:50:54 1996 *************** *** 1,3 **** --- 1,12 ---- + Sat Jan 20 01:44:32 1996 Lars Ingebrigtsen + + * gnus.texi (Article Hiding): Addition. + (Group Buffer Format): Addition. + (Article Hiding): Addition. + (Customizing Threading): Addition. + (Marking Groups): Addition. + (Thread Commands): Addition. + Wed Jan 17 02:26:15 1996 Lars Ingebrigtsen * gnus.texi (Group Maintenance): Addition.