Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mime.el @ 155:43dd3413c7c7 r20-3b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents 2af401a6ecca
children 2d532a89d707
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
392 (not (= ?\n (char-after (1+ inputpos))))) 392 (not (= ?\n (char-after (1+ inputpos)))))
393 (vm-insert-char char 1 nil work-buffer) 393 (vm-insert-char char 1 nil work-buffer)
394 (vm-increment cols)) 394 (vm-increment cols))
395 ((or (< char 33) (> char 126) (= char 61) 395 ((or (< char 33) (> char 126) (= char 61)
396 (and quote-from (= cols 0) (let ((case-fold-search nil)) 396 (and quote-from (= cols 0) (let ((case-fold-search nil))
397 (looking-at "From ")))) 397 (looking-at "From ")))
398 (and (= cols 0) (= char ?.)
399 (looking-at "\\.\\(\n\\|\\'\\)")))
398 (vm-insert-char ?= 1 nil work-buffer) 400 (vm-insert-char ?= 1 nil work-buffer)
399 (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist)) 401 (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist))
400 1 nil work-buffer) 402 1 nil work-buffer)
401 (vm-insert-char (car (rassq (logand char 15) 403 (vm-insert-char (car (rassq (logand char 15)
402 hex-digit-alist)) 404 hex-digit-alist))
835 (require 'disp-table) 837 (require 'disp-table)
836 (let* ((standard-display-table 838 (let* ((standard-display-table
837 (copy-sequence standard-display-table))) 839 (copy-sequence standard-display-table)))
838 (standard-display-european t) 840 (standard-display-european t)
839 (setq buffer-display-table standard-display-table)))) 841 (setq buffer-display-table standard-display-table))))
840 (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) 842 (if (and vm-mutable-frames vm-frame-per-folder
843 (vm-multiple-frames-possible-p))
841 (vm-set-hooks-for-frame-deletion)) 844 (vm-set-hooks-for-frame-deletion))
842 (use-local-map vm-mode-map) 845 (use-local-map vm-mode-map)
843 (and (vm-toolbar-support-possible-p) vm-use-toolbar 846 (and (vm-toolbar-support-possible-p) vm-use-toolbar
844 (vm-toolbar-install-toolbar)) 847 (vm-toolbar-install-toolbar))
845 (and (vm-menu-support-possible-p) 848 (and (vm-menu-support-possible-p)
1332 t )) 1335 t ))
1333 1336
1334 (defun vm-mime-display-external-generic (layout) 1337 (defun vm-mime-display-external-generic (layout)
1335 (let ((program-list (vm-mime-find-external-viewer 1338 (let ((program-list (vm-mime-find-external-viewer
1336 (car (vm-mm-layout-type layout)))) 1339 (car (vm-mm-layout-type layout))))
1337 (process (nth 0 (vm-mm-layout-cache layout)))
1338 (tempfile (nth 1 (vm-mm-layout-cache layout)))
1339 (buffer-read-only nil) 1340 (buffer-read-only nil)
1340 (start (point)) 1341 (start (point))
1341 end) 1342 process tempfile cache end)
1343 (setq cache (cdr (assq 'vm-mime-display-external-generic
1344 (vm-mm-layout-cache layout)))
1345 process (nth 0 cache)
1346 tempfile (nth 1 cache))
1342 (if (and (processp process) (eq (process-status process) 'run)) 1347 (if (and (processp process) (eq (process-status process) 'run))
1343 t 1348 t
1344 (cond ((or (null tempfile) (null (file-exists-p tempfile))) 1349 (cond ((or (null tempfile) (null (file-exists-p tempfile)))
1345 (vm-mime-insert-mime-body layout) 1350 (vm-mime-insert-mime-body layout)
1346 (setq end (point-marker)) 1351 (setq end (point-marker))
1380 (save-excursion 1385 (save-excursion
1381 (vm-select-folder-buffer) 1386 (vm-select-folder-buffer)
1382 (setq vm-message-garbage-alist 1387 (setq vm-message-garbage-alist
1383 (cons (cons process 'delete-process) 1388 (cons (cons process 'delete-process)
1384 vm-message-garbage-alist))) 1389 vm-message-garbage-alist)))
1385 (vm-set-mm-layout-cache layout (list process tempfile)))) 1390 (vm-set-mm-layout-cache
1391 layout
1392 (nconc (vm-mm-layout-cache layout)
1393 (list (cons 'vm-mime-display-external-generic
1394 (list process tempfile)))))))
1386 t ) 1395 t )
1387 1396
1388 (defun vm-mime-display-internal-application/octet-stream (layout) 1397 (defun vm-mime-display-internal-application/octet-stream (layout)
1389 (if (vectorp layout) 1398 (if (vectorp layout)
1390 (let ((buffer-read-only nil) 1399 (let ((buffer-read-only nil)
1391 (description (vm-mm-layout-description layout))) 1400 (description (vm-mm-layout-description layout)))
1392 (vm-mime-insert-button 1401 (vm-mime-insert-button
1393 (format "%-35.35s [%s to save to a file]" 1402 (format "%-35.35s [%s to save to a file]"
1394 (vm-mime-layout-description layout) 1403 (vm-mime-layout-description layout)
1395 (if (vm-mouse-support-possible-p) 1404 (if (vm-mouse-support-possible-here-p)
1396 "Click mouse-2" 1405 "Click mouse-2"
1397 "Press RETURN")) 1406 "Press RETURN"))
1398 (function 1407 (function
1399 (lambda (layout) 1408 (lambda (layout)
1400 (save-excursion 1409 (save-excursion
1477 1486
1478 (defun vm-mime-display-button-multipart/parallel (layout) 1487 (defun vm-mime-display-button-multipart/parallel (layout)
1479 (vm-mime-insert-button 1488 (vm-mime-insert-button
1480 (format "%-35.35s [%s to display in parallel]" 1489 (format "%-35.35s [%s to display in parallel]"
1481 (vm-mime-layout-description layout) 1490 (vm-mime-layout-description layout)
1482 (if (vm-mouse-support-possible-p) 1491 (if (vm-mouse-support-possible-here-p)
1483 "Click mouse-2" 1492 "Click mouse-2"
1484 "Press RETURN")) 1493 "Press RETURN"))
1485 (function 1494 (function
1486 (lambda (layout) 1495 (lambda (layout)
1487 (save-excursion 1496 (save-excursion
1496 (if (vectorp layout) 1505 (if (vectorp layout)
1497 (let ((buffer-read-only nil)) 1506 (let ((buffer-read-only nil))
1498 (vm-mime-insert-button 1507 (vm-mime-insert-button
1499 (format "%-35.35s [%s to display]" 1508 (format "%-35.35s [%s to display]"
1500 (vm-mime-layout-description layout) 1509 (vm-mime-layout-description layout)
1501 (if (vm-mouse-support-possible-p) 1510 (if (vm-mouse-support-possible-here-p)
1502 "Click mouse-2" 1511 "Click mouse-2"
1503 "Press RETURN")) 1512 "Press RETURN"))
1504 (function 1513 (function
1505 (lambda (layout) 1514 (lambda (layout)
1506 (save-excursion 1515 (save-excursion
1528 (defun vm-mime-display-button-message/rfc822 (layout) 1537 (defun vm-mime-display-button-message/rfc822 (layout)
1529 (let ((buffer-read-only nil)) 1538 (let ((buffer-read-only nil))
1530 (vm-mime-insert-button 1539 (vm-mime-insert-button
1531 (format "%-35.35s [%s to display]" 1540 (format "%-35.35s [%s to display]"
1532 (vm-mime-layout-description layout) 1541 (vm-mime-layout-description layout)
1533 (if (vm-mouse-support-possible-p) 1542 (if (vm-mouse-support-possible-here-p)
1534 "Click mouse-2" 1543 "Click mouse-2"
1535 "Press RETURN")) 1544 "Press RETURN"))
1536 (function 1545 (function
1537 (lambda (layout) 1546 (lambda (layout)
1538 (save-excursion 1547 (save-excursion
1584 (vm-mime-insert-button 1593 (vm-mime-insert-button
1585 (format "%-35.35s [%s to attempt assembly]" 1594 (format "%-35.35s [%s to attempt assembly]"
1586 (concat (vm-mime-layout-description layout) 1595 (concat (vm-mime-layout-description layout)
1587 (and number (concat ", part " number)) 1596 (and number (concat ", part " number))
1588 (and number total (concat " of " total))) 1597 (and number total (concat " of " total)))
1589 (if (vm-mouse-support-possible-p) 1598 (if (vm-mouse-support-possible-here-p)
1590 "Click mouse-2" 1599 "Click mouse-2"
1591 "Press RETURN")) 1600 "Press RETURN"))
1592 (function 1601 (function
1593 (lambda (layout) 1602 (lambda (layout)
1594 (save-excursion 1603 (save-excursion
1714 (if (and vm-xemacs-p 1723 (if (and vm-xemacs-p
1715 (featurep feature) 1724 (featurep feature)
1716 (eq (device-type) 'x)) 1725 (eq (device-type) 'x))
1717 (let ((start (point)) end tempfile g e 1726 (let ((start (point)) end tempfile g e
1718 (buffer-read-only nil)) 1727 (buffer-read-only nil))
1719 (if (vm-mm-layout-cache layout) 1728 (if (setq g (cdr (assq 'vm-mime-display-internal-image-xxxx
1720 (setq g (vm-mm-layout-cache layout)) 1729 (vm-mm-layout-cache layout))))
1730 nil
1721 (vm-mime-insert-mime-body layout) 1731 (vm-mime-insert-mime-body layout)
1722 (setq end (point-marker)) 1732 (setq end (point-marker))
1723 (vm-mime-transfer-decode-region layout start end) 1733 (vm-mime-transfer-decode-region layout start end)
1724 (setq tempfile (vm-make-tempfile-name)) 1734 (setq tempfile (vm-make-tempfile-name))
1725 ;; Write an empty tempfile out to disk and set its 1735 ;; Write an empty tempfile out to disk and set its
1729 (set-file-modes tempfile 384) 1739 (set-file-modes tempfile 384)
1730 ;; coding system for presentation buffer is binary so 1740 ;; coding system for presentation buffer is binary so
1731 ;; we don't need to set it here. 1741 ;; we don't need to set it here.
1732 (write-region start end tempfile nil 0) 1742 (write-region start end tempfile nil 0)
1733 (message "Creating %s glyph..." name) 1743 (message "Creating %s glyph..." name)
1744 ;; `((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)'. This function accepts
1734 (setq g (make-glyph 1745 (setq g (make-glyph
1735 (list (vector feature ':file tempfile) 1746 (list
1736 (vector 'string 1747 (cons (list 'win)
1737 ':data 1748 (vector feature ':file tempfile))
1738 (format "[Unknown %s image encoding]\n" 1749 (cons (list 'win)
1739 name))))) 1750 (vector 'string
1751 ':data
1752 (format "[Unknown/Bsd %s image encoding]\n"
1753 name)))
1754 (cons nil
1755 (vector 'string
1756 ':data
1757 (format "[%s image]\n" name))))))
1740 (message "") 1758 (message "")
1741 (vm-set-mm-layout-cache layout g) 1759 (vm-set-mm-layout-cache
1760 layout
1761 (nconc (vm-mm-layout-cache layout)
1762 (list (cons 'vm-mime-display-internal-image-xxxx g))))
1742 (save-excursion 1763 (save-excursion
1743 (vm-select-folder-buffer) 1764 (vm-select-folder-buffer)
1744 (setq vm-folder-garbage-alist 1765 (setq vm-folder-garbage-alist
1745 (cons (cons tempfile 'delete-file) 1766 (cons (cons tempfile 'delete-file)
1746 vm-folder-garbage-alist))) 1767 vm-folder-garbage-alist)))
1772 (and (featurep 'native-sound) 1793 (and (featurep 'native-sound)
1773 (not native-sound-only-on-console) 1794 (not native-sound-only-on-console)
1774 (eq (device-type) 'x)))) 1795 (eq (device-type) 'x))))
1775 (let ((start (point)) end tempfile 1796 (let ((start (point)) end tempfile
1776 (buffer-read-only nil)) 1797 (buffer-read-only nil))
1777 (if (vm-mm-layout-cache layout) 1798 (if (setq tempfile (cdr (assq 'vm-mime-display-internal-audio/basic
1778 (setq tempfile (vm-mm-layout-cache layout)) 1799 (vm-mm-layout-cache layout))))
1800 nil
1779 (vm-mime-insert-mime-body layout) 1801 (vm-mime-insert-mime-body layout)
1780 (setq end (point-marker)) 1802 (setq end (point-marker))
1781 (vm-mime-transfer-decode-region layout start end) 1803 (vm-mime-transfer-decode-region layout start end)
1782 (setq tempfile (vm-make-tempfile-name)) 1804 (setq tempfile (vm-make-tempfile-name))
1783 ;; Write an empty tempfile out to disk and set its 1805 ;; Write an empty tempfile out to disk and set its
1786 (write-region start start tempfile nil 0) 1808 (write-region start start tempfile nil 0)
1787 (set-file-modes tempfile 384) 1809 (set-file-modes tempfile 384)
1788 ;; coding system for presentation buffer is binary, so 1810 ;; coding system for presentation buffer is binary, so
1789 ;; we don't need to set it here. 1811 ;; we don't need to set it here.
1790 (write-region start end tempfile nil 0) 1812 (write-region start end tempfile nil 0)
1791 (vm-set-mm-layout-cache layout tempfile) 1813 (vm-set-mm-layout-cache
1814 layout
1815 (nconc (vm-mm-layout-cache layout)
1816 (list (cons 'vm-mime-display-internal-audio/basic
1817 tempfile))))
1792 (save-excursion 1818 (save-excursion
1793 (vm-select-folder-buffer) 1819 (vm-select-folder-buffer)
1794 (setq vm-folder-garbage-alist 1820 (setq vm-folder-garbage-alist
1795 (cons (cons tempfile 'delete-file) 1821 (cons (cons tempfile 'delete-file)
1796 vm-folder-garbage-alist))) 1822 vm-folder-garbage-alist)))
1804 (defun vm-mime-display-button-xxxx (layout disposable) 1830 (defun vm-mime-display-button-xxxx (layout disposable)
1805 (let ((description (vm-mime-layout-description layout))) 1831 (let ((description (vm-mime-layout-description layout)))
1806 (vm-mime-insert-button 1832 (vm-mime-insert-button
1807 (format "%-35.35s [%s to attempt display]" 1833 (format "%-35.35s [%s to attempt display]"
1808 description 1834 description
1809 (if (vm-mouse-support-possible-p) "Click mouse-2" "Press RETURN")) 1835 (if (vm-mouse-support-possible-here-p)
1836 "Click mouse-2"
1837 "Press RETURN"))
1810 (function 1838 (function
1811 (lambda (layout) 1839 (lambda (layout)
1812 (save-excursion 1840 (save-excursion
1813 (let ((vm-auto-displayed-mime-content-types t)) 1841 (let ((vm-auto-displayed-mime-content-types t))
1814 (vm-decode-mime-layout layout t))))) 1842 (vm-decode-mime-layout layout t)))))
2427 (let ((case-fold-search t) 2455 (let ((case-fold-search t)
2428 (armor-from (and vm-mime-composition-armor-from-lines 2456 (armor-from (and vm-mime-composition-armor-from-lines
2429 (let ((case-fold-search nil)) 2457 (let ((case-fold-search nil))
2430 (save-excursion 2458 (save-excursion
2431 (goto-char beg) 2459 (goto-char beg)
2432 (re-search-forward "^From " nil t)))))) 2460 (re-search-forward "^From " nil t)))))
2461 (armor-dot (let ((case-fold-search nil))
2462 (save-excursion
2463 (goto-char beg)
2464 (re-search-forward "^\\.\\n" nil t)))))
2433 (cond ((string-match "^binary$" encoding) 2465 (cond ((string-match "^binary$" encoding)
2434 (vm-mime-base64-encode-region beg end crlf) 2466 (vm-mime-base64-encode-region beg end crlf)
2435 (setq encoding "base64")) 2467 (setq encoding "base64"))
2436 ((and (not armor-from) (string-match "^7bit$" encoding)) t) 2468 ((and (not armor-from) (not armor-dot)
2469 (string-match "^7bit$" encoding)) t)
2437 ((string-match "^base64$" encoding) t) 2470 ((string-match "^base64$" encoding) t)
2438 ((string-match "^quoted-printable$" encoding) t) 2471 ((string-match "^quoted-printable$" encoding) t)
2439 ((eq vm-mime-8bit-text-transfer-encoding 'quoted-printable) 2472 ((eq vm-mime-8bit-text-transfer-encoding 'quoted-printable)
2440 (vm-mime-qp-encode-region beg end nil armor-from) 2473 (vm-mime-qp-encode-region beg end nil armor-from)
2441 (setq encoding "quoted-printable")) 2474 (setq encoding "quoted-printable"))