EmacsのDiredで起動するアプリケーションの関連付け(advice-addが使える環境のみ)

advice-addで比較的簡単に設定できるので参考までに公開。
diredの一覧で[ENTER]キーを押すとアプリケーション起動。
関連付け対象外のファイルは通常通り。
コードは以下の通り。本体はdired-open-file-by-app。
※case-fnはユーティリティ。
※2024/6/5: ファイル名に～などが入っているとエラーになる場合の対処(encode-coding-string)を入れました。
※2024/6/6: EXEファイルの起動部分の不具合修正。

(defmacro case-fn (expr fn &rest clauses)
  "Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...).  EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
If no clause succeeds, cl-case returns nil.  A single atom may be used in
place of a KEYLIST of one atom.  A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `fn'.

example 1: following :-> message/returns \"matched 2\"

(case-fn 2 (lambda (x y) (equal x y))
	 (1 (message \"matched 1\"))
	 (2 (message \"matched 2\"))
	 (t (message \"matched t\")))

example 2: following :-> message/returns \"matched 1\"

(case-fn 2 (lambda (x y) (% x y))
	 (1 (message \"matched 1\"))
	 (2 (message \"matched 2\"))
	 (t (message \"matched t\")))

\n(fn EXPR fn (KEYLIST BODY...)...)"
  (declare (indent 1) (debug (form &rest (sexp body))))
  (macroexp-let2 macroexp-copyable-p temp expr
    (let* ((head-list nil))
      `(cond
        ,@(mapcar
           (lambda (c)
             (cons (cond ((memq (car c) '(t otherwise)) t)
                         ((eq (car c) 'cl--ecase-error-flag)
                          `(error "cl-ecase failed: %s, %s"
                                  ,temp ',(reverse head-list)))
                         ((listp (car c))
                          (setf head-list (append (car c) head-list))
                          `(cl-member ,temp ',(car c) :test ,fn))
                         (t
                          (if (memq (car c) head-list)
                              (error "Duplicate key in case: %s"
                                     (car c)))
                          (push (car c) head-list)
                          `(funcall ,fn ,temp ,(car c))))
                   (or (cdr c) '(nil))))
           clauses)))))


(defun dired-find-file-by-app (oldfunc &rest args)
  (let ((orgfname (dired-get-filename))
        (fname)
        (bsfname))
    (setf bsfname (replace-regexp-in-string "/" "\\\\" orgfname))
    (setf fname   (encode-coding-string orgfname 'cp932))
    (setf bsfname (encode-coding-string bsfname 'cp932))
    (case-fn fname (lambda (y x) (string-match x y))
             ("\\.ts$"     (make-process :name "vlc"        :command (list "C:/Program Files/VideoLAN/VLC/vlc.exe" bsfname)))
             ("\\.mp4$"    (make-process :name "mpc"        :command (list "c:/Program Files/MPC-HC/mpc-hc64.exe" fname)))
             ("\\.dcv$"    (make-process :name "DMMPlayer2" :command (list "C:/Users/yuuic/AppData/Local/Programs/DMM Player v2/DMM Player v2.exe" fname)))
             ("\\.xls.*$"  (make-process :name "EXCEL"      :command (list "C:/Program Files/Microsoft Office/root/Office16/EXCEL.EXE" "/n" fname)))
             ("\\.doc.*$"  (make-process :name "WORD"       :command (list "C:/Program Files/Microsoft Office/root/Office16/WINWORD.EXE" fname)))
             ("\\.exe$"    (make-process :name "EXE"        :command (list orgfname)))
             (t            (apply oldfunc args)))))

(advice-add 'dired-find-file :around 'dired-open-file-by-app)