aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorGlenn Morris2011-01-15 12:38:27 -0800
committerGlenn Morris2011-01-15 12:38:27 -0800
commitd52969e8afaa19ed1acc01f4ff0bb651bf7869a7 (patch)
treea51a042adc70e362c982f1aec9e9e3d07097a85c /lisp
parent362b9d483c714a8fd87966ddbd8686850f870e34 (diff)
parent9f19b8ddfe3a46d8a5ae86b6c8d2394562d02843 (diff)
downloademacs-d52969e8afaa19ed1acc01f4ff0bb651bf7869a7.tar.gz
emacs-d52969e8afaa19ed1acc01f4ff0bb651bf7869a7.zip
Merge from emacs-23 branch, up to 2010-05-20T21:33:58Z!juri@jurta.org.
Note: emacs-23 2010-05-20T01:32:08Z!lekktu@gmail.com is rendered unnecessary by pre-existing 2010-05-20 trunk change.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog62
-rw-r--r--lisp/files.el7
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/message.el8
-rw-r--r--lisp/mail/rmailmm.el269
-rw-r--r--lisp/subr.el40
6 files changed, 260 insertions, 131 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8c0bfe3aaeb..1c772934c20 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,65 @@
12011-01-15 Mark Diekhans <markd@soe.ucsc.edu>
2
3 * files.el (backup-buffer): Make last-resort backup file in
4 .emacs.d (Bug#6953).
5
6 * subr.el (locate-user-emacs-file): If .emacs.d does not exist,
7 make it with permission 700.
8
92011-01-15 Kenichi Handa <handa@m17n.org>
10
11 * mail/rmailmm.el (rmail-mime-insert-header): Set
12 rmail-mime-coding-system to a cons whose car is the last coding
13 system used to decode the header.
14 (rmail-mime-find-header-encoding): New function.
15 (rmail-mime-insert-decoded-text): Override
16 rmail-mime-coding-system if it is a cons.
17 (rmail-show-mime): If only a header part was decoded, find the
18 coding system while ignoring mm-charset-override-alist.
19
202011-01-15 Chong Yidong <cyd@stupidchicken.com>
21
22 * subr.el (event-start, event-end): Doc fix (Bug#7826).
23
242011-01-15 Kenichi Handa <handa@m17n.org>
25
26 * mail/rmailmm.el (rmail-mime-next-item)
27 (rmail-mime-previous-item): Delete them.
28 (rmail-mime-shown-mode): Recursively call for children.
29 (rmail-mime-hidden-mode): Delete the 2nd arg TOP. Callers
30 changed.
31 (rmail-mime-raw-mode): Recursively call for children.
32 (rmail-mode-map): Change mapping of tab and backtab to
33 forward-button and backward-button respectively.
34 (rmail-mime-insert-tagline): Always insert "Hide" or "Show"
35 button.
36 (rmail-mime-update-tagline): New function.
37 (rmail-mime-insert-text): Call rmail-mime-update-tagline if the
38 body display is changed.
39 (rmail-mime-toggle-button): Renamed from rmail-mime-image.
40 (rmail-mime-image): Delete this button type.
41 (rmail-mime-toggle): New button type.
42 (rmail-mime-insert-bulk): Call rmail-mime-update-tagline if the
43 body display is changed. Change the save button label to "Save".
44 Don't process show/hide button here.
45 (rmail-mime-insert-multipart): Call rmail-mime-update-tagline if
46 the body display is changed. Unconditionally call
47 rmail-mime-insert for children.
48 (rmail-mime-handle): Update `display' vector of the just inserted
49 entity.
50 (rmail-mime-process): If mail-header-parse-content-type returns
51 nil, use "text/plain" as the fallback type.
52 (rmail-mime-insert): For raw-mode, recursively call
53 rmail-mim-insert for children.
54 (rmail-mime): Handle the case that the current buffer is not rmail
55 buffer (e.g. in summary buffer).
56
572011-01-15 Kenichi Handa <handa@m17n.org>
58
59 * mail/rmailmm.el (rmail-mime-next-item)
60 (rmail-mime-previous-item): Skip the body of a non-multipart
61 entity if a tagline is shown.
62
12011-01-15 Stefan Monnier <monnier@iro.umontreal.ca> 632011-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
2 64
3 * tmm.el (tmm-get-keymap): Skip bindings without labels (bug#7721). 65 * tmm.el (tmm-get-keymap): Skip bindings without labels (bug#7721).
diff --git a/lisp/files.el b/lisp/files.el
index 2223c1ae6b8..312ecb3852f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3778,10 +3778,9 @@ BACKUPNAME is the backup file name, which is the old file renamed."
3778 (rename-file real-file-name backupname t) 3778 (rename-file real-file-name backupname t)
3779 (setq setmodes (list modes context backupname))) 3779 (setq setmodes (list modes context backupname)))
3780 (file-error 3780 (file-error
3781 ;; If trouble writing the backup, write it in ~. 3781 ;; If trouble writing the backup, write it in
3782 (setq backupname (expand-file-name 3782 ;; .emacs.d/%backup%.
3783 (convert-standard-filename 3783 (setq backupname (locate-user-emacs-file "%backup%~"))
3784 "~/%backup%~")))
3785 (message "Cannot write backup file; backing up in %s" 3784 (message "Cannot write backup file; backing up in %s"
3786 backupname) 3785 backupname)
3787 (sleep-for 1) 3786 (sleep-for 1)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 326d6dbf244..ebae821fe3a 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
12011-01-15 Glenn Morris <rgm@gnu.org>
2
3 * message.el (message-mail): A compose-mail function should
4 accept headers as strings.
5
12011-01-13 Chong Yidong <cyd@stupidchicken.com> 62011-01-13 Chong Yidong <cyd@stupidchicken.com>
2 7
3 * message.el (message-tool-bar-gnome): Tweak tool-bar items. Add 8 * message.el (message-tool-bar-gnome): Tweak tool-bar items. Add
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 6ebcdc28766..64569cfb994 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -6512,7 +6512,13 @@ is a function used to switch to and display the mail buffer."
6512 (message-setup 6512 (message-setup
6513 (nconc 6513 (nconc
6514 `((To . ,(or to "")) (Subject . ,(or subject ""))) 6514 `((To . ,(or to "")) (Subject . ,(or subject "")))
6515 (when other-headers other-headers)) 6515 ;; C-h f compose-mail says that headers should be specified as
6516 ;; (string . value); however all the rest of message expects
6517 ;; headers to be symbols, not strings (eg message-header-format-alist).
6518 ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
6519 ;; We need to convert any string input, eg from rmail-start-mail.
6520 (dolist (h other-headers other-headers)
6521 (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
6516 yank-action send-actions continue switch-function 6522 yank-action send-actions continue switch-function
6517 return-action) 6523 return-action)
6518 ;; FIXME: Should return nil if failure. 6524 ;; FIXME: Should return nil if failure.
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 2221568e55f..2b42f811317 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -274,11 +274,11 @@ It is called with one argument ENTITY."
274 "Return a vector describing the displayed region of a MIME-entity at POS. 274 "Return a vector describing the displayed region of a MIME-entity at POS.
275Optional 2nd argument ENTITY is the MIME-entity at POS. 275Optional 2nd argument ENTITY is the MIME-entity at POS.
276The value is a vector [ INDEX HEADER TAGLINE BODY END], where 276The value is a vector [ INDEX HEADER TAGLINE BODY END], where
277 INDEX: index into the returned vector indicating where POS is (1..3).
277 HEADER: the position of the beginning of a header 278 HEADER: the position of the beginning of a header
278 TAGLINE: the position of the beginning of a tagline 279 TAGLINE: the position of the beginning of a tagline
279 BODY: the position of the beginning of a body 280 BODY: the position of the beginning of a body
280 END: the position of the end of the entity. 281 END: the position of the end of the entity."
281 INDEX: index into the returned vector indicating where POS is."
282 (save-excursion 282 (save-excursion
283 (or entity 283 (or entity
284 (setq entity (get-text-property pos 'rmail-mime-entity))) 284 (setq entity (get-text-property pos 'rmail-mime-entity)))
@@ -319,74 +319,32 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where
319 (setq end body-beg)) 319 (setq end body-beg))
320 (vector index beg tagline-beg body-beg end))))) 320 (vector index beg tagline-beg body-beg end)))))
321 321
322(defun rmail-mime-next-item ()
323 "Move point to the next displayed item of the current MIME entity.
324A MIME entity has three items; header, tagline, and body.
325If we are in the last item of the entity, move point to the first
326item of the next entity. If we reach the end of buffer, move
327point to the first item of the first entity (i.e. the beginning
328of buffer)."
329 (interactive)
330 (if (rmail-mime-message-p)
331 (let* ((segment (rmail-mime-entity-segment (point)))
332 (next-pos (aref segment (1+ (aref segment 0))))
333 (button (next-button (point))))
334 (goto-char (if (and button (< (button-start button) next-pos))
335 (button-start button)
336 next-pos))
337 (if (eobp)
338 (goto-char (point-min))))))
339
340(defun rmail-mime-previous-item ()
341 "Move point to the previous displayed item of the current MIME message.
342A MIME entity has three items; header, tagline, and body.
343If we are at the beginning of the first item of the entity, move
344point to the last item of the previous entity. If we reach the
345beginning of buffer, move point to the last item of the last
346entity."
347 (interactive)
348 (when (rmail-mime-message-p)
349 (if (bobp)
350 (goto-char (point-max)))
351 (let* ((segment (rmail-mime-entity-segment (1- (point))))
352 (prev-pos (aref segment (aref segment 0)))
353 (button (previous-button (point))))
354 (goto-char (if (and button (> (button-start button) prev-pos))
355 (button-start button)
356 prev-pos)))))
357
358(defun rmail-mime-shown-mode (entity) 322(defun rmail-mime-shown-mode (entity)
359 "Make MIME-entity ENTITY displayed by the default way." 323 "Make MIME-entity ENTITY displayed by the default way."
360 (let ((new (aref (rmail-mime-entity-display entity) 1))) 324 (let ((new (aref (rmail-mime-entity-display entity) 1)))
361 (aset new 0 (aref (rmail-mime-entity-header entity) 2)) 325 (aset new 0 (aref (rmail-mime-entity-header entity) 2))
362 (aset new 1 (aref (rmail-mime-entity-tagline entity) 2)) 326 (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
363 (aset new 2 (aref (rmail-mime-entity-body entity) 2)))) 327 (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
364
365(defun rmail-mime-hidden-mode (entity top)
366 "Make MIME-entity ENTITY displayed in the hidden mode.
367If TOP is non-nil, display ENTITY only by the tagline.
368Otherwise, don't display ENTITY."
369 (if top
370 (let ((new (aref (rmail-mime-entity-display entity) 1)))
371 (aset new 0 nil)
372 (aset new 1 top)
373 (aset new 2 nil)
374 (aset (rmail-mime-entity-body entity) 2 nil))
375 (let ((current (aref (rmail-mime-entity-display entity) 0)))
376 (aset current 0 nil)
377 (aset current 1 nil)
378 (aset current 2 nil)))
379 (dolist (child (rmail-mime-entity-children entity)) 328 (dolist (child (rmail-mime-entity-children entity))
380 (rmail-mime-hidden-mode child nil))) 329 (rmail-mime-shown-mode child)))
330
331(defun rmail-mime-hidden-mode (entity)
332 "Make MIME-entity ENTITY displayed in the hidden mode."
333 (let ((new (aref (rmail-mime-entity-display entity) 1)))
334 (aset new 0 nil)
335 (aset new 1 t)
336 (aset new 2 nil))
337 (dolist (child (rmail-mime-entity-children entity))
338 (rmail-mime-hidden-mode child)))
381 339
382(defun rmail-mime-raw-mode (entity) 340(defun rmail-mime-raw-mode (entity)
383 "Make MIME-entity ENTITY displayed in the raw mode." 341 "Make MIME-entity ENTITY displayed in the raw mode."
384 (let ((new (aref (rmail-mime-entity-display entity) 1))) 342 (let ((new (aref (rmail-mime-entity-display entity) 1)))
385 (aset new 0 'raw) 343 (aset new 0 'raw)
386 (aset new 1 nil) 344 (aset new 1 nil)
387 (aset new 2 'raw) 345 (aset new 2 'raw))
388 (dolist (child (rmail-mime-entity-children entity)) 346 (dolist (child (rmail-mime-entity-children entity))
389 (rmail-mime-hidden-mode child nil)))) 347 (rmail-mime-raw-mode child)))
390 348
391(defun rmail-mime-toggle-raw (entity) 349(defun rmail-mime-toggle-raw (entity)
392 "Toggle on and off the raw display mode of MIME-entity ENTITY." 350 "Toggle on and off the raw display mode of MIME-entity ENTITY."
@@ -407,7 +365,7 @@ Otherwise, don't display ENTITY."
407 (restore-buffer-modified-p modified))))) 365 (restore-buffer-modified-p modified)))))
408 366
409(defun rmail-mime-toggle-hidden () 367(defun rmail-mime-toggle-hidden ()
410 "Toggle on and off the hidden display mode of MIME-entity ENTITY." 368 "Hide or show the body of MIME-entity at point."
411 (interactive) 369 (interactive)
412 (when (rmail-mime-message-p) 370 (when (rmail-mime-message-p)
413 (let* ((rmail-mime-mbox-buffer rmail-view-buffer) 371 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
@@ -420,18 +378,19 @@ Otherwise, don't display ENTITY."
420 ;; Enter the hidden mode. 378 ;; Enter the hidden mode.
421 (progn 379 (progn
422 ;; If point is in the body part, move it to the tagline 380 ;; If point is in the body part, move it to the tagline
423 ;; (or the header if headline is not displayed). 381 ;; (or the header if tagline is not displayed).
424 (if (= (aref segment 0) 3) 382 (if (= (aref segment 0) 3)
425 (goto-char (aref segment 2))) 383 (goto-char (aref segment 2)))
426 (rmail-mime-hidden-mode entity t) 384 (rmail-mime-hidden-mode entity)
427 ;; If the current entity is the topmost one, display the 385 ;; If the current entity is the topmost one, display the
428 ;; header. 386 ;; header.
429 (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) 387 (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
430 (let ((new (aref (rmail-mime-entity-display entity) 1))) 388 (let ((new (aref (rmail-mime-entity-display entity) 1)))
431 (aset new 0 t)))) 389 (aset new 0 t))))
432 ;; Enter the shown mode. 390 ;; Enter the shown mode.
433 (aset (rmail-mime-entity-body entity) 2 t) 391 (rmail-mime-shown-mode entity)
434 (rmail-mime-shown-mode entity)) 392 ;; Force this body shown.
393 (aset (aref (rmail-mime-entity-display entity) 1) 2 t))
435 (let ((inhibit-read-only t) 394 (let ((inhibit-read-only t)
436 (modified (buffer-modified-p)) 395 (modified (buffer-modified-p))
437 (rmail-mime-mbox-buffer rmail-view-buffer) 396 (rmail-mime-mbox-buffer rmail-view-buffer)
@@ -441,8 +400,8 @@ Otherwise, don't display ENTITY."
441 (rmail-mime-insert entity) 400 (rmail-mime-insert entity)
442 (restore-buffer-modified-p modified)))))) 401 (restore-buffer-modified-p modified))))))
443 402
444(define-key rmail-mode-map "\t" 'rmail-mime-next-item) 403(define-key rmail-mode-map "\t" 'forward-button)
445(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item) 404(define-key rmail-mode-map [backtab] 'backward-button)
446(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden) 405(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
447 406
448;;; Handlers 407;;; Handlers
@@ -454,7 +413,11 @@ to the tag line."
454 (insert "[") 413 (insert "[")
455 (let ((tag (aref (rmail-mime-entity-tagline entity) 0))) 414 (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
456 (if (> (length tag) 0) (insert (substring tag 1) ":"))) 415 (if (> (length tag) 0) (insert (substring tag 1) ":")))
457 (insert (car (rmail-mime-entity-type entity))) 416 (insert (car (rmail-mime-entity-type entity)) " ")
417 (insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
418 (if (aref new 2) "Hide" "Show"))
419 :type 'rmail-mime-toggle
420 'help-echo "mouse-2, RET: Toggle show/hide")
458 (dolist (item item-list) 421 (dolist (item item-list)
459 (when item 422 (when item
460 (if (stringp item) 423 (if (stringp item)
@@ -462,6 +425,26 @@ to the tag line."
462 (apply 'insert-button item)))) 425 (apply 'insert-button item))))
463 (insert "]\n")) 426 (insert "]\n"))
464 427
428(defun rmail-mime-update-tagline (entity)
429 "Update the current tag line for MIME-entity ENTITY."
430 (let ((inhibit-read-only t)
431 (modified (buffer-modified-p))
432 ;; If we are going to show the body, the new button label is
433 ;; "Hide". Otherwise, it's "Show".
434 (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
435 "Show"))
436 (button (next-button (point))))
437 ;; Go to the second character of the button "Show" or "Hide".
438 (goto-char (1+ (button-start button)))
439 (setq button (button-at (point)))
440 (save-excursion
441 (insert label)
442 (delete-region (point) (button-end button)))
443 (delete-region (button-start button) (point))
444 (put-text-property (point) (button-end button) 'rmail-mime-entity entity)
445 (restore-buffer-modified-p modified)
446 (forward-line 1)))
447
465(defun rmail-mime-insert-header (header) 448(defun rmail-mime-insert-header (header)
466 "Decode and insert a MIME-entity header HEADER in the current buffer. 449 "Decode and insert a MIME-entity header HEADER in the current buffer.
467HEADER is a vector [BEG END DEFAULT-STATUS]. 450HEADER is a vector [BEG END DEFAULT-STATUS].
@@ -478,12 +461,27 @@ See `rmail-mime-entity' for the detail."
478 (rmail-copy-headers (point) (aref header 1))))) 461 (rmail-copy-headers (point) (aref header 1)))))
479 (rfc2047-decode-region pos (point)) 462 (rfc2047-decode-region pos (point))
480 (if (and last-coding-system-used (not rmail-mime-coding-system)) 463 (if (and last-coding-system-used (not rmail-mime-coding-system))
481 (setq rmail-mime-coding-system last-coding-system-used)) 464 (setq rmail-mime-coding-system (cons last-coding-system-used nil)))
482 (goto-char (point-min)) 465 (goto-char (point-min))
483 (rmail-highlight-headers) 466 (rmail-highlight-headers)
484 (goto-char (point-max)) 467 (goto-char (point-max))
485 (insert "\n")))) 468 (insert "\n"))))
486 469
470(defun rmail-mime-find-header-encoding (header)
471 "Retun the last coding system used to decode HEADER.
472HEADER is a header component of a MIME-entity object (see
473`rmail-mime-entity')."
474 (with-temp-buffer
475 (let ((last-coding-system-used nil))
476 (with-current-buffer rmail-mime-mbox-buffer
477 (let ((rmail-buffer rmail-mime-mbox-buffer)
478 (rmail-view-buffer rmail-mime-view-buffer))
479 (save-excursion
480 (goto-char (aref header 0))
481 (rmail-copy-headers (point) (aref header 1)))))
482 (rfc2047-decode-region (point-min) (point-max))
483 last-coding-system-used)))
484
487(defun rmail-mime-text-handler (content-type 485(defun rmail-mime-text-handler (content-type
488 content-disposition 486 content-disposition
489 content-transfer-encoding) 487 content-transfer-encoding)
@@ -516,7 +514,7 @@ See `rmail-mime-entity' for the detail."
516 ((string= transfer-encoding "quoted-printable") 514 ((string= transfer-encoding "quoted-printable")
517 (quoted-printable-decode-region pos (point)))))) 515 (quoted-printable-decode-region pos (point))))))
518 (decode-coding-region pos (point) coding-system) 516 (decode-coding-region pos (point) coding-system)
519 (or rmail-mime-coding-system 517 (if (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
520 (setq rmail-mime-coding-system coding-system)) 518 (setq rmail-mime-coding-system coding-system))
521 (or (bolp) (insert "\n")))) 519 (or (bolp) (insert "\n"))))
522 520
@@ -544,7 +542,10 @@ See `rmail-mime-entity' for the detail."
544 (rmail-mime-insert-header header))) 542 (rmail-mime-insert-header header)))
545 ;; tagline 543 ;; tagline
546 (if (eq (aref current 1) (aref new 1)) 544 (if (eq (aref current 1) (aref new 1))
547 (forward-char (- (aref segment 3) (aref segment 2))) 545 (if (or (not (aref current 1))
546 (eq (aref current 2) (aref new 2)))
547 (forward-char (- (aref segment 3) (aref segment 2)))
548 (rmail-mime-update-tagline entity))
548 (if (aref current 1) 549 (if (aref current 1)
549 (delete-char (- (aref segment 3) (aref segment 2)))) 550 (delete-char (- (aref segment 3) (aref segment 2))))
550 (if (aref new 1) 551 (if (aref new 1)
@@ -599,13 +600,13 @@ MIME-Version: 1.0
599 (insert-image (create-image data (cdr bulk-data) t)) 600 (insert-image (create-image data (cdr bulk-data) t))
600 (insert "\n"))) 601 (insert "\n")))
601 602
602(defun rmail-mime-image (button) 603(defun rmail-mime-toggle-button (button)
603 "Display the image associated with BUTTON." 604 "Hide or show the body of the MIME-entity associated with BUTTON."
604 (save-excursion 605 (save-excursion
605 (goto-char (button-end button)) 606 (goto-char (button-start button))
606 (rmail-mime-toggle-hidden))) 607 (rmail-mime-toggle-hidden)))
607 608
608(define-button-type 'rmail-mime-image 'action 'rmail-mime-image) 609(define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)
609 610
610 611
611(defun rmail-mime-bulk-handler (content-type 612(defun rmail-mime-bulk-handler (content-type
@@ -628,7 +629,7 @@ directly."
628 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity))))) 629 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
629 (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) 630 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
630 (body (rmail-mime-entity-body entity)) 631 (body (rmail-mime-entity-body entity))
631 size type to-show) 632 type to-show)
632 (cond (size 633 (cond (size
633 (setq size (string-to-number size))) 634 (setq size (string-to-number size)))
634 ((stringp (aref body 0)) 635 ((stringp (aref body 0))
@@ -662,7 +663,6 @@ directly."
662 663
663(defun rmail-mime-insert-bulk (entity) 664(defun rmail-mime-insert-bulk (entity)
664 "Presentation handler for an attachment MIME entity." 665 "Presentation handler for an attachment MIME entity."
665 ;; Find the default directory for this media type.
666 (let* ((content-type (rmail-mime-entity-type entity)) 666 (let* ((content-type (rmail-mime-entity-type entity))
667 (content-disposition (rmail-mime-entity-disposition entity)) 667 (content-disposition (rmail-mime-entity-disposition entity))
668 (current (aref (rmail-mime-entity-display entity) 0)) 668 (current (aref (rmail-mime-entity-display entity) 0))
@@ -671,6 +671,7 @@ directly."
671 (tagline (rmail-mime-entity-tagline entity)) 671 (tagline (rmail-mime-entity-tagline entity))
672 (bulk-data (aref tagline 1)) 672 (bulk-data (aref tagline 1))
673 (body (rmail-mime-entity-body entity)) 673 (body (rmail-mime-entity-body entity))
674 ;; Find the default directory for this media type.
674 (directory (catch 'directory 675 (directory (catch 'directory
675 (dolist (entry rmail-mime-attachment-dirs-alist) 676 (dolist (entry rmail-mime-attachment-dirs-alist)
676 (when (string-match (car entry) (car content-type)) 677 (when (string-match (car entry) (car content-type))
@@ -711,13 +712,16 @@ directly."
711 712
712 ;; tagline 713 ;; tagline
713 (if (eq (aref current 1) (aref new 1)) 714 (if (eq (aref current 1) (aref new 1))
714 (forward-char (- (aref segment 3) (aref segment 2))) 715 (if (or (not (aref current 1))
716 (eq (aref current 2) (aref new 2)))
717 (forward-char (- (aref segment 3) (aref segment 2)))
718 (rmail-mime-update-tagline entity))
715 (if (aref current 1) 719 (if (aref current 1)
716 (delete-char (- (aref segment 3) (aref segment 2)))) 720 (delete-char (- (aref segment 3) (aref segment 2))))
717 (if (aref new 1) 721 (if (aref new 1)
718 (rmail-mime-insert-tagline 722 (rmail-mime-insert-tagline
719 entity 723 entity
720 " file:" 724 " Save:"
721 (list filename 725 (list filename
722 :type 'rmail-mime-save 726 :type 'rmail-mime-save
723 'help-echo "mouse-2, RET: Save attachment" 727 'help-echo "mouse-2, RET: Save attachment"
@@ -725,14 +729,17 @@ directly."
725 'directory (file-name-as-directory directory) 729 'directory (file-name-as-directory directory)
726 'data data) 730 'data data)
727 (format " (%.0f%s)" size (car units)) 731 (format " (%.0f%s)" size (car units))
728 (if (cdr bulk-data) 732 ;; We don't need this button because the "type" string of a
729 " ") 733 ;; tagline is the button to do this.
730 (if (cdr bulk-data) 734 ;; (if (cdr bulk-data)
731 (list "Toggle show/hide" 735 ;; " ")
732 :type 'rmail-mime-image 736 ;; (if (cdr bulk-data)
733 'help-echo "mouse-2, RET: Toggle show/hide" 737 ;; (list "Toggle show/hide"
734 'image-type (cdr bulk-data) 738 ;; :type 'rmail-mime-image
735 'image-data data))))) 739 ;; 'help-echo "mouse-2, RET: Toggle show/hide"
740 ;; 'image-type (cdr bulk-data)
741 ;; 'image-data data))
742 )))
736 ;; body 743 ;; body
737 (if (eq (aref current 2) (aref new 2)) 744 (if (eq (aref current 2) (aref new 2))
738 (forward-char (- (aref segment 4) (aref segment 3))) 745 (forward-char (- (aref segment 4) (aref segment 3)))
@@ -883,8 +890,9 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
883 (setq second child))))) 890 (setq second child)))))
884 (or best (not second) (setq best second)) 891 (or best (not second) (setq best second))
885 (dolist (child entities) 892 (dolist (child entities)
886 (or (eq best child) 893 (unless (eq best child)
887 (rmail-mime-hidden-mode child t))))) 894 (aset (rmail-mime-entity-body child) 2 nil)
895 (rmail-mime-hidden-mode child)))))
888 entities))) 896 entities)))
889 897
890(defun test-rmail-mime-multipart-handler () 898(defun test-rmail-mime-multipart-handler ()
@@ -936,21 +944,23 @@ This is the epilogue. It is also to be ignored."))
936 (rmail-mime-insert-header header))) 944 (rmail-mime-insert-header header)))
937 ;; tagline 945 ;; tagline
938 (if (eq (aref current 1) (aref new 1)) 946 (if (eq (aref current 1) (aref new 1))
939 (forward-char (- (aref segment 3) (aref segment 2))) 947 (if (or (not (aref current 1))
948 (eq (aref current 2) (aref new 2)))
949 (forward-char (- (aref segment 3) (aref segment 2)))
950 (rmail-mime-update-tagline entity))
940 (if (aref current 1) 951 (if (aref current 1)
941 (delete-char (- (aref segment 3) (aref segment 2)))) 952 (delete-char (- (aref segment 3) (aref segment 2))))
942 (if (aref new 1) 953 (if (aref new 1)
943 (rmail-mime-insert-tagline entity))) 954 (rmail-mime-insert-tagline entity)))
944 955
945 (put-text-property beg (point) 'rmail-mime-entity entity) 956 (put-text-property beg (point) 'rmail-mime-entity entity)
957
946 ;; body 958 ;; body
947 (if (eq (aref current 2) (aref new 2)) 959 (if (eq (aref current 2) (aref new 2))
948 (forward-char (- (aref segment 4) (aref segment 3))) 960 (forward-char (- (aref segment 4) (aref segment 3)))
949 (if (aref current 2) 961 (dolist (child (rmail-mime-entity-children entity))
950 (delete-char (- (aref segment 4) (aref segment 3)))) 962 (rmail-mime-insert child)))
951 (if (aref new 2) 963 entity))
952 (dolist (child (rmail-mime-entity-children entity))
953 (rmail-mime-insert child))))))
954 964
955;;; Main code 965;;; Main code
956 966
@@ -1011,7 +1021,16 @@ The parsed header value:
1011 ;; Everything else is an attachment. 1021 ;; Everything else is an attachment.
1012 (rmail-mime-bulk-handler content-type 1022 (rmail-mime-bulk-handler content-type
1013 content-disposition 1023 content-disposition
1014 content-transfer-encoding))) 1024 content-transfer-encoding))
1025 (save-restriction
1026 (widen)
1027 (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
1028 current new)
1029 (when entity
1030 (setq current (aref (rmail-mime-entity-display entity) 0)
1031 new (aref (rmail-mime-entity-display entity) 1))
1032 (dotimes (i 3)
1033 (aset current i (aref new i)))))))
1015 1034
1016(defun rmail-mime-show (&optional show-headers) 1035(defun rmail-mime-show (&optional show-headers)
1017 "Handle the current buffer as a MIME message. 1036 "Handle the current buffer as a MIME message.
@@ -1056,7 +1075,8 @@ modified."
1056 (setq content-transfer-encoding (downcase content-transfer-encoding))) 1075 (setq content-transfer-encoding (downcase content-transfer-encoding)))
1057 (setq content-type 1076 (setq content-type
1058 (if content-type 1077 (if content-type
1059 (mail-header-parse-content-type content-type) 1078 (or (mail-header-parse-content-type content-type)
1079 '("text/plain"))
1060 (or default-content-type '("text/plain")))) 1080 (or default-content-type '("text/plain"))))
1061 (setq content-disposition 1081 (setq content-disposition
1062 (if content-disposition 1082 (if content-disposition
@@ -1184,13 +1204,20 @@ available."
1184 (if (aref current 1) 1204 (if (aref current 1)
1185 (delete-char (- (aref segment 3) (aref segment 2)))) 1205 (delete-char (- (aref segment 3) (aref segment 2))))
1186 ;; body 1206 ;; body
1187 (if (eq (aref current 2) (aref new 2)) 1207 (let ((children (rmail-mime-entity-children entity)))
1188 (forward-char (- (aref segment 4) (aref segment 3))) 1208 (if children
1189 (if (aref current 2) 1209 (progn
1190 (delete-char (- (aref segment 4) (aref segment 3)))) 1210 (put-text-property beg (point) 'rmail-mime-entity entity)
1191 (insert-buffer-substring rmail-mime-mbox-buffer 1211 (dolist (child children)
1192 (aref body 0) (aref body 1))) 1212 (rmail-mime-insert child)))
1193 (put-text-property beg (point) 'rmail-mime-entity entity))) 1213 (if (eq (aref current 2) (aref new 2))
1214 (forward-char (- (aref segment 4) (aref segment 3)))
1215 (if (aref current 2)
1216 (delete-char (- (aref segment 4) (aref segment 3))))
1217 (insert-buffer-substring rmail-mime-mbox-buffer
1218 (aref body 0) (aref body 1))
1219 (or (bolp) (insert "\n")))
1220 (put-text-property beg (point) 'rmail-mime-entity entity)))))
1194 (dotimes (i 3) 1221 (dotimes (i 3)
1195 (aset current i (aref new i))))) 1222 (aset current i (aref new i)))))
1196 1223
@@ -1218,17 +1245,18 @@ displays text and multipart messages, and offers to download
1218attachments as specfied by `rmail-mime-attachment-dirs-alist'." 1245attachments as specfied by `rmail-mime-attachment-dirs-alist'."
1219 (interactive "P") 1246 (interactive "P")
1220 (if rmail-enable-mime 1247 (if rmail-enable-mime
1221 (if (rmail-mime-message-p) 1248 (with-current-buffer rmail-buffer
1222 (let ((rmail-mime-mbox-buffer rmail-view-buffer) 1249 (if (rmail-mime-message-p)
1223 (rmail-mime-view-buffer rmail-buffer) 1250 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
1224 (entity (get-text-property (point) 'rmail-mime-entity))) 1251 (rmail-mime-view-buffer rmail-buffer)
1225 (if arg 1252 (entity (get-text-property (point) 'rmail-mime-entity)))
1226 (if entity 1253 (if arg
1227 (rmail-mime-toggle-raw entity)) 1254 (if entity
1228 (goto-char (point-min)) 1255 (rmail-mime-toggle-raw entity))
1229 (rmail-mime-toggle-raw 1256 (goto-char (point-min))
1230 (get-text-property (point) 'rmail-mime-entity)))) 1257 (rmail-mime-toggle-raw
1231 (message "Not a MIME message")) 1258 (get-text-property (point) 'rmail-mime-entity))))
1259 (message "Not a MIME message")))
1232 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string)) 1260 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
1233 (buf (get-buffer-create "*RMAIL*")) 1261 (buf (get-buffer-create "*RMAIL*"))
1234 (rmail-mime-mbox-buffer rmail-view-buffer) 1262 (rmail-mime-mbox-buffer rmail-view-buffer)
@@ -1262,8 +1290,19 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
1262 (with-current-buffer rmail-mime-view-buffer 1290 (with-current-buffer rmail-mime-view-buffer
1263 (erase-buffer) 1291 (erase-buffer)
1264 (rmail-mime-insert entity) 1292 (rmail-mime-insert entity)
1265 (if rmail-mime-coding-system 1293 (if (consp rmail-mime-coding-system)
1266 (set-buffer-file-coding-system rmail-mime-coding-system t t))) 1294 ;; Decoding is done by rfc2047-decode-region only for a
1295 ;; header. But, as the used coding system may have been
1296 ;; overriden by mm-charset-override-alist, we can't
1297 ;; trust (car rmail-mime-coding-system). So, here we
1298 ;; try the decoding again with mm-charset-override-alist
1299 ;; bound to nil.
1300 (let ((mm-charset-override-alist nil))
1301 (setq rmail-mime-coding-system
1302 (rmail-mime-find-header-encoding
1303 (rmail-mime-entity-header entity)))))
1304 (set-buffer-file-coding-system
1305 (coding-system-base rmail-mime-coding-system) t t))
1267 ;; Decoding failed. ENTITY is an error message. Insert the 1306 ;; Decoding failed. ENTITY is an error message. Insert the
1268 ;; original message body as is, and show warning. 1307 ;; original message body as is, and show warning.
1269 (let ((region (with-current-buffer rmail-mime-mbox-buffer 1308 (let ((region (with-current-buffer rmail-mime-mbox-buffer
diff --git a/lisp/subr.el b/lisp/subr.el
index 293d71b8915..25f36269df0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -853,24 +853,37 @@ in the current Emacs session, then this function may return nil."
853 853
854(defsubst event-start (event) 854(defsubst event-start (event)
855 "Return the starting position of EVENT. 855 "Return the starting position of EVENT.
856If EVENT is a mouse or key press or a mouse click, this returns the location 856EVENT should be a click, drag, or key press event.
857of the event. 857If it is a key press event, the return value has the form
858If EVENT is a drag, this returns the drag's starting position. 858 (WINDOW POS (0 . 0) 0)
859The return value is of the form 859If it is a click or drag event, it has the form
860 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) 860 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
861 IMAGE (DX . DY) (WIDTH . HEIGHT)) 861 IMAGE (DX . DY) (WIDTH . HEIGHT))
862The `posn-' functions access elements of such lists." 862The `posn-' functions access elements of such lists.
863For more information, see Info node `(elisp)Click Events'.
864
865If EVENT is a mouse or key press or a mouse click, this is the
866position of the event. If EVENT is a drag, this is the starting
867position of the drag."
863 (if (consp event) (nth 1 event) 868 (if (consp event) (nth 1 event)
864 (list (selected-window) (point) '(0 . 0) 0))) 869 (list (selected-window) (point) '(0 . 0) 0)))
865 870
866(defsubst event-end (event) 871(defsubst event-end (event)
867 "Return the ending location of EVENT. 872 "Return the ending location of EVENT.
868EVENT should be a click, drag, or key press event. 873EVENT should be a click, drag, or key press event.
869If EVENT is a click event, this function is the same as `event-start'. 874If EVENT is a key press event, the return value has the form
870The return value is of the form 875 (WINDOW POS (0 . 0) 0)
876If EVENT is a click event, this function is the same as
877`event-start'. For click and drag events, the return value has
878the form
871 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) 879 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
872 IMAGE (DX . DY) (WIDTH . HEIGHT)) 880 IMAGE (DX . DY) (WIDTH . HEIGHT))
873The `posn-' functions access elements of such lists." 881The `posn-' functions access elements of such lists.
882For more information, see Info node `(elisp)Click Events'.
883
884If EVENT is a mouse or key press or a mouse click, this is the
885position of the event. If EVENT is a drag, this is the starting
886position of the drag."
874 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) 887 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
875 (list (selected-window) (point) '(0 . 0) 0))) 888 (list (selected-window) (point) '(0 . 0) 0)))
876 889
@@ -2364,11 +2377,16 @@ directory if it does not exist."
2364 ;; unless we're in batch mode or dumping Emacs 2377 ;; unless we're in batch mode or dumping Emacs
2365 (or noninteractive 2378 (or noninteractive
2366 purify-flag 2379 purify-flag
2367 (file-accessible-directory-p (directory-file-name user-emacs-directory)) 2380 (file-accessible-directory-p
2368 (make-directory user-emacs-directory)) 2381 (directory-file-name user-emacs-directory))
2382 (let ((umask (default-file-modes)))
2383 (unwind-protect
2384 (progn
2385 (set-default-file-modes ?\700)
2386 (make-directory user-emacs-directory))
2387 (set-default-file-modes umask))))
2369 (abbreviate-file-name 2388 (abbreviate-file-name
2370 (expand-file-name new-name user-emacs-directory)))))) 2389 (expand-file-name new-name user-emacs-directory))))))
2371
2372 2390
2373;;;; Misc. useful functions. 2391;;;; Misc. useful functions.
2374 2392