octet.el

;;; octet.el --- An octet stream viewer -*- lexical-binding: nil -*-

;; Copyright (C) 2000, 2002-2005, 2010, 2014, 2016, 2017, 2019
;; Yuuichi Teranishi <teranisi@gohome.org>

;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Created: 2000/05/19
;; Keywords: octet-stream, broken document

;; 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; Display application/octet-stream inline on the emacs buffer.
;;
;; octet.el is an add-on module to SEMI package, which is designed to
;; display MIME contents generated by Microsoft Word, Excel and
;; PowerPoint encoded in application/octet-stream style.  It converts
;; them into HTML using converters like xlHtml and wvWare, and
;; displays them using emacs-w3m.  It works on several MUAs based on
;; SEMI package, like Wanderlust and Semi-Gnus.

;;; Requirements:
;;
;; + emacs-w3m
;;   + for HTML rendering
;;   + available at
;;     + MELPA
;;     + http://emacs-w3m.namazu.org/
;;     + https://github.com/emacs-w3m/emacs-w3m
;; + APEL
;;   + for character encoding portability
;;   + available at
;;     + MELPA
;;     + http://git.chise.org/elisp/apel/.
;; + FLIM
;;   + utilities for message representation and encoding
;;   + available at
;;     + MELPA
;;     + http://git.chise.org/elisp/flim/.
;; + SEMI
;;   + for mime utilities
;;   + available at
;;     + MELPA
;;     + http://git.chise.org/elisp/semi/.
;; + wvHtml
;;   + for MS Word documents
;;   + available at
;;     + MELPA
;;     + http://www.wvware.com/
;; + xlHtml
;;   + for MS Excel documents
;;   + available at
;;     + MELPA
;;     + http://chicago.sourceforge.net/xlhtml/
;; + pptHtml
;;   + for MS PowerPoint documents
;;   + available at
;;     + MELPA
;;     + http://chicago.sourceforge.net/xlhtml/
;; + gunzip
;;   + for decoding gzipped files
;; + bunzip2
;;   + for decoding bzip2ed files
;;

