re-selecting referenced articles.
* message.el (message-cancel-news): Allow editing.
(message-cancel-message): Add newline.
+2000-04-20 21:17:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-request-article-this-buffer): Allow
+ re-selecting referenced articles.
+
+ * message.el (message-cancel-news): Allow editing.
+ (message-cancel-message): Add newline.
+
+2000-04-20 21:03:54 William M. Perry <wmperry@aventail.com>
+
+ * mm-view.el (mm-inline-image-emacs): New function.
+
+2000-04-20 20:44:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mail-source.el (mail-source-delete-incoming): Change default in
+ cvs.
+
+2000-04-20 20:43:34 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
+
+ * gnus-art.el (gnus-mime-view-part-as-type-internal): New
+ function.
+
2000-04-20 14:45:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnml.el (nnml-request-expire-articles): Use it.
(let ((data (get-text-property (point) 'gnus-data)))
(mm-interactively-view-part data)))
-(defun gnus-mime-view-part-as-type ()
+(defun gnus-mime-view-part-as-type-internal ()
+ (gnus-article-check-buffer)
+ (let* ((name (mail-content-type-get
+ (mm-handle-type (get-text-property (point) 'gnus-data))
+ 'name))
+ (def-type (and name (mm-default-file-encoding name))))
+ (and def-type (cons def-type 0))))
+
+(defun gnus-mime-view-part-as-type (mime-type)
"Choose a MIME media type, and view the part as such."
(interactive
- (list (completing-read "View as MIME type: "
- (mapcar 'list (mailcap-mime-types)))))
+ (list (completing-read
+ "View as MIME type: "
+ (mapcar (lambda (i) (list i i)) (mailcap-mime-types))
+ nil nil
+ (gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
- (gnus-mm-display-part handle)))
+ (gnus-mm-display-part
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ (mm-handle-cache handle)
+ (mm-handle-id handle)))))
(defun gnus-mime-copy-part (&optional handle)
"Put the the MIME part under point into a new buffer."
(gnus-cache-request-article article group))
'article)
;; Get the article and put into the article buffer.
- ((or (stringp article) (numberp article))
+ ((or (stringp article)
+ (numberp article))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
(buffer-read-only nil))
(setq methods
(if (listp methods)
- (delq 'current methods)
+ methods
(list methods)))
- (if (and (null gnus-override-method) methods)
- (setq gnus-override-method (pop methods)))
+ (when (and (null gnus-override-method)
+ methods)
+ (setq gnus-override-method (pop methods)))
(while (not result)
+ (when (eq gnus-override-method 'current)
+ (setq gnus-override-method gnus-current-select-method))
(erase-buffer)
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
:group 'mail-source
:type 'integer)
-(defcustom mail-source-delete-incoming t
+(defcustom mail-source-delete-incoming nil
"*If non-nil, delete incoming files after handling."
:group 'mail-source
:type 'boolean)
:group 'message-insertion
:type 'regexp)
-(defcustom message-cancel-message "I am canceling my own article."
+(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
:group 'message-interface
:type 'string)
;;;###autoload
-(defun message-cancel-news ()
- "Cancel an article you posted."
- (interactive)
+(defun message-cancel-news (&optional arg)
+ "Cancel an article you posted.
+If ARG, allow editing of the cancellation message."
+ (interactive "P")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
(when (yes-or-no-p "Do you really want to cancel this article? ")
(message-make-from))))))
(error "This article is not yours"))
;; Make control message.
- (setq buf (set-buffer (get-buffer-create " *message cancel*")))
+ (if arg
+ (message-news)
+ (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " (message-make-from) "\n"
mail-header-separator "\n"
message-cancel-message)
(run-hooks 'message-cancel-hook)
- (message "Canceling your article...")
- (if (let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function))
- (message "Canceling your article...done"))
- (kill-buffer buf)))))
+ (unless arg
+ (message "Canceling your article...")
+ (if (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
+ (message "Canceling your article...done"))
+ (kill-buffer buf))))))
;;;###autoload
(defun message-supersede ()
(require 'mailcap)
(require 'mm-bodies)
+(defvar mm-xemacs-p (string-match "XEmacs" (emacs-version)))
+
(defgroup mime-display ()
"Display of MIME in mail and news articles."
:link '(custom-manual "(emacs-mime)Customization")
"Return the handle(s) referred to by ID."
(cdr (assoc id mm-content-id-alist)))
-(defun mm-get-image (handle)
+(defun mm-get-image-emacs (handle)
+ "Return an image instance based on HANDLE."
+ (let ((type (mm-handle-media-subtype handle))
+ spec)
+ ;; Allow some common translations.
+ (setq type
+ (cond
+ ((equal type "x-pixmap")
+ "xpm")
+ ((equal type "x-xbitmap")
+ "xbm")
+ (t type)))
+ (or (mm-handle-cache handle)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (prog1
+ (setq spec
+ (ignore-errors
+ (cond
+ ((equal type "xbm")
+ ;; xbm images require special handling, since
+ ;; the only way to create glyphs from these
+ ;; (without a ton of work) is to write them
+ ;; out to a file, and then create a file
+ ;; specifier.
+ (error "Don't know what to do for XBMs right now."))
+ (t
+ (list 'image :type (intern type) :data (buffer-string))))))
+ (mm-handle-set-cache handle spec))))))
+
+(defun mm-get-image-xemacs (handle)
"Return an image instance based on HANDLE."
(let ((type (mm-handle-media-subtype handle))
spec)
(vector (intern type) :data (buffer-string)))))))
(mm-handle-set-cache handle spec))))))
+(defun mm-get-image (handle)
+ (if mm-xemacs-p
+ (mm-get-image-xemacs handle)
+ (mm-get-image-emacs handle)))
+
(defun mm-image-fit-p (handle)
"Say whether the image in HANDLE will fit the current window."
(let ((image (mm-get-image handle)))
- (or mm-inline-large-images
- (and (< (glyph-width image) (window-pixel-width))
- (< (glyph-height image) (window-pixel-height))))))
+ (if (fboundp 'glyph-width)
+ ;; XEmacs' glyphs can actually tell us about their width, so
+ ;; lets be nice and smart about them.
+ (or mm-inline-large-images
+ (and (< (glyph-width image) (window-pixel-width))
+ (< (glyph-height image) (window-pixel-height))))
+ ;; Let's just inline everything under Emacs 21, since the image
+ ;; specification there doesn't actually get the width/height
+ ;; until you render the image.
+ t)))
(defun mm-valid-image-format-p (format)
"Say whether FORMAT can be displayed natively by Emacs."
- (and (fboundp 'valid-image-instantiator-format-p)
- (valid-image-instantiator-format-p format)))
+ (cond
+ ;; Handle XEmacs
+ ((fboundp 'valid-image-instantiator-format-p)
+ (valid-image-instantiator-format-p format))
+ ;; Handle Emacs 21
+ ((fboundp 'image-type-available-p)
+ (image-type-available-p format))
+ ;; Nobody else can do images yet.
+ (t
+ nil)))
(defun mm-valid-and-fit-image-p (format handle)
"Say whether FORMAT can be displayed natively and HANDLE fits the window."
;;;
;;; Functions for displaying various formats inline
;;;
+(defun mm-inline-image-emacs (handle)
+ (let ((b (point))
+ (overlay nil)
+ (string (copy-sequence "[MM-INLINED-IMAGE]"))
+ buffer-read-only)
+ (insert "\n")
+ (buffer-name)
+ (setq overlay (make-overlay (point) (point) (current-buffer)))
+ (put-text-property 0 (length string) 'display (mm-get-image handle) string)
+ (overlay-put overlay 'before-string string)
-(defun mm-inline-image (handle)
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (delete-overlay ,overlay)
+ (delete-region ,(set-marker (make-marker) b)
+ ,(set-marker (make-marker) (point))))))))
+
+(defun mm-inline-image-xemacs (handle)
(let ((b (point))
(annot (make-annotation (mm-get-image handle) nil 'text))
buffer-read-only)
(set-extent-property annot 'mm t)
(set-extent-property annot 'duplicable t)))
+(defun mm-inline-image (handle)
+ (if mm-xemacs-p
+ (mm-inline-image-xemacs handle)
+ (mm-inline-image-emacs handle)))
+
(defvar mm-w3-setup nil)
(defun mm-setup-w3 ()
(unless mm-w3-setup
projects / gnus / commitdiff