+Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.44 is released.
+
+1998-11-14 03:59:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.43 is released.
(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. :-)
+ t ; All non-existent numbers are the last article. :-)
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
kill-buffer no-display
select-articles)
(setq show-all nil
- select-articles nil)))))
+ select-articles nil)))))
(eq gnus-auto-select-next 'quietly))
(set-buffer gnus-group-buffer)
;; The entry function called above goes to the next
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- type list newmarked symbol delta-marks)
+ 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))
(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)
+ 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.
(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-show-thread)
+ (gnus-summary-first-subject)
+ (gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
(defun gnus-summary-best-unread-article ()
(push (cons prev (cdr active)) read))
(setq read (if (> (length read) 1) (nreverse read) read))
(if compute
- read
+ read
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-undo-register
(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)
+ (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))))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.43"
+(defconst gnus-version-number "0.44"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(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)
(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
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)
+ (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)
(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)
+ (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)
(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
(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))
+ "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:"
+ t))
(goto-char (point-max))
(widen)
(narrow-to-region (point) (point-max))
(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)
(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")
(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)
;;; mm-encode.el ends here
(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))
+ 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)
(let* ((nnmh-allow-delete-final t)
(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)))))))
+ ;; 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."
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.43 Manual
+@settitle Pterodactyl Gnus 0.44 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.43 Manual
+@title Pterodactyl Gnus 0.44 Manual
@author by Lars Magne Ingebrigtsen
@page
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.
+This manual corresponds to Pterodactyl Gnus 0.44.
@end ifinfo
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.43 Manual
+@settitle Pterodactyl Message 0.44 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.43 Manual
+@title Pterodactyl Message 0.44 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.43. Message is
+This manual corresponds to Pterodactyl Message 0.44. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / gnus / commitdiff