;;; Installation:
;;
;; Put follwing line in your setting file:
;;
;;   (require 'octet)
;;
;; If you use SEMI, you can also put following lines in your setting
;; file, in order to be able to toggle displaying
;; application/octet-stream messages.:
;;
;;   (octet-mime-setup)
;;

;;; Usage:
;;
;; To display an octet data file, execute following command:
;;
;;   M-x octet-find-file
;;

;;; History:
;;
;; + This file was created in 2000/05/19.
;; + All parts were rewritten in 2002/01/28.
;; + Added to emacs-w3m repository in 2002/01/29.
;; + Further details and subsequent changes are documented in the
;;   emacs-w3m Changelog file, and in git.

;;; Code:

(require 'poe)     ; for compatibility (from emacs package 'apel)
(require 'pces)    ; as-binary-process (from emacs package 'apel)
(require 'mime)    ; SEMI
(require 'w3m-util); w3m-insert-string

(defvar octet-temp-directory temporary-file-directory
  "A directory to create temporary files.")

(defvar octet-html-render-function 'octet-w3m-region
  "A function for HTML rendering.")

(defvar octet-suffix-type-alist
  '(("xls"  . msexcel)
    ("ppt"  . msppt)
    ("doc"  . msword)
    ("gz"   . gzip)
    ("bz2"  . bzip2)
    ("html" . html)
    ("jpg"  . jpeg)
    ("jpeg" . jpeg)
    ("gif"  . gif)
    ("png"  . png)
    ("tif"  . tiff)
    ("tiff" . tiff)
    ("txt"  . text)
    ("lzh"  . lzh)
    ("tar"  . tar)
    ("pdf"  . pdf))
  "Alist of suffix-to-octet-type.")

(defvar octet-content-type-alist
  '(("application/vnd\\.ms-excel"	. msexcel)
    ("application/vnd\\.ms-powerpoint"	. msppt)
    ("application/x-msexcel"		. msexcel)
    ("application/msword"		. msword)
    ("image/jpeg"			. jpeg)
    ("image/gif"			. gif)
    ("image/png"			. png)
    ("image/tiff"			. tiff)
    ("audio/midi"			. ignore)
    ("video/mpeg"			. ignore)
    ("text/html"			. html-un)
    ("application/x-tar"		. tar)
    ("application/pdf"			. pdf))
  "Alist of content-type-regexp-to-octet-type.")

(defvar octet-magic-type-alist
  '(("^\377\330\377[\340\356]..JFIF"	image jpeg)
    ("^\211PNG"				image png)
    ("^GIF8[79]"			image gif)
    ("^II\\*\000"			image tiff)
    ("^MM\000\\*"			image tiff)
    ("^MThd"				audio midi)
    ("^\000\000\001\263"		video mpeg)
    ("^<!doctype html"			text  html)
    ("^<head"				text  html)
    ("^<title"				text  html)
    ("^<html"				text  html))
  "*Alist of regexp about magic-number vs. corresponding content-types.
Each element looks like (REGEXP TYPE SUBTYPE).
REGEXP is a regular expression to match against the beginning of the
content of entity.
TYPE is symbol to indicate primary type of content-type.
SUBTYPE is symbol to indicate subtype of content-type.")

(defvar octet-type-filter-alist
  `((msexcel octet-filter-call1	      "xlhtml" ("-te")	html-u8)
    (msppt   octet-filter-call1	      "ppthtml" nil	html-u8)
    (msword  octet-filter-call2-extra "wvHtml"	nil	html-u8)
    (html    octet-render-html	      nil	nil	nil)
    (html-u8 octet-decode-u8-text     nil	nil	html)
    (html-un octet-decode-text	      nil	nil	html)
    (gzip    octet-filter-call1	      "gunzip"	("-c")	guess)
    (bzip2   octet-filter-call1	      "bunzip2"	("-c")	guess)
    (text    octet-decode-text	      nil	nil	nil)
    (ignore  ignore		      nil	nil	nil)
    (jpeg    octet-decode-image	      nil	jpeg	nil)
    (gif     octet-decode-image	      nil	gif	nil)
    (png     octet-decode-image	      nil	png	nil)
    (tiff    octet-decode-image	      nil	tiff	nil)
    (guess   octet-filter-guess	      nil	nil	nil)
    (lzh     octet-filter-call1	      "lha"	("-v")	text)
    (tar     octet-tar-mode	      nil	nil	nil)
    (pdf     octet-filter-call2	     "pdftotext" ("-q" "-eucjp" "-raw") text))
  "Alist of type-to-filter-program.
Each element should have the form like:
(TYPE FUNCTION FILTER_PROGRAM ARGUMENT NEW-TYPE)
nil in NEW-TYPE means filtering is completed.")

(defvar octet-find-file-hook nil)

(defvar octet-attachments nil)
(make-variable-buffer-local 'octet-attachments)

(defun octet-render-html (&rest args)
  (funcall octet-html-render-function (point-min) (point-max))
  0)

(defun octet-decode-text (&rest args)
  (let ((string (buffer-string)))
    (erase-buffer)
    (set-buffer-multibyte t)
    (insert (decode-coding-string string 'undecided)))
  0)

;;; HTML rendering by w3m.el
(defun w3m-about-octet-attachments (url &optional no-decode no-cache
					&rest args)
  (let (buffer attachments pair)
    (set-buffer-multibyte nil)
    (when (string-match "\\`about://octet-attachments/\\([^/]+\\)/" url)
      (setq buffer (get-buffer (decode-coding-string
				(base64-decode-string (match-string 1 url))
				'utf-8))
	    url (substring url (match-end 0))
	    attachments (with-current-buffer buffer
			  octet-attachments))
      (when (and buffer attachments
		 (setq pair (assoc url attachments)))
	(insert (cdr pair)))))
  (car (funcall (symbol-function 'w3m-local-file-type) url)))

(defun octet-w3m-region (beg end)
  (let ((w3m-display-inline-images t)
	(w3m-url-hierarchical-schemes '("about")))
    (funcall (symbol-function 'w3m-region)
	     beg end (concat "about://octet-attachments/"
			     (base64-encode-string
			      (encode-coding-string (buffer-name) 'utf-8))
			     "/"))
    (setq octet-attachments nil))
  0)

;; Decode image
(defun octet-decode-image (ignore &rest args)
  (let (image)
    (if (image-type-available-p (car args))
	(progn
	  (setq image (create-image (buffer-string) (car args) 'data))
	  (if image
	      (progn (erase-buffer)
		     (insert-image image) 0)
	    1))
      1)))

(defun octet-decode-u8-text (&rest args)
  (let ((string (buffer-string)))
    (erase-buffer)
    (set-buffer-multibyte t)
    (insert (decode-coding-string string 'utf-8)))
  0)

(defun octet-filter-call2 (filter &optional args)
  "Call octed filter with two arguments (infile, outfile).
Current buffer content is replaced.
Returns 0 if succeed."
  (let ((infile (file-name-nondirectory
		 (make-temp-file (expand-file-name "octet"
						   octet-temp-directory))))
	(outfile (file-name-nondirectory
		  (make-temp-file (expand-file-name "octet"
						    octet-temp-directory))))
	(last-dir default-directory)
	result)
    (cd octet-temp-directory)
    (write-region-as-binary (point-min) (point-max) infile nil 'no-msg)
    (unwind-protect
	(progn
	  (as-binary-process
	   (setq result (apply 'call-process filter nil nil nil
			       (append args (list infile outfile)))))
	  (when (and (numberp result)
		     (zerop result))
	    (erase-buffer)
	    (insert-file-contents-as-binary outfile))
	  0)
      (if (file-exists-p infile) (delete-file infile))
      (if (file-exists-p outfile) (delete-file outfile))
      (cd last-dir))))

(defun octet-filter-call2-extra (filter &optional args)
  "Call octed filter with two arguments (infile, outfile).
Current buffer content is replaced.
Also, exta attachments are collected to `octet-attachments'.
Returns 0 if succeed."
  (let ((infile (file-name-nondirectory
		 (make-temp-file (expand-file-name "octet"
						   octet-temp-directory))))
	(outfile (file-name-nondirectory
		  (make-temp-file (expand-file-name "octet"
						    octet-temp-directory))))
	(last-dir default-directory)
	result)
    (cd octet-temp-directory)
    (write-region-as-binary (point-min) (point-max) infile nil 'no-msg)
    (unwind-protect
	(progn
	  (as-binary-process
	   (setq result (apply 'call-process filter nil nil nil
			       (append args (list infile outfile)))))
	  (when (and (numberp result)
		     (zerop result))
	    (erase-buffer)
	    (insert-file-contents-as-binary outfile)
	    (dolist (attach (directory-files "." nil (concat
						      (regexp-quote outfile)
						      ".*\\..*")))
	      (setq octet-attachments
		    (cons (cons
			   attach
			   (with-temp-buffer
			     (insert-file-contents-as-binary attach)
			     (buffer-string)))
			  octet-attachments))
	      (if (file-exists-p attach) (delete-file attach))
	      ))
	  0)
      (if (file-exists-p infile) (delete-file infile))
      (if (file-exists-p outfile) (delete-file outfile))
      (cd last-dir))))

(defun octet-filter-call1 (filter &optional args)
  "Call external octed filter with two arguments (infile) and obtain stdout.
Current buffer content is replaced.
Returns 0 if succeed."
  (let ((infile (file-name-nondirectory
		 (make-temp-file (expand-file-name "octet"
						   octet-temp-directory))))
	(last-dir default-directory)
	result)
    (cd octet-temp-directory)
    (write-region-as-binary (point-min) (point-max) infile nil 'no-msg)
    (unwind-protect
	(progn
	  (erase-buffer)
	  (as-binary-process
	   (setq result (apply 'call-process filter nil t nil
			       (append args (list infile)))))
	  (if (numberp result) result 1))
      (if (file-exists-p infile) (delete-file infile))
      (cd last-dir))))

(defun octet-filter-guess (&rest args)
  (let (buffer-file-name)
    (octet-buffer)
    0))

(defun octet-tar-mode (&rest args)
  (funcall (symbol-function 'tar-mode))
  0)

(defun octet-guess-type-from-name (name)
  (when (string-match "\\.\\([a-z0-9]+\\)\\'" name)
    (cdr (assoc (downcase (match-string 1 name))
		octet-suffix-type-alist))))

(defun octet-guess-type-from-content-type (content-type)
  (let ((alist octet-content-type-alist)
	type)
    (while alist
      (when (string-match (car (car alist)) content-type)
	(setq type (cdr (car alist))
	      alist nil))
      (setq alist (cdr alist)))
    type))

(defun octet-guess-type-from-magic ()
  (let ((rest octet-magic-type-alist)
	type subtype)
    (goto-char (point-min))
    (while (not (let ((cell (car rest)))
		  (if cell
		      (if (looking-at (car cell))
			  (setq type (nth 1 cell)
				subtype (nth 2 cell)))
		    t)))
      (setq rest (cdr rest)))
    (if type
	(octet-guess-type-from-content-type
	 (concat (symbol-name type) "/" (symbol-name subtype))))))

(defun octet-filter-buffer (type)
  "Call a filter function in `octet-type-filter-alist'.
TYPE is the symbol of type.
Returns NEW-TYPE."
  (let ((elem (assq type octet-type-filter-alist)))
    (if (zerop (apply (nth 1 elem) (list (nth 2 elem) (nth 3 elem))))
	(nth 4 elem))))

;;;###autoload
(defun octet-buffer (&optional name content-type)
  "View octet-stream content according to `octet-type-filter-alist'.
Optional NAME is the filename.
If optional CONTENT-TYPE is specified, it is used for type guess."
  (interactive)
  (let ((type (or (and content-type
		       (octet-guess-type-from-content-type
			content-type))
		  (octet-guess-type-from-magic)
		  (and (or name buffer-file-name)
		       (octet-guess-type-from-name
			(or name buffer-file-name)))
		  (intern (condition-case nil
			      (completing-read "Octet Type(text): "
					       (mapcar
						(lambda (pair)
						  (list (symbol-name
							 (cdr pair))))
						octet-suffix-type-alist)
					       nil 'require-match nil nil
					       "text")
			    (quit "text"))))))
    (while (setq type (octet-filter-buffer type)))))

;;;###autoload
(defun octet-find-file (file)
  "Find FILE with octet-stream decoding."
  (interactive "fFilename: ")
  (as-binary-input-file	(find-file file))
  (unwind-protect
      (let ((inhibit-read-only t))
	(octet-buffer))
    (goto-char (point-min))
    (set-buffer-modified-p nil)
    (auto-save-mode -1)
    (setq buffer-read-only t
	  truncate-lines t)
    (run-hooks 'octet-find-file-hook)))

;;;
;; Functions for SEMI.
;;

(defvar mime-preview-octet-hook nil)
(defvar mime-view-octet-hook nil)

;;;###autoload
(defun mime-preview-octet (entity situation)
  "A method for mime-view to preview octet message."
  (goto-char (point-max))
  (let ((p (point))
	(name (mime-entity-filename entity))
	from-buf to-buf)
    (insert "\n")
    (goto-char p)
    (save-restriction
      (narrow-to-region p p)
      (setq to-buf (current-buffer))
      (with-temp-buffer
	(setq from-buf (current-buffer))
	(w3m-insert-string (mime-entity-content entity))
	(octet-buffer name (mime-entity-type/subtype entity))
	(with-current-buffer to-buf
	  (insert-buffer-substring from-buf)
	  (run-hooks 'mime-preview-octet-hook))))))

;;;###autoload
(defun mime-view-octet (entity situation)
  "A method for mime-view to display octet message."
  (let (type subtype)
    (let ((mdata (mime-entity-content entity))
	  (rest octet-magic-type-alist))
      (while (not (let ((cell (car rest)))
		    (if cell
			(if (string-match (car cell) mdata)
			    (setq type (nth 1 cell)
				  subtype (nth 2 cell)))
		      t)))
	(setq rest (cdr rest)))
      (if type
	  (progn
	    (setq situation (del-alist 'method (copy-alist situation)))
	    (funcall (symbol-function 'mime-play-entity)
		     entity
		     (put-alist 'type type
				(put-alist 'subtype subtype
					   situation))
		     'mime-view-octet))
	(let ((buf (get-buffer-create
		    (format "%s-%s" (buffer-name) (mime-entity-number entity))))
	      (name (mime-entity-filename entity)))
	  (with-current-buffer buf
	    (set-buffer-multibyte nil)
	    (setq buffer-read-only nil)
	    (erase-buffer)
	    (w3m-insert-string mdata)
	    (octet-buffer name (mime-entity-type/subtype entity))
	    (setq buffer-read-only t
		  truncate-lines t)
	    (set-buffer-multibyte t)
	    (set-buffer-modified-p nil))
	  (let ((win (get-buffer-window (current-buffer))))
	    (or (eq (selected-window) win)
		(select-window (or win (get-largest-window)))))
	  (view-buffer buf)
	  (run-hooks 'mime-view-octet-hook)
	  (goto-char (point-min)))))))

(declare-function ctree-set-calist-strictly "calist" (ctree-var calist))

;;;###autoload
(defun octet-mime-setup ()
  "Octet setting for MIME module."
  (eval-after-load "mime-view"
    '(progn
       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . msword)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . excel)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . x-msexcel)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . vnd.ms-excel)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . vnd.ms-powerpoint)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-acting-condition
	'((mode . "play")
	  (type . application)(subtype . octet-stream)
	  (method . mime-view-octet)))

       (ctree-set-calist-strictly
	'mime-preview-condition
	'((type . application)(subtype . t)
	  (encoding . t)
	  (body . invisible)
	  (body-presentation-method . mime-preview-octet)))
       ;; another condition?
       )))

(provide 'octet)

;;; octet.el ends here