Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
emacs
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
emacs
emacs
Commits
e7ca0062
Commit
e7ca0062
authored
Jan 12, 2011
by
Kenichi Handa
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Another improvement of MIME handling in rmail.
parent
8434f239
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
162 additions
and
110 deletions
+162
-110
lisp/ChangeLog
lisp/ChangeLog
+39
-0
lisp/mail/rmailmm.el
lisp/mail/rmailmm.el
+123
-110
No files found.
lisp/ChangeLog
View file @
e7ca0062
2011-01-12 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-next-item)
(rmail-mime-previous-item): Delete them.
(rmail-mime-shown-mode): Recursively call for children.
(rmail-mime-hidden-mode): Delete the 2nd arg TOP. Callers
changed.
(rmail-mime-raw-mode): Recursively call for children.
(rmail-mode-map): Change mapping of tab and backtab to
forward-button and backward-button respectively.
(rmail-mime-insert-tagline): Always insert "Hide" or "Show"
button.
(rmail-mime-update-tagline): New function.
(rmail-mime-insert-text): Call rmail-mime-update-tagline if the
body display is changed.
(rmail-mime-toggle-button): Renamed from rmail-mime-image.
(rmail-mime-image): Delete this button type.
(rmail-mime-toggle): New button type.
(rmail-mime-insert-bulk): Call rmail-mime-update-tagline if the
body display is changed. Change the save button label to "Save".
Don't process show/hide button here.
(rmail-mime-insert-multipart): Call rmail-mime-update-tagline if
the body display is changed. Unconditionally call
rmail-mime-insert for children.
(rmail-mime-handle): Update `display' vector of the just inserted
entity.
(rmail-mime-process): If mail-header-parse-content-type returns
nil, use "text/plain" as the fallback type.
(rmail-mime-insert): For raw-mode, recursively call
rmail-mim-insert for children.
(rmail-mime): Handle the case that the current buffer is not rmail
buffer (e.g. in summary buffer).
2011-01-05 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-next-item)
(rmail-mime-previous-item): Skip the body of a non-multipart
entity if a tagline is shown.
2011-01-04 Kenichi Handa <handa@m17n.org>
* mail/rmailmm.el (rmail-mime-insert-bulk): Display an unknown
...
...
lisp/mail/rmailmm.el
View file @
e7ca0062
...
...
@@ -273,11 +273,11 @@ It is called with one argument ENTITY."
"Return a vector describing the displayed region of a MIME-entity at POS.
Optional 2nd argument ENTITY is the MIME-entity at POS.
The value is a vector [ INDEX HEADER TAGLINE BODY END], where
INDEX: index into the returned vector indicating where POS is (1..3).
HEADER: the position of the beginning of a header
TAGLINE: the position of the beginning of a tagline
BODY: the position of the beginning of a body
END: the position of the end of the entity.
INDEX: index into the returned vector indicating where POS is."
END: the position of the end of the entity."
(
save-excursion
(
or
entity
(
setq
entity
(
get-text-property
pos
'rmail-mime-entity
)))
...
...
@@ -318,74 +318,32 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where
(
setq
end
body-beg
))
(
vector
index
beg
tagline-beg
body-beg
end
)))))
(
defun
rmail-mime-next-item
()
"Move point to the next displayed item of the current MIME entity.
A MIME entity has three items; header, tagline, and body.
If we are in the last item of the entity, move point to the first
item of the next entity. If we reach the end of buffer, move
point to the first item of the first entity (i.e. the beginning
of buffer)."
(
interactive
)
(
if
(
rmail-mime-message-p
)
(
let*
((
segment
(
rmail-mime-entity-segment
(
point
)))
(
next-pos
(
aref
segment
(
1+
(
aref
segment
0
))))
(
button
(
next-button
(
point
))))
(
goto-char
(
if
(
and
button
(
<
(
button-start
button
)
next-pos
))
(
button-start
button
)
next-pos
))
(
if
(
eobp
)
(
goto-char
(
point-min
))))))
(
defun
rmail-mime-previous-item
()
"Move point to the previous displayed item of the current MIME message.
A MIME entity has three items; header, tagline, and body.
If we are at the beginning of the first item of the entity, move
point to the last item of the previous entity. If we reach the
beginning of buffer, move point to the last item of the last
entity."
(
interactive
)
(
when
(
rmail-mime-message-p
)
(
if
(
bobp
)
(
goto-char
(
point-max
)))
(
let*
((
segment
(
rmail-mime-entity-segment
(
1-
(
point
))))
(
prev-pos
(
aref
segment
(
aref
segment
0
)))
(
button
(
previous-button
(
point
))))
(
goto-char
(
if
(
and
button
(
>
(
button-start
button
)
prev-pos
))
(
button-start
button
)
prev-pos
)))))
(
defun
rmail-mime-shown-mode
(
entity
)
"Make MIME-entity ENTITY displayed by the default way."
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
aset
new
0
(
aref
(
rmail-mime-entity-header
entity
)
2
))
(
aset
new
1
(
aref
(
rmail-mime-entity-tagline
entity
)
2
))
(
aset
new
2
(
aref
(
rmail-mime-entity-body
entity
)
2
))))
(
aset
new
2
(
aref
(
rmail-mime-entity-body
entity
)
2
)))
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-shown-mode
child
)))
(
defun
rmail-mime-hidden-mode
(
entity
top
)
"Make MIME-entity ENTITY displayed in the hidden mode.
If TOP is non-nil, display ENTITY only by the tagline.
Otherwise, don't display ENTITY."
(
if
top
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
aset
new
0
nil
)
(
aset
new
1
top
)
(
aset
new
2
nil
)
(
aset
(
rmail-mime-entity-body
entity
)
2
nil
))
(
let
((
current
(
aref
(
rmail-mime-entity-display
entity
)
0
)))
(
aset
current
0
nil
)
(
aset
current
1
nil
)
(
aset
current
2
nil
)))
(
defun
rmail-mime-hidden-mode
(
entity
)
"Make MIME-entity ENTITY displayed in the hidden mode."
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
aset
new
0
nil
)
(
aset
new
1
t
)
(
aset
new
2
nil
))
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-hidden-mode
child
nil
)))
(
rmail-mime-hidden-mode
child
)))
(
defun
rmail-mime-raw-mode
(
entity
)
"Make MIME-entity ENTITY displayed in the raw mode."
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
aset
new
0
'raw
)
(
aset
new
1
nil
)
(
aset
new
2
'raw
)
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-hidden-mode
child
nil
)
)))
(
aset
new
2
'raw
)
)
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-raw-mode
child
)))
(
defun
rmail-mime-toggle-raw
(
entity
)
"Toggle on and off the raw display mode of MIME-entity ENTITY."
...
...
@@ -406,7 +364,7 @@ Otherwise, don't display ENTITY."
(
restore-buffer-modified-p
modified
)))))
(
defun
rmail-mime-toggle-hidden
()
"
Toggle on and off the hidden display mode of MIME-entity ENTITY
."
"
Hide or show the body of MIME-entity at point
."
(
interactive
)
(
when
(
rmail-mime-message-p
)
(
let*
((
rmail-mime-mbox-buffer
rmail-view-buffer
)
...
...
@@ -419,18 +377,19 @@ Otherwise, don't display ENTITY."
;; Enter the hidden mode.
(
progn
;; If point is in the body part, move it to the tagline
;; (or the header if
head
line is not displayed).
;; (or the header if
tag
line is not displayed).
(
if
(
=
(
aref
segment
0
)
3
)
(
goto-char
(
aref
segment
2
)))
(
rmail-mime-hidden-mode
entity
t
)
(
rmail-mime-hidden-mode
entity
)
;; If the current entity is the topmost one, display the
;; header.
(
if
(
and
rmail-mime-mbox-buffer
(
=
(
aref
segment
1
)
(
point-min
)))
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
aset
new
0
t
))))
;; Enter the shown mode.
(
aset
(
rmail-mime-entity-body
entity
)
2
t
)
(
rmail-mime-shown-mode
entity
))
(
rmail-mime-shown-mode
entity
)
;; Force this body shown.
(
aset
(
aref
(
rmail-mime-entity-display
entity
)
1
)
2
t
))
(
let
((
inhibit-read-only
t
)
(
modified
(
buffer-modified-p
))
(
rmail-mime-mbox-buffer
rmail-view-buffer
)
...
...
@@ -440,8 +399,8 @@ Otherwise, don't display ENTITY."
(
rmail-mime-insert
entity
)
(
restore-buffer-modified-p
modified
))))))
(
define-key
rmail-mode-map
"\t"
'
rmail-mime-next-item
)
(
define-key
rmail-mode-map
[backtab]
'
rmail-mime-previous-item
)
(
define-key
rmail-mode-map
"\t"
'
forward-button
)
(
define-key
rmail-mode-map
[backtab]
'
backward-button
)
(
define-key
rmail-mode-map
"\r"
'rmail-mime-toggle-hidden
)
;;; Handlers
...
...
@@ -453,7 +412,11 @@ to the tag line."
(
insert
"["
)
(
let
((
tag
(
aref
(
rmail-mime-entity-tagline
entity
)
0
)))
(
if
(
>
(
length
tag
)
0
)
(
insert
(
substring
tag
1
)
":"
)))
(
insert
(
car
(
rmail-mime-entity-type
entity
)))
(
insert
(
car
(
rmail-mime-entity-type
entity
))
" "
)
(
insert-button
(
let
((
new
(
aref
(
rmail-mime-entity-display
entity
)
1
)))
(
if
(
aref
new
2
)
"Hide"
"Show"
))
:type
'rmail-mime-toggle
'help-echo
"mouse-2, RET: Toggle show/hide"
)
(
dolist
(
item
item-list
)
(
when
item
(
if
(
stringp
item
)
...
...
@@ -461,6 +424,26 @@ to the tag line."
(
apply
'insert-button
item
))))
(
insert
"]\n"
))
(
defun
rmail-mime-update-tagline
(
entity
)
"Update the current tag line for MIME-entity ENTITY."
(
let
((
inhibit-read-only
t
)
(
modified
(
buffer-modified-p
))
;; If we are going to show the body, the new button label is
;; "Hide". Otherwise, it's "Show".
(
label
(
if
(
aref
(
aref
(
rmail-mime-entity-display
entity
)
1
)
2
)
"Hide"
"Show"
))
(
button
(
next-button
(
point
))))
;; Go to the second character of the button "Show" or "Hide".
(
goto-char
(
1+
(
button-start
button
)))
(
setq
button
(
button-at
(
point
)))
(
save-excursion
(
insert
label
)
(
delete-region
(
point
)
(
button-end
button
)))
(
delete-region
(
button-start
button
)
(
point
))
(
put-text-property
(
point
)
(
button-end
button
)
'rmail-mime-entity
entity
)
(
restore-buffer-modified-p
modified
)
(
forward-line
1
)))
(
defun
rmail-mime-insert-header
(
header
)
"Decode and insert a MIME-entity header HEADER in the current buffer.
HEADER is a vector [BEG END DEFAULT-STATUS].
...
...
@@ -543,7 +526,10 @@ See `rmail-mime-entity' for the detail."
(
rmail-mime-insert-header
header
)))
;; tagline
(
if
(
eq
(
aref
current
1
)
(
aref
new
1
))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
if
(
or
(
not
(
aref
current
1
))
(
eq
(
aref
current
2
)
(
aref
new
2
)))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
rmail-mime-update-tagline
entity
))
(
if
(
aref
current
1
)
(
delete-char
(
-
(
aref
segment
3
)
(
aref
segment
2
))))
(
if
(
aref
new
1
)
...
...
@@ -598,13 +584,13 @@ MIME-Version: 1.0
(
insert-image
(
create-image
data
(
cdr
bulk-data
)
t
))
(
insert
"\n"
)))
(
defun
rmail-mime-
image
(
button
)
"
Display the image
associated with BUTTON."
(
defun
rmail-mime-
toggle-button
(
button
)
"
Hide or show the body of the MIME-entity
associated with BUTTON."
(
save-excursion
(
goto-char
(
button-
end
button
))
(
goto-char
(
button-
start
button
))
(
rmail-mime-toggle-hidden
)))
(
define-button-type
'rmail-mime-
image
'action
'rmail-mime-image
)
(
define-button-type
'rmail-mime-
toggle
'action
'rmail-mime-toggle-button
)
(
defun
rmail-mime-bulk-handler
(
content-type
...
...
@@ -627,7 +613,7 @@ directly."
(
size
(
cdr
(
assq
'size
(
cdr
(
rmail-mime-entity-disposition
entity
)))))
(
bulk-data
(
aref
(
rmail-mime-entity-tagline
entity
)
1
))
(
body
(
rmail-mime-entity-body
entity
))
size
type
to-show
)
type
to-show
)
(
cond
(
size
(
setq
size
(
string-to-number
size
)))
((
stringp
(
aref
body
0
))
...
...
@@ -661,7 +647,6 @@ directly."
(
defun
rmail-mime-insert-bulk
(
entity
)
"Presentation handler for an attachment MIME entity."
;; Find the default directory for this media type.
(
let*
((
content-type
(
rmail-mime-entity-type
entity
))
(
content-disposition
(
rmail-mime-entity-disposition
entity
))
(
current
(
aref
(
rmail-mime-entity-display
entity
)
0
))
...
...
@@ -670,6 +655,7 @@ directly."
(
tagline
(
rmail-mime-entity-tagline
entity
))
(
bulk-data
(
aref
tagline
1
))
(
body
(
rmail-mime-entity-body
entity
))
;; Find the default directory for this media type.
(
directory
(
catch
'directory
(
dolist
(
entry
rmail-mime-attachment-dirs-alist
)
(
when
(
string-match
(
car
entry
)
(
car
content-type
))
...
...
@@ -710,13 +696,16 @@ directly."
;; tagline
(
if
(
eq
(
aref
current
1
)
(
aref
new
1
))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
if
(
or
(
not
(
aref
current
1
))
(
eq
(
aref
current
2
)
(
aref
new
2
)))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
rmail-mime-update-tagline
entity
))
(
if
(
aref
current
1
)
(
delete-char
(
-
(
aref
segment
3
)
(
aref
segment
2
))))
(
if
(
aref
new
1
)
(
rmail-mime-insert-tagline
entity
"
fil
e:"
"
Sav
e:"
(
list
filename
:type
'rmail-mime-save
'help-echo
"mouse-2, RET: Save attachment"
...
...
@@ -724,14 +713,17 @@ directly."
'directory
(
file-name-as-directory
directory
)
'data
data
)
(
format
" (%.0f%s)"
size
(
car
units
))
(
if
(
cdr
bulk-data
)
" "
)
(
if
(
cdr
bulk-data
)
(
list
"Toggle show/hide"
:type
'rmail-mime-image
'help-echo
"mouse-2, RET: Toggle show/hide"
'image-type
(
cdr
bulk-data
)
'image-data
data
)))))
;; We don't need this button because the "type" string of a
;; tagline is the button to do this.
;; (if (cdr bulk-data)
;; " ")
;; (if (cdr bulk-data)
;; (list "Toggle show/hide"
;; :type 'rmail-mime-image
;; 'help-echo "mouse-2, RET: Toggle show/hide"
;; 'image-type (cdr bulk-data)
;; 'image-data data))
)))
;; body
(
if
(
eq
(
aref
current
2
)
(
aref
new
2
))
(
forward-char
(
-
(
aref
segment
4
)
(
aref
segment
3
)))
...
...
@@ -882,8 +874,9 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(
setq
second
child
)))))
(
or
best
(
not
second
)
(
setq
best
second
))
(
dolist
(
child
entities
)
(
or
(
eq
best
child
)
(
rmail-mime-hidden-mode
child
t
)))))
(
unless
(
eq
best
child
)
(
aset
(
rmail-mime-entity-body
child
)
2
nil
)
(
rmail-mime-hidden-mode
child
)))))
entities
)))
(
defun
test-rmail-mime-multipart-handler
()
...
...
@@ -935,21 +928,23 @@ This is the epilogue. It is also to be ignored."))
(
rmail-mime-insert-header
header
)))
;; tagline
(
if
(
eq
(
aref
current
1
)
(
aref
new
1
))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
if
(
or
(
not
(
aref
current
1
))
(
eq
(
aref
current
2
)
(
aref
new
2
)))
(
forward-char
(
-
(
aref
segment
3
)
(
aref
segment
2
)))
(
rmail-mime-update-tagline
entity
))
(
if
(
aref
current
1
)
(
delete-char
(
-
(
aref
segment
3
)
(
aref
segment
2
))))
(
if
(
aref
new
1
)
(
rmail-mime-insert-tagline
entity
)))
(
put-text-property
beg
(
point
)
'rmail-mime-entity
entity
)
;; body
(
if
(
eq
(
aref
current
2
)
(
aref
new
2
))
(
forward-char
(
-
(
aref
segment
4
)
(
aref
segment
3
)))
(
if
(
aref
current
2
)
(
delete-char
(
-
(
aref
segment
4
)
(
aref
segment
3
))))
(
if
(
aref
new
2
)
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-insert
child
))))))
(
dolist
(
child
(
rmail-mime-entity-children
entity
))
(
rmail-mime-insert
child
)))
entity
))
;;; Main code
...
...
@@ -1010,7 +1005,16 @@ The parsed header value:
;; Everything else is an attachment.
(
rmail-mime-bulk-handler
content-type
content-disposition
content-transfer-encoding
)))
content-transfer-encoding
))
(
save-restriction
(
widen
)
(
let
((
entity
(
get-text-property
(
1-
(
point
))
'rmail-mime-entity
))
current
new
)
(
when
entity
(
setq
current
(
aref
(
rmail-mime-entity-display
entity
)
0
)
new
(
aref
(
rmail-mime-entity-display
entity
)
1
))
(
dotimes
(
i
3
)
(
aset
current
i
(
aref
new
i
)))))))
(
defun
rmail-mime-show
(
&optional
show-headers
)
"Handle the current buffer as a MIME message.
...
...
@@ -1055,7 +1059,8 @@ modified."
(
setq
content-transfer-encoding
(
downcase
content-transfer-encoding
)))
(
setq
content-type
(
if
content-type
(
mail-header-parse-content-type
content-type
)
(
or
(
mail-header-parse-content-type
content-type
)
'
(
"text/plain"
))
(
or
default-content-type
'
(
"text/plain"
))))
(
setq
content-disposition
(
if
content-disposition
...
...
@@ -1183,13 +1188,20 @@ available."
(
if
(
aref
current
1
)
(
delete-char
(
-
(
aref
segment
3
)
(
aref
segment
2
))))
;; body
(
if
(
eq
(
aref
current
2
)
(
aref
new
2
))
(
forward-char
(
-
(
aref
segment
4
)
(
aref
segment
3
)))
(
if
(
aref
current
2
)
(
delete-char
(
-
(
aref
segment
4
)
(
aref
segment
3
))))
(
insert-buffer-substring
rmail-mime-mbox-buffer
(
aref
body
0
)
(
aref
body
1
)))
(
put-text-property
beg
(
point
)
'rmail-mime-entity
entity
)))
(
let
((
children
(
rmail-mime-entity-children
entity
)))
(
if
children
(
progn
(
put-text-property
beg
(
point
)
'rmail-mime-entity
entity
)
(
dolist
(
child
children
)
(
rmail-mime-insert
child
)))
(
if
(
eq
(
aref
current
2
)
(
aref
new
2
))
(
forward-char
(
-
(
aref
segment
4
)
(
aref
segment
3
)))
(
if
(
aref
current
2
)
(
delete-char
(
-
(
aref
segment
4
)
(
aref
segment
3
))))
(
insert-buffer-substring
rmail-mime-mbox-buffer
(
aref
body
0
)
(
aref
body
1
))
(
or
(
bolp
)
(
insert
"\n"
)))
(
put-text-property
beg
(
point
)
'rmail-mime-entity
entity
)))))
(
dotimes
(
i
3
)
(
aset
current
i
(
aref
new
i
)))))
...
...
@@ -1217,17 +1229,18 @@ displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'."
(
interactive
"P"
)
(
if
rmail-enable-mime
(
if
(
rmail-mime-message-p
)
(
let
((
rmail-mime-mbox-buffer
rmail-view-buffer
)
(
rmail-mime-view-buffer
rmail-buffer
)
(
entity
(
get-text-property
(
point
)
'rmail-mime-entity
)))
(
if
arg
(
if
entity
(
rmail-mime-toggle-raw
entity
))
(
goto-char
(
point-min
))
(
rmail-mime-toggle-raw
(
get-text-property
(
point
)
'rmail-mime-entity
))))
(
message
"Not a MIME message"
))
(
with-current-buffer
rmail-buffer
(
if
(
rmail-mime-message-p
)
(
let
((
rmail-mime-mbox-buffer
rmail-view-buffer
)
(
rmail-mime-view-buffer
rmail-buffer
)
(
entity
(
get-text-property
(
point
)
'rmail-mime-entity
)))
(
if
arg
(
if
entity
(
rmail-mime-toggle-raw
entity
))
(
goto-char
(
point-min
))
(
rmail-mime-toggle-raw
(
get-text-property
(
point
)
'rmail-mime-entity
))))
(
message
"Not a MIME message"
)))
(
let*
((
data
(
rmail-apply-in-message
rmail-current-message
'buffer-string
))
(
buf
(
get-buffer-create
"*RMAIL*"
))
(
rmail-mime-mbox-buffer
rmail-view-buffer
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment