File: mew-w3m.el

package info (click to toggle)
w3m-el 1.4.569+0.20170110-5
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 5,780 kB
  • sloc: lisp: 45,666; sh: 515; makefile: 403
file content (520 lines) | stat: -rw-r--r-- 18,146 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
;; mew-w3m.el --- View Text/Html content with w3m in Mew

;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009, 2010
;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>

;; Author: Shun-ichi GOTO  <gotoh@taiyo.co.jp>,
;;         Hideyuki SHIRAI <shirai@meadowy.org>
;; Created: Wed Feb 28 03:31:00 2001
;; Version: $Revision: 1.71 $
;; Keywords: Mew, mail, w3m, WWW, hypermedia

;; This file is a part of emacs-w3m.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This package is for viewing formatted (rendered) Text/Html content
;; in Mew's message buffer.

;;; Installation:

;; (1) Simply load this file and add followings in your ~/.mew file.
;;
;; (require 'mew-w3m)
;;
;; (2) And you can use keymap of w3m-mode as mew-w3m-minor-mode.
;; To activate this feaeture, add followings also:
;;
;; (setq mew-use-w3m-minor-mode t)
;; (add-hook 'mew-message-hook 'mew-w3m-minor-mode-setter)
;;
;; (3) If you use mew-1.95b118 or later on which Emacs 21, 22 or XEmacs,
;; can display the images in the Text/Html message.
;; To activate this feaeture, add following in your ~/.mew file.
;;
;; (define-key mew-summary-mode-map "T" 'mew-w3m-view-inline-image)
;;
;; Press "T":    Toggle the visibility of the images included its message only.
;; Press "C-uT": Display the all images included its Text/Html part."
;;
;; (4) You can use emacs-w3m to fetch and/or browse
;; `external-body with URL access'. To activate this feaeture,
;; add followings also:
;;
;; (setq mew-ext-url-alist
;;      '(("^application/" "Fetch by emacs-w3m" mew-w3m-ext-url-fetch nil)
;;        (t "Browse by emacs-w3m" mew-w3m-ext-url-show nil)))
;;  or
;; (setq mew-ext-url-alist
;;      '((t "Browse by emacs-w3m" mew-w3m-ext-url-show nil)))
;;

;;; Usage:

;; There's nothing special. Browse messages in usual way.
;; On viewing Text/Html file, rendered text is appeared in message
;; buffer instead of usual "HTML" banner.
;; C-c C-e operation is also allowed to view with external browser.
;;
;; If mew-use-w3m-minor-mode is t, key operations of w3m-mode is
;; allowed (as minor-mode-map) and jump links in message buffer.
;; NOTE: This feature is not complete. You may confuse.
;;
;;

;;; Code:

(require 'mew)
(require 'w3m)
(eval-when-compile (require 'cl))

;;; initializer for mew
(defgroup mew-w3m nil
  "mew-w3m - Inline HTML rendering extension of Mew"
  :group 'w3m)

(defcustom mew-use-w3m-minor-mode nil
  "*Use w3m minor mode in message buffer.
Non-nil means that the minor mode whose keymap contains keys binded to
some emacs-w3m commands are activated in message buffer, when viewing
Text/Html contents."
  :group 'mew-w3m
  :type 'boolean)

(defcustom mew-w3m-auto-insert-image nil
  "*If non-nil, images are inserted automatically in Multipart/Related message.
This variable is effective only in XEmacs, Emacs 21 and Emacs 22."
  :group 'mew-w3m
  :type 'boolean)

(defcustom mew-w3m-cid-retrieve-hook nil
  "*Hook run after cid retrieved"
  :group 'mew-w3m
  :type 'hook)

(defcustom mew-w3m-region-cite-mark "&gt;&nbsp;"
  "*Method of converting `blockquote'."
  :group 'mew-w3m
  :type '(choice (const :tag "Use Indent" nil)
		 (const :tag "Use Cite Mark \"> \"" "&gt;&nbsp;")
		 (string :tag "Use Other Mark")))

(defconst mew-w3m-safe-url-regexp "\\`cid:")

;; Avoid bytecompile error and warnings.
(eval-when-compile
  (defvar mew-use-text/html)
  (unless (fboundp 'mew-current-get-fld)
    (autoload 'mew-coding-system-p "mew")
    (autoload 'mew-current-get-fld "mew")
    (autoload 'mew-current-get-msg "mew")
    (autoload 'mew-syntax-get-entry-by-cid "mew")
    (defun mew-cache-hit (&rest args) ())))

(defmacro mew-w3m-add-text-properties (props)
  `(add-text-properties (point-min)
			(min (1+ (point-min)) (point-max))
			,props))

(defun mew-w3m-minor-mode-setter ()
  "Check message buffer and activate w3m-minor-mode."
  (w3m-minor-mode (or (and (get-text-property (point-min) 'w3m)
			   mew-use-w3m-minor-mode)
		      0)))

(defvar mew-w3m-use-safe-url-regexp t)

(defun mew-w3m-view-inline-image (&optional allimage)
  "Display the images of Text/Html part.
\\<mew-summary-mode-map>
'\\[mew-w3m-view-inline-image]'	Toggle display the images included its message only.
'\\[universal-argument]\\[mew-w3m-view-inline-image]'	Display the all images included its Text/Html part."
  (interactive "P")
  (mew-summary-msg-or-part
   (if allimage
       (let ((mew-use-text/html t)
	     (mew-w3m-auto-insert-image t)
	     (mew-w3m-use-safe-url-regexp nil))
	 (mew-summary-display 'force))
     (with-current-buffer (mew-buffer-message)
       (let* ((image (get-text-property (point-min) 'w3m-images))
	      (w3m-display-inline-images image)
	      (w3m-safe-url-regexp (when mew-w3m-use-safe-url-regexp
				     mew-w3m-safe-url-regexp)))
	 (w3m-toggle-inline-images)
	 (mew-elet
	  (mew-w3m-add-text-properties `(w3m-images ,(not image)))
	  (set-buffer-modified-p nil)))))))

(defun mew-w3m-cite-blockquote (&optional inside-blockquote)
  "Quote paragraphs in <blockquote>...</blockquote> with the citation mark.
The variable `mew-w3m-region-cite-mark' specifies the citation mark."
  (let ((case-fold-search t))
    (while (and (re-search-forward "\
\[\t\n ]*<[\t\n ]*blockquote\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t)
		(w3m-end-of-tag "blockquote" t))
      (save-restriction
	(narrow-to-region (match-beginning 0) (match-end 0))
	(delete-region (goto-char (match-end 3)) (match-end 0))
	(insert "\n")
	(delete-region (goto-char (point-min)) (match-beginning 3))
	(insert "\n")
	(while (and (re-search-forward
		     "<[\t\n ]*pre\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t)
		    (w3m-end-of-tag "pre" t))
	  (delete-region (goto-char (match-end 2)) (match-end 0))
	  (if (bolp)
	      (when (looking-at "\n+") (replace-match ""))
	    (insert "\n"))
	  (delete-region (goto-char (match-beginning 0)) (match-beginning 2))
	  (if (bolp)
	      (when (looking-at "\n+") (replace-match ""))
	    (insert "\n")))
	(goto-char (point-min))
	(mew-w3m-cite-blockquote 'inside-blockquote)
	(goto-char (point-min))
	(while (re-search-forward
		"[\t\n ]*<br\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t)
	  (replace-match "\n"))
	(goto-char (point-min))
	(while (and (re-search-forward
		     "[\t\n ]*<div\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t)
		    (w3m-end-of-tag "div"))
	  (goto-char (match-beginning 0))
	  (insert "\n")
	  (goto-char (1+ (match-end 0)))
	  (insert "\n"))
	(goto-char (point-min))
	(while (re-search-forward "^[\t <>]+$" nil t)
	  (replace-match ""))
	(goto-char (point-min))
	(while (re-search-forward "\n\n\n+" nil t)
	  (replace-match "\n\n"))
	(goto-char (point-min))
	(when mew-w3m-region-cite-mark
	  (goto-char (point-min))
	  (while (re-search-forward "[^\t\n ]" nil t)
	    (beginning-of-line)
	    (if (looking-at "[\t ]+")
		(replace-match mew-w3m-region-cite-mark)
	      (insert mew-w3m-region-cite-mark))
	    (end-of-line)))
	(unless inside-blockquote
	  ; "> > > " --> ">>> "
	  (when (and mew-w3m-region-cite-mark
		     (string-match "&nbsp;\\'" mew-w3m-region-cite-mark))
	    (let ((base (substring mew-w3m-region-cite-mark
				   0 (match-beginning 0)))
		  (regexp (regexp-quote mew-w3m-region-cite-mark)))
	      (setq regexp (concat "^" regexp "\\(?:" regexp "\\)+"))
	      (goto-char (point-min))
	      (while (re-search-forward regexp nil t)
		(dotimes (i (prog1
				(/ (- (match-end 0) (match-beginning 0))
				   (length mew-w3m-region-cite-mark))
			      (delete-region (match-beginning 0)
					     (match-end 0))))
		  (insert base))
		(insert "&nbsp;"))))
	  (goto-char (point-min))
	  (insert "<pre>")
	  (goto-char (point-max))
	  (insert "</pre>\n"))))))

(defun mew-w3m-region (start end &optional url charset)
  "w3m-region with inserting the cite mark."
  (if (null mew-w3m-region-cite-mark)
      (w3m-region start end url charset)
    (save-restriction
      (narrow-to-region (goto-char start) end)
      (mew-w3m-cite-blockquote)
      (w3m-region (point-min) (point-max) url charset)
      (goto-char (point-min))
      (while (re-search-forward "^[\t ]+$" nil t)
	(replace-match ""))
      (goto-char (point-min))
      (while (re-search-forward "\n\n\n+" nil t)
	(replace-match "\n\n"))
      (goto-char (point-min))
      (skip-chars-forward "\n")
      (delete-region (point-min) (point))
      (goto-char (point-max))
      (skip-chars-backward "\n")
      (delete-region (point) (point-max))
      (insert "\n"))))

;; processing Text/Html contents with w3m.
(defun mew-mime-text/html-w3m (&rest args)
  "View Text/Html contents with w3m rendering output."
  (let ((w3m-display-inline-images mew-w3m-auto-insert-image)
	(w3m-safe-url-regexp (when mew-w3m-use-safe-url-regexp
			       mew-w3m-safe-url-regexp))
	w3m-force-redisplay	;; don't redraw
	charset wcs xref
	cache begin end params execute)
    (if (= (length args) 2)
	;; Mew-2
	(setq begin (nth 0 args) end (nth 1 args))
      ;; Old Mew
      (setq cache (nth 0 args))
      (setq begin (nth 1 args))
      (setq end (nth 2 args))
      (setq params (nth 3 args))
      (setq execute (nth 4 args)))
    (if (and cache (or execute (<= end begin)))
	;; 'C-cC-e' + Old Mew
	(apply 'mew-mime-text/html (list cache begin end params execute))
      (save-excursion
	;; search Xref: Header in SHIMBUN article
	(when cache (set-buffer cache))
	(goto-char (point-min))
	(when (re-search-forward mew-eoh nil t)
	  (let ((eoh (point))
		(case-fold-search t))
	    (goto-char (point-min))
	    (when (and (re-search-forward "^X-Shimbun-Id: " eoh t)
		       (goto-char (point-min))
		       (re-search-forward "^Xref: \\(.+\\)\n" eoh t))
	      (setq xref (match-string 1))
	      (w3m-static-if (fboundp 'match-string-no-properties)
		  (setq xref (match-string-no-properties 1))
		(setq xref (match-string 1))
		(set-text-properties 0 (length xref) nil xref))))))
      (mew-elet
       (cond
	((and (null cache) (eq w3m-type 'w3m-m17n))
	 ;; Mew-2 + w3m-m17n.
	 ;; Coding-system and charset are decided by Mew.
	 (let ((w3m-input-coding-system w3m-input-coding-system)
	       (w3m-output-coding-system w3m-output-coding-system)
	       (w3m-halfdump-command-arguments w3m-halfdump-command-arguments))
	   (when (setq charset (mew-charset-guess-region begin end))
	     (setq wcs (mew-charset-to-cs charset)))
	   (when (and charset wcs (mew-coding-system-p wcs))
	     ;; guess correctly and not us-ascii
	     (setq w3m-input-coding-system wcs)
	     (setq w3m-output-coding-system wcs)
	     (setq w3m-halfdump-command-arguments
		   (list "-halfdump"
			 "-I" charset "-O" charset
			 "-o" "ext_halfdump=1"
			 "-o" "pre_conv=1"
			 "-o" "strict_iso2022=0")))
	   (mew-w3m-region begin end xref)))
	((null cache)	;; Mew-2 + w3m, w3mmee
	 (mew-w3m-region begin end xref (mew-charset-guess-region begin end)))
	(t		;; Old Mew
	 (setq charset (or (mew-syntax-get-param params "charset")
			   (with-current-buffer cache
			     (mew-charset-guess-region begin end))))
	 (if charset
	     (setq wcs (mew-charset-to-cs charset))
	   (setq wcs mew-cs-text-for-write))
	 (mew-frwlet
	     mew-cs-dummy wcs
	   (mew-w3m-region (point)
			   (progn (insert-buffer-substring cache begin end)
				  (point))
			   xref))))
       (mew-w3m-add-text-properties `(w3m t w3m-images ,mew-w3m-auto-insert-image))))))

