2022-11-19

diredに「戻る」機能を追加する

diredにディレクトリを「戻る」機能が無かったので追加してみました。

前提として、私はディレクトリを開くときに元のdiredバッファをkillするように改造して使っています。遙か昔Emacsを使い始めたときに真っ先に気になったことの一つがそれ。いつの間にかEmacsがdiredバッファだらけになっていてびっくりするわけです。他のEmacsユーザのことはほとんど知りませんが、多くの人が気になって直したのではないでしょうか。今日作業中に気がついたのですが、Emacs28からはdired-kill-when-opening-new-dired-bufferというカスタマイズ変数が追加されています。まさにそれを実現するための機能が長い時を経て追加されていました。

それでなぜ今になって戻る機能が欲しくなったかというと、新しいPCでシンボリックリンクを使ったからです。私は普段HOMEディレクトリをUSERPROFILE(C:/Users/名前/)とは別の場所に設定して使っています。C:/home/名前/のように。しかしそうするとUsersとhomeの使い分けが問題になってきます。私はUsersディレクトリはほとんど無視してhomeの中だけで過ごしてきました。そもそもWindows95系にはUsersなんてディレクトリは無かったはずです。古くからのユーザにはC:/の直下に好きなようにファイルを置いている人もまだいるかもしれません。それはともかく、私の使い方ではUsersとhomeが微妙に役割が被るケースがありました。その最たる物がdownloadsディレクトリです。私はこれまでUsersの下のディレクトリは使わずにC:/home/名前/downloadsというディレクトリを作って使っていました。しかし新しいPCをセットアップするたびにC:/Users/名前/Downloadsにファイルがダウンロードされてしまうわけです。ブラウザの設定をまだ変えていないので。ブラウザの設定を変えるのにも飽き飽きしてきましたし、エクスプローラで見たときにUsersの下のDownloadsディレクトリの方がアイコンが付いていて見た目が良く操作もしやすいという利点もあったので、 mklink /d C:\home\名前\downloads C:\Users\名前\Downloads でシンボリックリンクを張ってみたというわけです。個人的にはWindowsでシンボリックリングが欲しくなることというのはほとんど無いのでちょっと新鮮な気分でした。ちなみにシンボリックリンクを作るにはデフォルトでは管理者権限が必要みたいなのですが、Windowsを開発者モード(何だそりゃ)というのにすると管理者権限が無くても大丈夫になるようです。それでEmacsのdiredからC:/home/名前/downloadsディレクトリを開いてみると、C:/Users/名前/Downloadsが開きました。おおちゃんと対応しているじゃないかと気を良くして^を押して上のディレクトリに戻ろうとするとhome側では無くUsers側で上のディレクトリに移動してしまうわけです。原因の一端は find-file-visit-truename が t になっていることにありました。これがtだと開いた段階でシンボリックリンクの名前では無く、真のファイル名で開いてしまうわけです。nilにすればC:/home/名前/downloadsというパスでdiredが開くので、^を押したときにちゃんとC:/home/名前/に戻ります。しかし私は find-file-visit-truename を t に設定した覚えがありません。変数のドキュメントを見るとOriginal valueはnilだと書かれていますし実際files.elのdefcustomはnilです。探してみると、w32-fns.elの先頭付近でWindowsであればtに変更していました。8.3やlongnameを同一のバッファで開くというようなコメントがあります。今時8.3なんてお目にかかりませんしnilにしても問題ないような気がしましたが、念のためいじらないでおこうと思います。となるとシンボリックリンクの飛び先から戻るために最後に開いていたディレクトリに「戻る」機能が必要になるというわけです。ヤレヤレ!

HelpやInfoにも l で戻る機能がありますし、同じキーで戻れるようにしておけば直感的かもしれません。 l はdired-do-redisplayですが個人的には使っていません。 g を押してしまいますし。

既にあったコードも含めて次のようになりました。

