message-yank-buffer.
1999-11-26 Hrvoje Niksic <hniksic@iskon.hr>
* message.el (message-shorten-references): Cut references to 31
elements, then either fold them or shorten them to 988 characters.
(message-shorten-1): New function.
(message-cater-to-broken-inn): New variable.
1999-12-01 21:47:10 Eric Marsden <emarsden@mail.dotcom.fr>
* nnslashdot.el (nnslashdot-lose): New function.
1999-12-01 21:08:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mm-view.el (mm-inline-message): Not the right type of charset is
being fetched here. Let the group charset rule.
(mm-inline-message): Ignore us-ascii.
+1999-12-01 21:59:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-mode-map): Changed keystroke for
+ message-yank-buffer.
+
+1999-11-26 Hrvoje Niksic <hniksic@iskon.hr>
+
+ * message.el (message-shorten-references): Cut references to 31
+ elements, then either fold them or shorten them to 988 characters.
+ (message-shorten-1): New function.
+ (message-cater-to-broken-inn): New variable.
+
+1999-12-01 21:47:10 Eric Marsden <emarsden@mail.dotcom.fr>
+
+ * nnslashdot.el (nnslashdot-lose): New function.
+
+1999-12-01 21:08:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-inline-message): Not the right type of charset is
+ being fetched here. Let the group charset rule.
+ (mm-inline-message): Ignore us-ascii.
+
+1999-11-24 Carsten Leonhardt <leo@arioch.oche.de>
+
+ * mail-source.el (mail-source-fetch-maildir): work around the
+ ommitted "file-regular-p" in efs/ange-ftp
+
+1999-12-01 19:59:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime-1): Don't insert extra empty line.
+ (mml-generate-mime-1): Use the encoding param.
+
+ * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual.
+
+ * gnus-cache.el (gnus-cache-possibly-enter-article): Require
+ gnus-art before binding its variables.
+
+ * gnus-art.el (gnus-article-prepare-display): Run the prepare
+ after the MIME.
+
+1999-12-01 19:48:14 Rupa Schomaker <rupa-list@rupa.com>
+
+ * message.el (message-clone-locals): Use it.
+
+ * gnus-msg.el (gnus-configure-posting-styles): Make
+ user-mail-address local.
+
1999-11-20 Simon Josefsson <jas@pdc.kth.se>
* gnus-start.el (gnus-get-unread-articles): Scan each method only
1999-12-01 17:37:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-generate-new-buffer-clone-locals): Use varstr.
+ (message-clone-locals): Ditto.
+
* gnus-sum.el (gnus-summary-enter-digest-group): Have the digest
group inherit reply-to or from.
(setq buffer-read-only nil
gnus-article-wash-types nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
- (gnus-run-hooks 'gnus-article-prepare-hook)
(when gnus-display-mime-function
- (funcall gnus-display-mime-function))))
+ (funcall gnus-display-mime-function))
+ (gnus-run-hooks 'gnus-article-prepare-hook)))
;;;
;;; Gnus MIME viewing functions
t ; The article already is saved.
(save-excursion
(set-buffer nntp-server-buffer)
+ (require 'gnus-art)
(let ((gnus-use-cache nil)
(gnus-article-decode-hook nil))
(gnus-request-article-this-buffer number group))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
(let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
gnus-article-prepare-hook
gnus-article-decode-hook
gnus-display-mime-function
- gnus-break-pages
- gnus-visual)
+ gnus-break-pages)
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(let ((found 0)
(mail-source-string (format "maildir:%s" path)))
(dolist (file (directory-files path t))
- (when (and (file-regular-p file)
+ (when (and (not (file-directory-p file))
(not (if function
(funcall function file mail-source-crash-box)
(rename-file file mail-source-crash-box))))
:group 'message-sending
:type '(repeat string))
+(defvar message-cater-to-broken-inn t
+ "Non-nil means Gnus should not fold the `References' header.
+Folding `References' makes ancient versions of INN create incorrect
+NOV lines.")
+
(defvar gnus-post-method)
(defvar gnus-select-method)
(defcustom message-post-method
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
- (define-key message-mode-map "\C-c\C-Y" 'message-yank-buffer)
+ (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(let ((errbuf (if message-interactive
- (generate-new-buffer " sendmail errors")
+ (message-generate-new-buffer-clone-locals " sendmail errors")
0))
resend-to-addresses delimline)
(let ((case-fold-search t))
;; But some systems are more broken with -f, so
;; we'll let users override this.
(if (null message-sendmail-f-is-evil)
- (list "-f" (user-login-name)))
+ (list "-f"
+ (if (null user-mail-address)
+ (user-login-name)
+ (user-mail-address))
+ ))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
(defun message-fill-header (header value)
(let ((begin (point))
- (fill-column 990)
+ (fill-column 78)
(fill-prefix "\t"))
(insert (capitalize (symbol-name header))
": "
(replace-match " " t t))
(goto-char (point-max)))))
+(defun message-shorten-1 (list cut surplus)
+ ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+ (setcdr (nthcdr (- cut 2) refs)
+ (nthcdr (+ (- cut 2) surplus 1) refs)))
+
(defun message-shorten-references (header references)
- "Limit REFERENCES to be shorter than 988 characters."
- (let ((max 988)
- (cut 4)
+ "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+If folding is disallowed, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until they are."
+ (let ((maxcount 31)
+ (count 0)
+ (cut 6)
refs)
(with-temp-buffer
(insert references)
(goto-char (point-min))
+ ;; Cons a list of valid references.
(while (re-search-forward "<[^>]+>" nil t)
(push (match-string 0) refs))
- (setq refs (nreverse refs))
- (while (> (length (mapconcat 'identity refs " ")) max)
- (when (< (length refs) (1+ cut))
- (decf cut))
- (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
- (insert (capitalize (symbol-name header)) ": "
- (mapconcat 'identity refs " ") "\n")))
+ (setq refs (nreverse refs)
+ count (length refs)))
+
+ ;; If the list has more than MAXCOUNT elements, trim it by
+ ;; removing the CUTth element and the required number of
+ ;; elements that follow.
+ (when (> count maxcount)
+ (let ((surplus (- count maxcount)))
+ (message-shorten-1 refs cut surplus)
+ (decf count surplus)))
+
+ ;; If folding is disallowed, make sure the total length (including
+ ;; the spaces between) will be less than MAXSIZE characters.
+ (when message-cater-to-broken-inn
+ (let ((maxsize 988)
+ (totalsize (+ (apply #'+ (mapcar #'length refs))
+ (1- count)))
+ (surplus 0)
+ (ptr (nthcdr (1- cut) refs)))
+ ;; Decide how many elements to cut off...
+ (while (> totalsize maxsize)
+ (decf totalsize (1+ (length (car ptr))))
+ (incf surplus)
+ (setq ptr (cdr ptr)))
+ ;; ...and do it.
+ (when (> surplus 0)
+ (message-shorten-1 refs cut surplus))))
+
+ ;; Finally, collect the references back into a string and insert
+ ;; it into the buffer.
+ (let ((refstring (mapconcat #'identity refs " ")))
+ (if message-cater-to-broken-inn
+ (insert (capitalize (symbol-name header)) ": "
+ refstring "\n")
+ (message-fill-header header refstring)))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
- (message-clone-locals oldbuf)
+ (message-clone-locals oldbuf varstr)
(current-buffer))))
-(defun message-clone-locals (buffer)
+(defun message-clone-locals (buffer &optional varstr)
"Clone the local variables from BUFFER to the current buffer."
(let ((locals (save-excursion
(set-buffer buffer)
(buffer-local-variables)))
- (regexp "^gnus\\|^nn\\|^message"))
+ (regexp "^gnus\\|^nn\\|^message\\|^user-mail-address"))
(mapcar
(lambda (local)
(when (and (consp local)
(car local)
- (string-match regexp (symbol-name (car local))))
+ (string-match regexp (symbol-name (car local)))
+ (or (null varstr)
+ (string-match varstr (symbol-name (car local)))))
(ignore-errors
(set (make-local-variable (car local))
(cdr local)))))
(delete-char 1)
(search-forward "\n\n")
(setq lines (buffer-substring (point-min) (1- (point))))
- (delete-region (point-min) (point))))))
+ (delete-region (point-min) (point))))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-header "Mime-Version")
(setq start nil)))
charset)))))))
-(defun mm-body-encoding (charset)
+(defun mm-body-encoding (charset &optional encoding)
"Do Content-Transfer-Encoding and return the encoding of the current buffer."
(let ((bits (mm-body-7-or-8)))
(cond
((eq charset mail-parse-charset)
bits)
(t
- (let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist))
+ (let ((encoding (or encoding
+ (cdr (assq charset mm-body-charset-encoding-alist))
(mm-qp-or-base64))))
(mm-encode-content-transfer-encoding encoding "text/plain")
encoding)))))
(charset (mail-content-type-get
(mm-handle-type handle) 'charset))
gnus-displaying-mime handles)
+ (when charset
+ (setq charset (intern (downcase charset)))
+ (when (eq charset 'us-ascii)
+ (setq charset nil)))
(save-excursion
(save-restriction
(narrow-to-region b b)
(mm-insert-part handle)
(let (gnus-article-mime-handles
- (gnus-newsgroup-charset (or charset gnus-newsgroup-charset)))
+ (gnus-newsgroup-charset
+ (or charset gnus-newsgroup-charset)))
(run-hooks 'gnus-article-decode-hook)
(gnus-article-prepare-display)
(setq handles gnus-article-mime-handles))
(delete-region (+ (match-beginning 0) 2)
(+ (match-beginning 0) 3))))))
(setq charset (mm-encode-body))
- (setq encoding (mm-body-encoding charset))
+ (setq encoding (mm-body-encoding charset
+ (cdr (assq 'encoding cont))))
(setq coded (buffer-string)))
(mm-with-unibyte-buffer
(cond
(let ((mml-boundary (mml-compute-boundary cont)))
(insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n"
type mml-boundary))
- (insert "\n")
(setq cont (cddr cont))
(while cont
(insert "\n--" mml-boundary "\n")
(defvoo nnmh-status-string "")
(defvoo nnmh-group-alist nil)
-(defvoo nnmh-allow-delete-final nil)
+(defvar nnmh-allow-delete-final nil)
\f
(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old)
(nnslashdot-possibly-change-server group server)
- (unless gnus-nov-is-evil
- (if nnslashdot-threaded
- (nnslashdot-threaded-retrieve-headers articles group)
- (nnslashdot-sane-retrieve-headers articles group))))
+ (condition-case why
+ (unless gnus-nov-is-evil
+ (if nnslashdot-threaded
+ (nnslashdot-threaded-retrieve-headers articles group)
+ (nnslashdot-sane-retrieve-headers articles group)))
+ (search-failed (nnslashdot-lose why))))
(deffoo nnslashdot-threaded-retrieve-headers (articles group)
(let ((last (car (last articles)))
(deffoo nnslashdot-request-article (article &optional group server buffer)
(nnslashdot-possibly-change-server group server)
(let (contents)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (when (and (stringp article)
- (string-match "%\\([0-9]+\\)@" article))
- (setq article (string-to-number (match-string 1 article))))
- (when (numberp article)
- (if (= article 1)
- (progn
- (re-search-forward "Posted by .* on ")
- (forward-line 1)
+ (condition-case why
+ (save-excursion
+ (set-buffer nnslashdot-buffer)
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (when (and (stringp article)
+ (string-match "%\\([0-9]+\\)@" article))
+ (setq article (string-to-number (match-string 1 article))))
+ (when (numberp article)
+ (if (= article 1)
+ (progn
+ (re-search-forward "Posted by .* on ")
+ (forward-line 1)
+ (setq contents
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward
+ "<p>.*A href=http://slashdot.org/article.pl")
+ (match-beginning 0)))))
+ (search-forward (format "<a name=\"%d\">" (1- article)))
(setq contents
(buffer-substring
- (point)
- (progn
- (re-search-forward
- "<p>.*A href=http://slashdot.org/article.pl")
- (match-beginning 0)))))
- (search-forward (format "<a name=\"%d\">" (1- article)))
- (setq contents
- (buffer-substring
- (re-search-forward "<td[^>]+>")
- (search-forward "</td>")))))))
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (insert contents)
- (goto-char (point-min))
- (while (search-forward "<br><br>" nil t)
- (replace-match "<p>" t t))
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups))
- "\n")
- (let ((header (cdr (assq article nnslashdot-headers))))
- (nnheader-insert-header header))
- (nnheader-report 'nnslashdot "Fetched article %s" article)
- (cons group article)))))
+ (re-search-forward "<td[^>]+>")
+ (search-forward "</td>")))))))
+ (search-failed (nnslashdot-lose why))))
+
+ (when contents
+ (save-excursion
+ (set-buffer (or buffer nntp-server-buffer))
+ (erase-buffer)
+ (insert contents)
+ (goto-char (point-min))
+ (while (search-forward "<br><br>" nil t)
+ (replace-match "<p>" t t))
+ (goto-char (point-min))
+ (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
+ (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups))
+ "\n")
+ (let ((header (cdr (assq article nnslashdot-headers))))
+ (nnheader-insert-header header))
+ (nnheader-report 'nnslashdot "Fetched article %s" article)
+ (cons group article)))))
(deffoo nnslashdot-close-server (&optional server)
(when (and (nnslashdot-server-opened server)
(nnslashdot-possibly-change-server nil server)
(let ((number 0)
sid elem description articles gname)
- ;; First we do the Ultramode to get info on all the latest groups.
- (with-temp-buffer
- (nnweb-insert "http://slashdot.org/slashdot.xml")
- (goto-char (point-min))
- (while (search-forward "<story>" nil t)
- (narrow-to-region (point) (search-forward "</story>"))
- (goto-char (point-min))
- (re-search-forward "<title>\\([^<]+\\)</title>")
- (setq description (match-string 1))
- (re-search-forward "<url>\\([^<]+\\)</url>")
- (setq sid (match-string 1))
- (string-match "/\\([0-9/]+\\).shtml" sid)
- (setq sid (match-string 1 sid))
- (re-search-forward "<comments>\\([^<]+\\)</comments>")
- (setq articles (string-to-number (match-string 1)))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid) nnslashdot-groups))
- (goto-char (point-max))
- (widen)))
- ;; Then do the older groups.
- (while (> (- nnslashdot-group-number number) 0)
- (with-temp-buffer
- (let ((case-fold-search t))
- (nnweb-insert (format nnslashdot-active-url number))
- (goto-char (point-min))
- (while (re-search-forward
- "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" nil t)
- (setq sid (match-string 1)
- description (match-string 2))
- (forward-line 1)
- (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
- (setq articles (string-to-number (match-string 1))))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid) nnslashdot-groups)))))
- (incf number 30))
+ (condition-case why
+ ;; First we do the Ultramode to get info on all the latest groups.
+ (with-temp-buffer
+ (nnweb-insert "http://slashdot.org/slashdot.xml")
+ (goto-char (point-min))
+ (while (search-forward "<story>" nil t)
+ (narrow-to-region (point) (search-forward "</story>"))
+ (goto-char (point-min))
+ (re-search-forward "<title>\\([^<]+\\)</title>")
+ (setq description (match-string 1))
+ (re-search-forward "<url>\\([^<]+\\)</url>")
+ (setq sid (match-string 1))
+ (string-match "/\\([0-9/]+\\).shtml" sid)
+ (setq sid (match-string 1 sid))
+ (re-search-forward "<comments>\\([^<]+\\)</comments>")
+ (setq articles (string-to-number (match-string 1)))
+ (setq gname (concat description " (" sid ")"))
+ (if (setq elem (assoc gname nnslashdot-groups))
+ (setcar (cdr elem) articles)
+ (push (list gname articles sid) nnslashdot-groups))
+ (goto-char (point-max))
+ (widen)))
+ ;; Then do the older groups.
+ (while (> (- nnslashdot-group-number number) 0)
+ (with-temp-buffer
+ (let ((case-fold-search t))
+ (nnweb-insert (format nnslashdot-active-url number))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" nil t)
+ (setq sid (match-string 1)
+ description (match-string 2))
+ (forward-line 1)
+ (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t)
+ (setq articles (string-to-number (match-string 1))))
+ (setq gname (concat description " (" sid ")"))
+ (if (setq elem (assoc gname nnslashdot-groups))
+ (setcar (cdr elem) articles)
+ (push (list gname articles sid) nnslashdot-groups)))))
+ (incf number 30))
+ (search-failed (nnslashdot-lose why)))
(nnslashdot-write-groups)
(nnslashdot-generate-active)
t))
-
+
(deffoo nnslashdot-request-newgroups (date &optional server)
(nnslashdot-possibly-change-server nil server)
(nnslashdot-generate-active)
(insert (prin1-to-string (car elem))
" " (number-to-string (cadr elem)) " 1 y\n"))))
+(defun nnslashdot-lose (why)
+ (error "Slashdot HTML has changed; please get a new version of nnslashdot"))
+
(provide 'nnslashdot)
;;; nnslashdot.el ends here
projects / gnus / commitdiff