(defvar w3m-mew-support-cid (and (boundp 'mew-version-number)
				 (fboundp 'mew-syntax-get-entry-by-cid)))

(defun mew-w3m-cid-retrieve (url &rest args)
  (let ((output-buffer (current-buffer)))
    (with-current-buffer w3m-current-buffer
      (when (and w3m-mew-support-cid
		 (string-match "^cid:\\(.+\\)" url))
	(setq url (match-string 1 url))
	(let* ((fld (mew-current-get-fld (mew-frame-id)))
	       (msg (mew-current-get-msg (mew-frame-id)))
	       (cache (mew-cache-hit fld msg 'must-hit))
	       (syntax (mew-cache-decode-syntax cache))
	       cidstx beg end)
	  (if (string< "4.0.53" mew-version-number)
	      (setq cidstx (mew-syntax-get-entry-by-cid syntax (concat "<" url ">")))
	    (setq cidstx (mew-syntax-get-entry-by-cid syntax url)))
	  (when cidstx
	    (setq beg (mew-syntax-get-begin cidstx))
	    (setq end (mew-syntax-get-end cidstx))
	    (prog1
		(with-current-buffer output-buffer
		  (set-buffer-multibyte t)
		  (insert-buffer-substring cache beg end)
		  (set-buffer-multibyte nil)
		  (downcase (car (mew-syntax-get-ct cidstx))))
	      (run-hooks 'mew-w3m-cid-retrieve-hook))))))))

(when w3m-mew-support-cid
  (push (cons 'mew-message-mode 'mew-w3m-cid-retrieve)
	w3m-cid-retrieve-function-alist))

(defun mew-w3m-ext-url-show (dummy url)
  (pop-to-buffer (mew-buffer-message))
  (w3m url))

(defun mew-w3m-ext-url-fetch (dummy url)
  (lexical-let ((url url)
		(name (file-name-nondirectory url))
		handler)
    (w3m-process-do
	(success (prog1
		     (w3m-download url nil nil handler)
		   (message "Download: %s..." name)))
      (if success
	  (message "Download: %s...done" name)
	(message "Download: %s...failed" name))
      (sit-for 1))))

(defun w3m-mail-compose-with-mew (source url charset content-type
					 to subject other-headers)
  "Compose a mail using Mew."
  (when (one-window-p)
    (split-window))
  (select-window (next-window))
  (condition-case nil
      (unless (and (boundp 'mew-init-p) mew-init-p
		   (progn
		     (mew-summary-jump-to-draft-buffer)
		     (and (eq major-mode 'mew-draft-mode)
			  (y-or-n-p "Attatch this draft? "))))
	(mew-user-agent-compose to subject other-headers))
    (quit
     (if (y-or-n-p "Create new draft? ")
	 (mew-user-agent-compose to subject other-headers)
       (delete-window)
       (error "Abort mail composing"))))
  (let* ((basename (file-name-nondirectory (w3m-url-strip-query url)))
	 (ct (downcase  content-type))
	 (mew-attach-move-next-after-copy nil)
	 (i 1)
	 (pos -1)
	 (csorig (mew-charset-to-cs (symbol-name charset)))
	 last filename cs)
    (unless (mew-attach-p)
      (mew-draft-prepare-attachments))
    ;; goto last attachment
    (setq last (catch 'last
		 (while (not (= pos (point)))
		   (setq i (1+ i))
		   (mew-attach-goto-number 'here `(,i))
		   (when (mew-attach-line-lastp)
		     (throw 'last t)))))
    (when (eq csorig mew-cs-unknown)
      (setq csorig nil))
    (if (or (not last) (not (mew-attach-not-line012-1)))
	(message "Can not attach from emacs-w3m here!")
      ;; Application/.*xml is not inline view with Mew.
      (cond
       ((string= "application/xhtml+xml" ct)
	(setq ct "text/html"))
       ((string-match "^application/.*xml$" ct)
	(setq ct "text/xml")))
      (setq filename (expand-file-name (cond
					((and (string-match "^[\t ]*$" basename)
					      (string= ct "text/html"))
					 "index.html")
					((and (string-match "^[\t ]*$" basename)
					      (string= ct "text/xml"))
					 "index.xml")
					((string-match "^[\t ]*$" basename)
					 "dummy")
					(t
					 basename))
				       mew-temp-dir))
      (with-temp-buffer
	(cond
	 ((string= "text/html" ct)
	  (insert source)
	  (setq cs (w3m-static-if (fboundp 'mew-text/html-detect-cs)
		       (mew-text/html-detect-cs (point-min) (point-max))))
	  (when (or (eq cs mew-cs-unknown) (not cs))
	    (cond
	     (csorig
	      (setq cs csorig))
	     (t
	      (setq cs mew-cs-autoconv)))))
	 ((string= "text/xml" ct)
	  (insert source)
	  (setq cs (w3m-static-if (fboundp 'mew-text/html-detect-cs)
		       (mew-text/html-detect-cs (point-min) (point-max))))
	  (when (or (eq cs mew-cs-unknown) (not cs))
	    (cond
	     (csorig
	      (setq cs csorig))
	     ((mew-coding-system-p 'utf-8)
	      (setq cs 'utf-8))
	     (t
	      (setq cs mew-cs-autoconv)))))
	 ((string-match "^text/" ct)
	  (insert source)
	  (setq cs mew-cs-autoconv))
	 (t
	  (mew-set-buffer-multibyte nil)
	  (insert source)
	  (setq cs mew-cs-binary)))
	(setq charset (cond
		       ((eq cs mew-cs-autoconv)
			(mew-charset-guess-region (point-min) (point-max)))
		       ((eq cs mew-cs-binary)
			nil)
		       (t
			(mew-cs-to-charset cs))))
	(mew-frwlet
	    mew-cs-text-for-read cs
	  (write-region (point-min) (point-max) filename nil 'nomsg)))
      (when ct
	(setq ct (mew-capitalize ct)))
      (mew-attach-copy filename (file-name-nondirectory filename))
      ;; content-type check & set
      (let* ((nums (mew-syntax-nums))
	     (syntax (mew-syntax-get-entry mew-encode-syntax nums))
	     (file (mew-syntax-get-file syntax))
	     (ctl (mew-syntax-get-ct syntax))
	     (ct-orig (mew-syntax-get-value ctl 'cap))
	     cte)
	(unless (string= ct ct-orig)
	  (setq ctl (list ct))
	  (mew-syntax-set-ct syntax ctl)
	  (setq cte (mew-ctdb-cte (mew-ctdb-by-ct ct)))
	  (mew-syntax-set-cte syntax cte)
	  (mew-syntax-set-cdp syntax (mew-syntax-cdp-format ct file))
	  (mew-encode-syntax-print mew-encode-syntax)))
      ;; charset set
      (let* ((nums (mew-syntax-nums))
	     (syntax (mew-syntax-get-entry mew-encode-syntax nums))
	     (file (mew-syntax-get-file syntax))
	     (ctl (mew-syntax-get-ct syntax))
	     (ct (mew-syntax-get-value ctl 'cap))
	     (params (mew-syntax-get-params ctl))
	     (ocharset "charset"))
	(when (and (string-match "^Text" ct) charset)
	  (setq params (mew-delete ocharset params))
	  (setq ctl (cons ct (cons (list ocharset charset) params)))
	  (mew-syntax-set-ct syntax ctl))
	(mew-syntax-set-cd syntax url)
	(mew-encode-syntax-print mew-encode-syntax))
      (message "Compose a mail using Mew with %s...done" url)
      (when (and (file-exists-p filename) (file-writable-p filename))
	(delete-file filename)))))

;;;
(provide 'mew-w3m)

;; mew-w3m.el ends here