(with-eval-after-load "dired"
  ;; 戻る機能を実現する
  
  (defvar-local my-dired-dir-history nil)

  (defmacro my-dired-dir-history-push (&rest body)
    (let ((new-hist (gensym))
          (result (gensym)))
      `(let ((,new-hist (cons (dired-current-directory) my-dired-dir-history))
             (,result (progn
                        ,@body))) ;;ここで新しいバッファを開く
         (setq-local my-dired-dir-history ,new-hist) ;;新しいバッファに履歴を持たせる
         ,result)))

  (defun my-dired-dir-history-back ()
    (interactive)
    ;; 存在しないディレクトリをスキップする。
    (while (and my-dired-dir-history
                (not (file-directory-p (car my-dired-dir-history))))
      (setq my-dired-dir-history (cdr my-dired-dir-history)))
    ;; 最近のディレクトリを開く。
    (when my-dired-dir-history
      (let ((last-dir (car my-dired-dir-history))
            (new-hist (cdr my-dired-dir-history)))
        (set-buffer-modified-p nil)
        (find-alternate-file last-dir)
        (setq-local my-dired-dir-history new-hist))))

  (define-key dired-mode-map "l" #'my-dired-dir-history-back) ;;dired-do-redisplayは個人的に使っていないのと(gを使ってしまう)、helpやinfoがlで戻るのでそれに合わせる。

  ;; aで開いたときに現在のディレクトリを履歴に記録する。

  (defun my-dired-find-alternate-file-for-record-dir-history (original-fun)
    (my-dired-dir-history-push
     (funcall original-fun)))
  (advice-add #'dired-find-alternate-file
              :around
              #'my-dired-find-alternate-file-for-record-dir-history)

  ;; ;; Emacs 28以降でdired-kill-when-opening-new-dired-bufferを使って
  ;; ;; e, f, ^でディレクトリを開いた場合に対応する。
  ;; (defun my-dired--find-file-for-record-dir-history (original-fun find-file-function file &rest args)
  ;;   (if (and (eq find-file-function #'find-alternate-file)
  ;;            (file-directory-p file))
  ;;       (my-dired-dir-history-push
  ;;        (apply original-fun find-file-function file args))
  ;;     (apply original-fun find-file-function file args)))
  ;; (when (and (fboundp 'dired--find-file)
  ;;            (boundp 'dired-kill-when-opening-new-dired-buffer)
  ;;            dired-kill-when-opening-new-dired-buffer)
  ;;   (advice-add #'dired--find-file
  ;;               :around
  ;;               #'my-dired--find-file-for-record-dir-history))
  ;; ↑動作未確認。
  ;; Emacs28以降であれば下の修正をせずに上の修正をしてdired-kill-when-opening-new-dired-bufferをtにすれば良い、はず。

  ;; 元々修正していたファイルを開く処理

  (defconst my-dired-open-desktop-extensions
    '(;;"pdf" <=use pdf-tools
      "xls" "xlsx" "docx" "vsd"
      "psd"
      "wav" "mp3" "aac" "au" "ogg" "flac"
      "mp4" "avi" "mpg" "mpeg"))
  (defun my-dired-w32-open ()
    (interactive)
    (w32-shell-execute "open" (dired-get-filename)))
  (defun my-dired-find-alternate-file ()
    (interactive)
    (cond
     ;; directoryはdired-find-alternate-file(aキー相当)で開く
     ((file-directory-p (dired-get-filename))
      (dired-find-alternate-file))
     ;; 一部の拡張子はw32-shell-executeで開く
     ((member (file-name-extension (dired-get-filename)) my-dired-open-desktop-extensions)
      (my-dired-w32-open))
     ;; emacsで開く
     (t
      (dired-find-file))))

  (define-key dired-mode-map "\C-m" 'my-dired-find-alternate-file) ;;C-mやRET

  ;; 元々修正していた上ディレクトリに移動する処理
  ;; (dired-up-directoryのコードをちょっと修正した物です)

  (defun my-dired-up-directory (&optional other-window)
    "Run dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
Creates a buffer if necessary."
    (interactive "P")
    (let* ((dir (dired-current-directory))
           (up (file-name-directory (directory-file-name dir))))
      (unless (equal dir up)
        (or (dired-goto-file (directory-file-name dir))
            ;; Only try dired-goto-subdir if buffer has more than one dir.
            (and (cdr dired-subdir-alist)
                 (dired-goto-subdir up))
            (progn
              (if other-window
                  (dired-other-window up)
                ;; ここから修正
                ;; 元は(dired up)
                ;; Emacs28からは(dired--find-possibly-alternative-file up)
                (my-dired-dir-history-push
                 (set-buffer-modified-p nil)
                 (find-alternate-file up))
                ;; ここまで修正
                )
              
              (dired-goto-file dir))))))

  (define-key dired-mode-map [delete] 'my-dired-up-directory) ;;Back Space
  (define-key dired-mode-map "^" 'my-dired-up-directory) ;;^

);;with-eval-after-load "dired"

dired-kill-when-opening-new-dired-bufferを使う方法に切り替えようかなとも思いましたが、たまにEmacs27以前をテストのために立ち上げることがあるのでしばらくは使わずにいようと思います。

HOMEをUSERPROFILEと同じにしてしまうという手も考えなくも無いんですけどね。C:/Users/名前/下の乱雑さを見ると気が引けてしまいます。整理していない(アプリが勝手にいじくるママにしている)からというのもあるのでしょうけど。