dired-win-exec.el

;;; dired-win-exec.el --- Windows Program Exec for Dired.  -*- lexical-binding: t; -*-

;; Copyright (C) 2016, 2017, 2018 fubuki

;; Author: fubuki@*****.org
;; Keywords: tools

;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Dired will be the Windows launcher.
;; Start up the Windows application set by the extension.
;; Multiple startup programs can be set and it becomes selection input with prefix start.

;;; Installation:

;; (require 'dired-win-exec)
;; (add-hook 'dired-mode-hook
;;           #'(lambda() (local-set-key [remap dired-find-file] 'dired-win-exec)))

;; Specify the character string of the start program to be associated
;; with the extension in the variable `dired-win-exec-list' as a LIST.

;; (("Extension" "program") ...)

;; Multiple specifications can be specified by setting both "extension" and "program" to LIST.

;;; Code:

(require 'dired)

(defgroup dired-win-exec nil
  "Dired win exec."
  :group 'dired)

(defcustom dired-win-exec-list
  '((("jpg" "gif" "bmp" "pdf") dired-win-exec-open)
    (("html" "htm") (find-file dired-win-exec-open))
    ("svg" (dired-win-exec-open "C:/Program Files/Inkscape/inkscape.exe"))
    ("rtf"
     ("C:/Program Files/Windows NT/Accessories/wordpad.exe"
      "C:/Program Files/Microsoft Office 15/root/office15/WINWORD.EXE"))
    ("doc" "C:/Program Files/Microsoft Office 15/root/office15/WINWORD.EXE")
    (("xlsm" "xls" "xlsx")
     "C:/Program Files/Microsoft Office 15/root/office15/EXCEL.EXE")
    ("xcf" "C:/Program Files/GIMP 2/bin/gimp-2.8.exe")
    ("png"
     ("C:/Program Files/IrfanView/i_view32.exe"
      "C:/Program Files/GIMP 2/bin/gimp-2.8.exe")))
  "dired win execute association list."
  :type '(repeat
          (list (choice (string :tag "Extention")
                        (repeat :tag "Extention list" string ))
                (choice (file     :tag "Program")
                        (function :tag "Function")
                        (repeat :tag "Program or Function list"
                                (choice
                                 (file     :tag "Program")
                                 (function :tag "Function"))))))
  :group 'dired-win-exec)

(defcustom dired-win-exec-default 'find-file
  "`dired-win-exec' Default command or functuon."
  :type '(choice function file)
  :group 'dired-win-exec)

(defcustom dired-win-exec-select nil
  "Always select input with NON-NIL."
  :type  'boolean
  :group 'dired-win-exec)

(defcustom dired-win-exec-coding-system '(undecided . sjis)
  "for process coding system."
  :type  '(choice (cons coding-system coding-system)
                  (coding-system))
  :group 'dired-win-exec)

(defcustom dired-win-exec-exit-flag t
  "dired-win-exec `set-process-query-on-exit-flag' function flag."
  :type 'boolean
  :group 'dired-win-exec)

(defcustom dired-win-exec-message 'echo
  "If `NIL', there is no message. `echo' message only.
Other message and message buffer also recorded."
  :type  '(choice boolean (const echo))
  :group 'dired-win-exec)

(defun dired-win-exec-message (&rest args)
  (let ((message-log-max message-log-max))
    (if (eq dired-win-exec-message nil)
        nil
      (if (eq dired-win-exec-message 'echo)
          (setq message-log-max nil))
      (apply 'message args))))
  
(defmacro with-process-coding-system (code &rest body)
  "Coding system for file name."
  (declare (indent 1))
  `(let ((default-process-coding-system ,code))
     ,@body))

(defun dired-win-exec-open (file)
  (with-process-coding-system dired-win-exec-coding-system
    (dired-win-exec-message "exec: %s" file)
    (w32-shell-execute "open" file)))

(defun dired-win-exec-file-name-nondirectory (name)
  (if (functionp name)
      (symbol-name name)
    (file-name-nondirectory name)))

(defun dired-win-exec-make-assoc-list (list)
  "Generate association list for supplement from program LIST."
  (and list (cons (cons (dired-win-exec-file-name-nondirectory (car list)) (car list))
                  (dired-win-exec-make-assoc-list (cdr list)))))

(defun dired-win-exec-match (ext exec-list &optional prefix)
  "Execute the file that matches EXT from EXEC-LIST.
Select input with PREFIX option."
  (let (exec)
    (if (null ext)
        nil
      (dolist (an exec-list)
        (if (consp (car an))
            (and (member-ignore-case ext (car an)) (setq exec (cadr an)))
          (and (equal (upcase ext) (upcase (car an))) (setq exec (cadr an))))
        (and exec
             (return
              (if (consp exec)
                  (if (not prefix)
                      (car exec)
                    (let* ((alist (dired-win-exec-make-assoc-list exec))
                           (exec (completing-read "Program: " alist)))
                      (cdr (assoc exec alist))))
                exec)))))))

(defun dired-win-exec (&optional file prefix)
  "Run MS-windows program FILE from dired."
  (interactive
   (list (dired-get-filename)
         (or dired-win-exec-select current-prefix-arg)))
  (let* ((exec (dired-win-exec-match (file-name-extension file) dired-win-exec-list prefix))
	 (buff "*Win exec*"))

    (cond
     ((null exec)
      (funcall dired-win-exec-default file))

     ((functionp exec)
      (funcall exec file))

     (t
      (with-process-coding-system dired-win-exec-coding-system
        (dired-win-exec-message "exec: %s" file)
        (set-process-query-on-exit-flag
         (start-process
          buff buff exec
          (replace-regexp-in-string "/" "\\\\" (expand-file-name file)))
         dired-win-exec-exit-flag))))))

(provide 'dired-win-exec)
;; Fin.