*** pub/pgnus/lisp/binhex.el Sat Nov 14 01:50:22 1998 --- pgnus/lisp/binhex.el Sat Nov 14 05:47:25 1998 *************** *** 3,9 **** ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 ! ;; $Revision: 5.1 $ ;; Time-stamp: ;; Keywords: binhex --- 3,9 ---- ;; Author: Shenghuo Zhu ;; Create Date: Oct 1, 1998 ! ;; $Revision: 5.2 $ ;; Time-stamp: ;; Keywords: binhex *** pub/pgnus/lisp/gnus-sum.el Sat Nov 14 01:50:25 1998 --- pgnus/lisp/gnus-sum.el Sat Nov 14 05:47:25 1998 *************** *** 2391,2397 **** (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) ! t ; All non-existent numbers are the last article. :-) (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () --- 2391,2397 ---- (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) ! t ; All non-existent numbers are the last article. :-) (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () *************** *** 2615,2621 **** kill-buffer no-display select-articles) (setq show-all nil ! select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next --- 2615,2621 ---- kill-buffer no-display select-articles) (setq show-all nil ! select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next *************** *** 4211,4217 **** (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) ! type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) --- 4211,4217 ---- (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) ! type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) *************** *** 4704,4717 **** (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (header (cond ((and old-header use-old-header) ! old-header) ! ((and (numberp id) ! (gnus-number-to-header id)) ! (gnus-number-to-header id)) ! (t ! (gnus-read-header id)))) ! (number (and (numberp id) id)) ! d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. --- 4704,4717 ---- (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (header (cond ((and old-header use-old-header) ! old-header) ! ((and (numberp id) ! (gnus-number-to-header id)) ! (gnus-number-to-header id)) ! (t ! (gnus-read-header id)))) ! (number (and (numberp id) id)) ! d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. *************** *** 5948,5956 **** (interactive) (prog1 (when (gnus-summary-first-subject) ! (gnus-summary-show-thread) ! (gnus-summary-first-subject) ! (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) (defun gnus-summary-best-unread-article () --- 5948,5956 ---- (interactive) (prog1 (when (gnus-summary-first-subject) ! (gnus-summary-show-thread) ! (gnus-summary-first-subject) ! (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) (defun gnus-summary-best-unread-article () *************** *** 9054,9060 **** (push (cons prev (cdr active)) read)) (setq read (if (> (length read) 1) (nreverse read) read)) (if compute ! read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register --- 9054,9060 ---- (push (cons prev (cdr active)) read)) (setq read (if (> (length read) 1) (nreverse read) read)) (if compute ! read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register *************** *** 9064,9070 **** (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. ! (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) --- 9064,9070 ---- (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. ! (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) *** pub/pgnus/lisp/gnus.el Sat Nov 14 01:50:25 1998 --- pgnus/lisp/gnus.el Sat Nov 14 05:47:26 1998 *************** *** 254,260 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.43" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) --- 254,260 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.44" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) *** pub/pgnus/lisp/message.el Sat Nov 14 01:50:26 1998 --- pgnus/lisp/message.el Sat Nov 14 05:47:26 1998 *************** *** 863,868 **** --- 863,869 ---- (defvar message-this-is-news nil) (defvar message-this-is-mail nil) (defvar message-draft-article nil) + (defvar message-mime-part nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) *************** *** 1273,1278 **** --- 1274,1281 ---- (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) + (define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part) + (define-key message-mode-map "\t" 'message-tab)) (easy-menu-define *************** *** 1341,1348 **** C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) ! (make-local-variable 'message-reply-buffer) ! (setq message-reply-buffer nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) --- 1344,1350 ---- C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) ! (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) *************** *** 1384,1393 **** (make-local-variable 'message-newsreader) (make-local-variable 'message-mailer) (make-local-variable 'message-post-method) ! (make-local-variable 'message-sent-message-via) ! (setq message-sent-message-via nil) ! (make-local-variable 'message-checksum) ! (setq message-checksum nil) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) --- 1386,1394 ---- (make-local-variable 'message-newsreader) (make-local-variable 'message-mailer) (make-local-variable 'message-post-method) ! (set (make-local-variable 'message-sent-message-via) nil) ! (set (make-local-variable 'message-checksum) nil) ! (set (make-local-variable 'message-mime-part) 0) ;;(when (fboundp 'mail-hist-define-keys) ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) *************** *** 4075,4080 **** --- 4076,4082 ---- (defun message-encode-message-body () "Examine the message body, encode it, and add the requisite headers." + (message-format-mime) (when (featurep 'mule) (let (old-headers) (save-excursion *************** *** 4082,4088 **** (message-narrow-to-headers-or-head) (unless (setq old-headers (message-fetch-field "mime-version")) (message-remove-header ! "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)) (goto-char (point-max)) (widen) (narrow-to-region (point) (point-max)) --- 4084,4091 ---- (message-narrow-to-headers-or-head) (unless (setq old-headers (message-fetch-field "mime-version")) (message-remove-header ! "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" ! t)) (goto-char (point-max)) (widen) (narrow-to-region (point) (point-max)) *************** *** 4102,4107 **** --- 4105,4154 ---- (mm-insert-rfc822-headers charset encoding)) (mm-encode-body))))))) + (defun message-insert-mime-part (file type) + "Insert a multipart/alternative part into the buffer." + (interactive + (let* ((file (read-file-name "Insert file: " nil nil t)) + (type (mm-default-file-encoding file))) + (setq mime-type + (read-string (format "MIME type for %s: " file) (car type))) + (unless (equal mime-type (car type)) + (setq type (list mime-type))) + (list file type))) + + (insert (format "-*[%s %d]*-\n" (car type) (incf message-mime-part))) + (let ((current buffer-file-name) + (part message-mime-part)) + (mm-with-unibyte-buffer + (insert-file file) + (mm-insert-headers type (mm-encode-buffer type) file) + (nndraft-save-mime-part current part)))) + + (defun message-format-mime () + "Insert all the MIME parts." + (when (not (zerop message-mime-part)) + (message-narrow-to-headers) + (goto-char (point-max)) + (let ((boundary (mm-insert-multipart-headers)) + (current buffer-file-name)) + (widen) + (forward-line 1) + (insert "This is a MIME message. If you are reading this -- *phphthth*.\n\n") + (insert "--" boundary "\n\n") + (while (re-search-forward + "-\\*\\[\\([-a-z/A-Z0-9]+\\) \\([0-9]+\\)\\]\\*-" nil t) + (let ((part (string-to-number (match-string 2)))) + (delete-region (match-beginning 0) (match-end 0)) + (insert "\n--" boundary "\n") + (narrow-to-region (point) (point)) + (nndraft-get-mime-part current part) + (goto-char (point-max)) + (widen) + (insert "\n--" boundary "\n\n") + )) + (goto-char (point-max)) + (insert "\n--" boundary "--\n")))) + (run-hooks 'message-load-hook) (provide 'message) *** pub/pgnus/lisp/mm-encode.el Sun Sep 13 09:36:28 1998 --- pgnus/lisp/mm-encode.el Sat Nov 14 05:47:26 1998 *************** *** 26,31 **** --- 26,80 ---- (require 'mail-parse) + (defvar mm-mime-file-types + '(("\\.rtf$" "text/richtext") + ("\\.\\(html\\|htm\\)$" "text/html") + ("\\.ps$" "application/postscript" + (encoding quoted-printable) + (disposition "attachment")) + ("\\.\\(jpeg\\|jpg\\)$" "image/jpeg") + ("\\.gif$" "image/gif") + ("\\.png$" "image/png") + ("\\.\\(tiff\\|tif\\)$" "image/tiff") + ("\\.pic$" "image/x-pic") + ("\\.mag$" "image/x-mag") + ("\\.xbm$" "image/x-xbm") + ("\\.xwd$" "image/x-xwd") + ("\\.au$" "audio/basic") + ("\\.mpg$" "video/mpeg") + ("\\.txt$" "text/plain") + ("\\.el$" "application/octet-stream" + ("type" ."emacs-lisp")) + ("\\.lsp$" "application/octet-stream" + ("type" "common-lisp")) + ("\\.tar\\.gz$" "application/octet-stream" + ("type" "tar+gzip")) + ("\\.tgz$" "application/octet-stream" + ("type" "tar+gzip")) + ("\\.tar\\.Z$" "application/octet-stream" + ("type" "tar+compress")) + ("\\.taz$" "application/octet-stream" + ("type" "tar+compress")) + ("\\.gz$" "application/octet-stream" + ("type" "gzip")) + ("\\.Z$" "application/octet-stream" + ("type" "compress")) + ("\\.lzh$" "application/octet-stream" + ("type" . "lha")) + ("\\.zip$" "application/zip") + ("\\.diffs?$" "text/plain" + ("type" . "patch")) + ("\\.patch$" "application/octet-stream" + ("type" "patch")) + ("\\.signature" "text/plain") + (".*" "application/octet-stream")) + "*Alist of regexps and MIME types.") + + (defvar mm-content-transfer-encoding-defaults + '(("text/.*" quoted-printable) + (".*" base64)) + "Alist of regexps that match MIME types and their encodings.") + (defun mm-insert-rfc822-headers (charset encoding) "Insert text/plain headers with CHARSET and ENCODING." (insert "MIME-Version: 1.0\n") *************** *** 33,38 **** --- 82,165 ---- (mail-quote-string (downcase (symbol-name charset))) "\n") (insert "Content-Transfer-Encoding: " (downcase (symbol-name encoding)) "\n")) + + (defun mm-insert-multipart-headers () + "Insert multipart/mixed headers." + (let ((boundary "=-=-=")) + (insert "MIME-Version: 1.0\n") + (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" + boundary)) + boundary)) + + (defun mm-default-file-encoding (file) + "Return a default encoding for FILE." + (let ((types mm-mime-file-types) + type) + (catch 'found + (while (setq type (pop types)) + (when (string-match (car type) file) + (throw 'found (cdr type))) + (pop types))))) + + (defun mm-encode-content-transfer-encoding (encoding &optional type) + (cond + ((eq encoding 'quoted-printable) + (quoted-printable-encode-region (point-min) (point-max))) + ((eq encoding 'base64) + (when (equal type "text/plain") + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match "\r\n" t t))) + (condition-case () + (base64-encode-region (point-min) (point-max)) + (error nil))) + ((memq encoding '(7bit 8bit binary)) + ) + ((null encoding) + ) + ((eq encoding 'x-uuencode) + (condition-case () + (uudecode-encode-region (point-min) (point-max)) + (error nil))) + ((functionp encoding) + (condition-case () + (funcall encoding (point-min) (point-max)) + (error nil))) + (t + (message "Unknown encoding %s; defaulting to 8bit" encoding)))) + + (defun mm-encode-buffer (type) + "Encode the buffer which contains data of TYPE. + The encoding used is returned." + (let* ((mime-type (if (stringp type) type (car type))) + (encoding + (or (and (listp type) + (cadr (assq 'encoding type))) + (mm-content-transfer-encoding mime-type)))) + (mm-encode-content-transfer-encoding encoding mime-type) + encoding)) + + (defun mm-insert-headers (type encoding &optional file) + "Insert headers for TYPE." + (insert "Content-Type: " (car type)) + (when file + (insert ";\n\tname=\"" (file-name-nondirectory file) "\"")) + (insert "\n") + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + (insert "Content-Disposition: inline") + (when file + (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\"")) + (insert "\n") + (insert "\n")) + + (defun mm-content-transfer-encoding (type) + "Return a CTE suitable for TYPE." + (let ((rules mm-content-transfer-encoding-defaults)) + (catch 'found + (while rules + (when (string-match (caar rules) type) + (throw 'found (cadar rules))) + (pop rules))))) (provide 'mm-encode) *** pub/pgnus/lisp/nndraft.el Sun Oct 11 02:32:06 1998 --- pgnus/lisp/nndraft.el Sat Nov 14 05:47:26 1998 *************** *** 153,164 **** (with-temp-buffer (insert-buffer buf) (setq article (nndraft-request-accept-article ! group (nnoo-current-server 'nndraft) t 'noinsert)) ! (setq file (nndraft-article-filename article))) ! (setq buffer-file-name (expand-file-name file)) ! (setq buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) article)) (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) --- 153,173 ---- (with-temp-buffer (insert-buffer buf) (setq article (nndraft-request-accept-article ! group (nnoo-current-server 'nndraft) t 'noinsert) ! file (nndraft-article-filename article))) ! (setq buffer-file-name (expand-file-name file) ! buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) article)) + + (defun nndraft-save-mime-part (file part) + "Save MIME PART belonging to the FILE." + (write-region (point-min) (point-max) + (format "%s.%d" file part))) + + (defun nndraft-get-mime-part (file part) + "Save MIME PART belonging to the FILE." + (insert-file-contents (format "%s.%d" file part))) (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) *** pub/pgnus/lisp/nnoo.el Sat Aug 29 19:54:02 1998 --- pgnus/lisp/nnoo.el Sat Nov 14 05:47:27 1998 *************** *** 105,115 **** (cdr (assq pbackend (nnoo-parents backend)))) (prog1 (apply function args) ! ;; Copy the changed variables back into the child. ! (let ((vars (cdr (assq pbackend (nnoo-parents backend))))) ! (while vars ! (set (cadar vars) (symbol-value (caar vars))) ! (setq vars (cdr vars))))))) (defun nnoo-execute (backend function &rest args) "Execute FUNCTION on behalf of BACKEND." --- 105,115 ---- (cdr (assq pbackend (nnoo-parents backend)))) (prog1 (apply function args) ! ;; Copy the changed variables back into the child. ! (let ((vars (cdr (assq pbackend (nnoo-parents backend))))) ! (while vars ! (set (cadar vars) (symbol-value (caar vars))) ! (setq vars (cdr vars))))))) (defun nnoo-execute (backend function &rest args) "Execute FUNCTION on behalf of BACKEND." *** pub/pgnus/lisp/ChangeLog Sat Nov 14 01:50:22 1998 --- pgnus/lisp/ChangeLog Sat Nov 14 05:47:24 1998 *************** *** 1,3 **** --- 1,29 ---- + Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.44 is released. + + 1998-11-14 03:59:14 Lars Magne Ingebrigtsen + + * message.el (message-format-mime): New function. + + * nndraft.el (nndraft-save-mime-part): New function. + (nndraft-get-mime-part): New function. + + * mm-encode.el (mm-default-file-encoding): New function. + (mm-content-transfer-encoding): New function. + (mm-encode-buffer): New function. + + * message.el: New command. + (message-mime-part): New variable. + (message-insert-mime-part): New command. + + * mm-encode.el (mm-encode-content-transfer-encoding): New + function. + + * mm-util.el (mm-content-transfer-encoding-defaults): New + variable. + (mm-mime-file-types): Taken from TM. + Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.43 is released. *** pub/pgnus/texi/gnus.texi Sat Nov 14 01:50:28 1998 --- pgnus/texi/gnus.texi Sat Nov 14 05:47:27 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.43 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.44 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Pterodactyl Gnus 0.43 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.44 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.43. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.44. @end ifinfo *** pub/pgnus/texi/message.texi Sat Nov 14 01:50:28 1998 --- pgnus/texi/message.texi Sat Nov 14 05:47:27 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.43 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.44 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Pterodactyl Message 0.43 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.44 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,89 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.43. Message is distributed with the Gnus distribution bearing the same version number as this manual. --- 83,89 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.44. Message is distributed with the Gnus distribution bearing the same version number as this manual.