「Windows ショートカットを dired と連携して使うための設定」の編集履歴（バックアップ）一覧はこちら
追加された行は緑色になります。
削除された行は赤色になります。
&bold(){■ Windows版 Emacs 共通の設定}
&bold(){■ Windows Subsystem for Linux の Emacs で利用できる設定}
----
&bold(){【お知らせ】}
----
&bold(){＜2020/02/06 追記＞}
本設定により dired で表示するようにしたショートカットファイルは、リンク元のファイル名（“->”の左側のファイル名）であれば wdired の機能で直接編集可能です。ただし、リンク先（“->”の右側のファイル名）のファイル名を編集すると、不正な動作（恐らく、シンボリックリンクに作り直そうとしてエラーとなり、ショートカットファイルが消える）となりますのでご注意ください。
&bold(){＜2019/06/24 追記＞}
w32-symlinks-parse-shortcut 関数の中に定義されている文字列内に"\ "が含まれていたが、これは空（NULL）であることが分かったので削除しました。機能に変更はありません。
&bold(){＜2019/05/13 追記＞}
4) の見直しにより、次の設定で Windows ショートカットを作成した際、g で dired の再表示を行わなくともリンク先の表示が行われるようになりました。
・[[WSL で NTFS シンボリックリンクや Windows ショートカットを作成するための設定]]
&bold(){＜2018/06/27 追記＞}
こちらの情報を参考としています。ありがとうございます。
・http://d.hatena.ne.jp/holidays-l/20110610/p1
&bold(){＜2018/06/21 追記＞}
Emacs-26系では、default- で始まる変数が廃止されたため、本設定が正常に動作しなくなりました。その対策を行いました。
&bold(){<2018/01/11 追記>}
Cygwin版 Emacs では、Emacs の機能でシンボリックリンクの作成や修正ができます。CYGWIN の設定内容により次のような動きとなります。
・CYGWIN=winsymlinks:lnk で Emacs を起動した場合： Emacs で作成したシンボリックリンクは Windows ショートカットとして作成される。（Cygwin 上ではシンボリックリンクと認識される特別な Windows ショートカットが作成されるため、ファイル名に付く .lnk は表示されない。）
・CYGWIN=winsymlinks:nativestrict で Emacs を起動した場合： Emacs で作成したシンボリックリンクは NTFS シンボリックリンクとして作成される。（NTFS シンボリックリンクの作成に管理者権限を不要とするためには、次の追記の 2) の条件を満たす必要があります。）
&bold(){<2018/01/11 追記>}
Windows 10 1709 を使ってみて、以下を確認しています。
1) WSL では、DrvFs 上で NTFS シンボリックリンクが参照可能となっている。
2) NTFS シンボリックリンクを管理者権限なしで作成するには、以下のどちらかの対応を行う必要がある。
・開発モードにする
https://www.ipentec.com/document/document.aspx?page=windows-windows-10-set-developer-mode
※ 具体的には、シンボリックリンクを作成するプログラムから呼ばれる CreateSymbolicLink 関数が、dwFlags の SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE フラグを立てた状態で実行される必要があります。Windows の mklink や Cygwin は対応されているようですが、MinGW（MSYS2）は未対応のようです。
・SeCreateSymbolicLinkPrivilege 権限を付加する（再ログインが必要）
https://qiita.com/ucho/items/c5ea0beb8acf2f1e4772#comment-250af72ab706bd611549
※ Cygwin を使っている場合は、Cygwin のコンソールを管理権限で開き、次のコマンドを実行してください。（「[[Cygwin で sudo 的コマンドを使うための設定]]」で紹介している sudo を使って管理権限を与える方法もあります。）上記のリンクのコメントにある MSYS2 での利用方法を参考としています。
$ editrights -u $USER -l
$ editrights -u $USER -a SeCreateSymbolicLinkPrivilege
administrators のメンバーは UAC により特権が削除されるという次のような情報もあるのですが、なぜか私の環境では発生していません。
https://qiita.com/azechi/items/f9a97393cb41be4be437
&bold(){<2017/07/22 追記>}
Windows 10 1703 では、開発モードとしていれば管理者権限なしでシンボリックリンクが作成できるようになりました。
・http://forest.watch.impress.co.jp/docs/news/1033597.html
最近の Cygwin でも対応済みとなっており、次の設定をすることにより利用することができます。
export CYGWIN="winsymlinks:nativestrict"
お試しください。（ただし、Windows 10 1703 の Windows Subsystem for Linux では NTFS シンボリックリンクを参照できません。）
&bold(){<2017/06/21 追記>}
本設定は、Windows Subsystem for Linux 上で動作している Emacs から Windows ファイルシステムを参照する場合にも利用可能です。次の設定と組み合わせてご利用ください。（21番は必須の設定です。）
・[[WSL で Emacs を使うための設定]]
&bold(){<2017/05/01 追記>}
本設定は、VirtualBox 上の Linux 上で動作している Emacs から Windows ファイルシステムを参照する場合にも利用可能です。次の設定（最低、4番までの設定が必要）と組み合わせてご利用ください。
・[[VirtualBox 上の Ubuntu から WSL を経由して Windows 環境にアクセスするための設定（戦略３）]]
※ NTFS シンボリックリンクも辿りたい場合は、全ての設定が必要です。
&bold(){<2017/04/12 追記>}
ショートカットファイルの仕様の資料が次のページにあります。
・https://storage.googleapis.com/google-code-archive-downloads/v2/code.google.com/8bits/The_Windows_Shortcut_File_Format.pdf
&bold(){<2015/05/16 追記>}
gnupack-12.00 以降の Cygwin版 Emacs では、Cygwin の ln -s で作成したショートカットをシンボリックリンクとして認識してくれます。
（CYGWIN 環境変数がデフォルト設定である winsymlinks:lnk となっている場合です。Windows で作ったショートカットはシンボリックリンクとしては認識してくれません。）
・https://cygwin.com/cygwin-ug-net/using-cygwinenv.html
if set to just winsymlinks or winsymlinks:lnk, Cygwin creates symlinks &bold(){as Windows shortcuts with a special header} and the R/O attribute set.
&bold(){【本題】}
----
・【重要】Cygwin版 Emacs を使っている場合は、最初に「[[Windowsパス と UNCパス を使えるようにするための設定]]」を行ってください。
・【重要】Windows Subsystem for Linux で Emacs を使っている場合は、最初に「[[Windowsパス と UNCパス を使えるようにするための設定（WSL 設定編）]]」を行ってください。
Windows ショートカットを dired と連携して使うための設定です。「[[w32-symlinks を dired と連携して使うための設定]]」をベースに、Emacs への影響が最小限となるように見直しをしたものです。Emacs の Magic File Names を使った機能を削除し、シンプルな実装にしています。Windows系の Emacs で利用できる他、Windows Subsystem for Linux でも利用可能です。
1) w32-symlinks.el から最低限必要な以下の設定を抽出し、有効とする。（ライセンスは w32-symlinks.el に従ってください。一部、抽出元の設定から変更している箇所（by smzht のコメントがある行）があります。）
・http://www.emacswiki.org/emacs/w32-symlinks.el （抽出元）
;;; w32-symlinks.el --- MS Windows symbolic link (shortcut) support
;; Copyright (C) 2002, 2003 Francis J. Wright, 2005 Lars Hansen
;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk>
;; Last-Updated: 22-11-2005 18:00 UTC
;; By: Lars Hansen <larsh at soem dot dk>
;; URL: http://www.emacswiki.org/emacs/w32-symlinks.el
;; Keywords: convenience, files, unix
;; This file is not part of GNU Emacs.
;; w32-symlinks 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.
;; w32-symlinks 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.
(defun w32-symlinks-parse-symlink (file-name)
"Optionally parse FILE-NAME as a MS Windows symlink file, if possible."
(condition-case nil
(and (string-match "\\.lnk\\'" file-name)
(w32-symlinks-parse-shortcut file-name))
(error nil)))
(defun w32-symlinks-buffer-substring-as-int (start length)
"Return contents of part of the current buffer as an unsigned integer.
START is a character position\; LENGTH specifies the length of the
integer in bytes and should be 1, 2 or 4.
Assumes byte order is low to high (little-endian)."
(let ((idx (+ start length))
(int 0))
;; Base (radix) using unsigned char digits is 2^8 = 256.
(while (>= (setq idx (1- idx)) start)
(setq int (+ (* 256 int) (char-after idx))))
int))
(defun w32-symlinks-parse-shortcut (file)
"Return file or directory referenced by MS Windows shortcut (.lnk) FILE.
Return nil if the file cannot be parsed."
;; Based on "The Windows Shortcut File Format" as
;; reverse-engineered by Jesse Hager <jessehager at iname.com>
;; available from http://www.wotsit.org/download.asp?f=shortcut.
(with-temp-buffer
(set-buffer-multibyte nil) ; added by smzht
(let ((inhibit-file-name-handlers
(cons 'w32-symlinks-file-name-handler
(and (eq inhibit-file-name-operation 'insert-file-contents)
inhibit-file-name-handlers))))
(insert-file-contents-literally file)) ; Eli Zaretskii
(and
;; Parse the File Header Table.
;; Check for Shell Link identifier (4 bytes)
;; followed by Shell Link GUID (16 bytes):
(string= (buffer-substring 1 21) ; otherwise not a shortcut file
"L\0\0\0\x01\x14\x02\0\0\0\0\0\xC0\0\0\0\0\0\0\x46")
;; Get the main flags dword at offset 14h.
(let ((flags (w32-symlinks-buffer-substring-as-int (+ (point) ?\x14) 4))
target)
;; Skip to end of Header:
(forward-char ?\x4C)
(if (= (logand flags 1) 1)
;; Flag 0 (2^0=1) set means Shell Item Id List present, so
;; skip it. The list length is the first word, which must
;; also be skipped:
(forward-char
(+ 2 (w32-symlinks-buffer-substring-as-int (point) 2))))
(if (= (logand flags 2) 2)
;; Flag 1 (2^1=2) set means File Location Info Table
;; present, so parse it.
(progn
;; The full file pathname is (generally) stored in two
;; pieces: a head depending on whether the file is on a
;; local or network volume and a remaining pathname tail.
;; Get and check the volume flags dword at offset 8h:
(setq flags (w32-symlinks-buffer-substring-as-int
(+ (point) ?\x8) 4))
(if (/= (logand flags 3) 0) ; Must have bit 0 or 1 set.
(let ((head ; Get local or network
(save-excursion ; pathname head.
;; If bit 0 then local else network:
(if (setq flags (= (logand flags 1) 1))
;; Go to the base pathname on the local
;; system at the offset specified as a
;; dword at offset 10h:
(forward-char
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x10) 4))
;; Go to the network volume table at the
;; offset specified as a dword at offset 14h:
(forward-char
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x14) 4))
;; Go to the network share name at offset 14h:
(forward-char ?\x14))
(buffer-substring (point)
(1- (search-forward "\0")))))
(tail ; Get the remaining pathname tail
(progn ; specified as a dword at
(forward-char ; offset 18h.
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x18) 4))
(buffer-substring (point)
(1- (search-forward "\0"))))))
(setq target
;; Network share name needs trailing \ added:
(concat head
(unless (or flags (string= tail "")) "\\")
tail)))))
;; Otherwise, continue parsing...
;; NB: Shortcuts generated using WSH seem to use Unicode.
;; May be flag bit 7 indicates use of Unicode (other than in
;; the Shell Item Id List), but I have no confirmation of
;; that, so for now I use the hack below to detect Unicode.
(if (= (logand flags 4) 4)
;; Flag 2 (2^2=4) set means Description String present,
;; so skip it. The string length is the first word,
;; which must also be skipped.
(let ((len (w32-symlinks-buffer-substring-as-int (point) 2)))
(forward-char 2) ; skip length word
(forward-char
(if (eq (char-after (1+ (point))) 0) ; assume unicode
(* len 2)
len))))
(if (= (logand flags 8) 8)
;; Flag 3 (2^3=8) set means Relative Path String present,
;; so parse it. The string length is the first word.
(let ((len (w32-symlinks-buffer-substring-as-int (point) 2)))
(forward-char 2) ; skip length word
(setq target
(if (eq (char-after (1+ (point))) 0) ; assume unicode
(decode-coding-string
(buffer-substring (point) (+ (point) (* len 2)))
'utf-16le) ; modified by smzht
(buffer-substring (point) (+ (point) len)))))))
(when target
(setq target (decode-coding-string target 'undecided)) ; modified by smzht
(let ((i (length target)))
(while (>= (setq i (1- i)) 0)
(if (eq (aref target i) ?\\) (aset target i ?/))))
target)))))
(defun set-attr-symlink (file-and-attr)
(when (and (cdr file-and-attr)
(not (cadr file-and-attr))
(setcar (cdr file-and-attr) (w32-symlinks-parse-symlink (car file-and-attr))))
(aset (nth 9 file-and-attr) 0 ?l)))
2) ls-lisp を有効にする。
(require 'dired)
(require 'ls-lisp)
;; ls-lisp を使う
(setq ls-lisp-use-insert-directory-program nil)
;; dired の並び順を Explorer と同じにする
(setq ls-lisp-ignore-case t) ; ファイル名の大文字小文字無視でソート
(setq ls-lisp-dirs-first t) ; ディレクトリとファイルを分けて表示
(setq dired-listing-switches "-alG") ; グループ表示なし
(setq ls-lisp-UCA-like-collation nil) ; for 25.1 or later
3) melpa から noflet package をインストールする。
（参考） http://emacs.rubikitch.com/noflet/
4) 以下の設定を行う。
(require 'noflet)
;; dired でショートカットのターゲット名を表示するように対策する
(advice-add 'ls-lisp-insert-directory
:around
(lambda (orig-fun &rest args)
(noflet ((directory-files-and-attributes
(&rest args2)
(mapcar (lambda (x) (set-attr-symlink x) x)
(apply this-fn args2))))
(apply orig-fun args))))
(advice-add 'ls-lisp-format
:before
(lambda (&rest args)
(set-attr-symlink (cons (nth 0 args) (nth 1 args)))))
;; dired でファイル名を取得する際、ショートカットのターゲット名を返すように対策する
(advice-add 'dired-get-file-for-visit
:filter-return
(lambda (return-value)
(let ((file-name (w32-symlinks-parse-symlink return-value)))
(if file-name
(expand-file-name file-name)
return-value))))
----
<変更履歴>
・2018/09/04 このページを作成した。
・2018/06/21 Emacs-26系では、default- で始まる変数が廃止されたため、本設定が正常に動作しなくなった。その対策を行った。
・2019/05/13 Windows ショートカット作成時した際、g で dired の再表示を行わなくともリンク先の表示が行われるように改善した。
・2019/06/24 w32-symlinks-parse-shortcut 関数の中に定義されている文字列内に"\ "が含まれていたが、これは空（NULL）であることが分かったので削除した。
----
#javascript(){{
<script>
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
})(window,document,'script','//www.google-analytics.com/analytics.js','ga');
ga('create', 'UA-40267130-1', 'atwiki.jp');
ga('send', 'pageview');
</script>
}}
&bold(){■ Windows版 Emacs 共通の設定}
&bold(){■ Windows Subsystem for Linux の Emacs で利用できる設定}
----
&bold(){【お知らせ】}
----
&bold(){<2021/02/05 追記>}
本ページの内容は WSL2 でも動作します。DrvFs や VolFs の記載がある場合には、Windows 側のファイルシステム、WSL2 側のファイルシステムと読み替えてください。
&bold(){＜2020/02/06 追記＞}
本設定により dired で表示するようにしたショートカットファイルは、リンク元のファイル名（“->”の左側のファイル名）であれば wdired の機能で直接編集可能です。ただし、リンク先（“->”の右側のファイル名）のファイル名を編集すると、不正な動作（恐らく、シンボリックリンクに作り直そうとしてエラーとなり、ショートカットファイルが消える）となりますのでご注意ください。
&bold(){＜2019/06/24 追記＞}
w32-symlinks-parse-shortcut 関数の中に定義されている文字列内に"\ "が含まれていたが、これは空（NULL）であることが分かったので削除しました。機能に変更はありません。
&bold(){＜2019/05/13 追記＞}
4) の見直しにより、次の設定で Windows ショートカットを作成した際、g で dired の再表示を行わなくともリンク先の表示が行われるようになりました。
・[[WSL で NTFS シンボリックリンクや Windows ショートカットを作成するための設定]]
&bold(){＜2018/06/27 追記＞}
こちらの情報を参考としています。ありがとうございます。
・http://d.hatena.ne.jp/holidays-l/20110610/p1
&bold(){＜2018/06/21 追記＞}
Emacs-26系では、default- で始まる変数が廃止されたため、本設定が正常に動作しなくなりました。その対策を行いました。
&bold(){<2018/01/11 追記>}
Cygwin版 Emacs では、Emacs の機能でシンボリックリンクの作成や修正ができます。CYGWIN の設定内容により次のような動きとなります。
・CYGWIN=winsymlinks:lnk で Emacs を起動した場合： Emacs で作成したシンボリックリンクは Windows ショートカットとして作成される。（Cygwin 上ではシンボリックリンクと認識される特別な Windows ショートカットが作成されるため、ファイル名に付く .lnk は表示されない。）
・CYGWIN=winsymlinks:nativestrict で Emacs を起動した場合： Emacs で作成したシンボリックリンクは NTFS シンボリックリンクとして作成される。（NTFS シンボリックリンクの作成に管理者権限を不要とするためには、次の追記の 2) の条件を満たす必要があります。）
&bold(){<2018/01/11 追記>}
Windows 10 1709 を使ってみて、以下を確認しています。
1) WSL では、DrvFs 上で NTFS シンボリックリンクが参照可能となっている。
2) NTFS シンボリックリンクを管理者権限なしで作成するには、以下のどちらかの対応を行う必要がある。
・開発モードにする
https://www.ipentec.com/document/document.aspx?page=windows-windows-10-set-developer-mode
※ 具体的には、シンボリックリンクを作成するプログラムから呼ばれる CreateSymbolicLink 関数が、dwFlags の SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE フラグを立てた状態で実行される必要があります。Windows の mklink や Cygwin は対応されているようですが、MinGW（MSYS2）は未対応のようです。
・SeCreateSymbolicLinkPrivilege 権限を付加する（再ログインが必要）
https://qiita.com/ucho/items/c5ea0beb8acf2f1e4772#comment-250af72ab706bd611549
※ Cygwin を使っている場合は、Cygwin のコンソールを管理権限で開き、次のコマンドを実行してください。（「[[Cygwin で sudo 的コマンドを使うための設定]]」で紹介している sudo を使って管理権限を与える方法もあります。）上記のリンクのコメントにある MSYS2 での利用方法を参考としています。
$ editrights -u $USER -l
$ editrights -u $USER -a SeCreateSymbolicLinkPrivilege
administrators のメンバーは UAC により特権が削除されるという次のような情報もあるのですが、なぜか私の環境では発生していません。
https://qiita.com/azechi/items/f9a97393cb41be4be437
&bold(){<2017/07/22 追記>}
Windows 10 1703 では、開発モードとしていれば管理者権限なしでシンボリックリンクが作成できるようになりました。
・http://forest.watch.impress.co.jp/docs/news/1033597.html
最近の Cygwin でも対応済みとなっており、次の設定をすることにより利用することができます。
export CYGWIN="winsymlinks:nativestrict"
お試しください。（ただし、Windows 10 1703 の Windows Subsystem for Linux では NTFS シンボリックリンクを参照できません。）
&bold(){<2017/06/21 追記>}
本設定は、Windows Subsystem for Linux 上で動作している Emacs から Windows ファイルシステムを参照する場合にも利用可能です。次の設定と組み合わせてご利用ください。（21番は必須の設定です。）
・[[WSL で Emacs を使うための設定]]
&bold(){<2017/05/01 追記>}
本設定は、VirtualBox 上の Linux 上で動作している Emacs から Windows ファイルシステムを参照する場合にも利用可能です。次の設定（最低、4番までの設定が必要）と組み合わせてご利用ください。
・[[VirtualBox 上の Ubuntu から WSL を経由して Windows 環境にアクセスするための設定（戦略３）]]
※ NTFS シンボリックリンクも辿りたい場合は、全ての設定が必要です。
&bold(){<2017/04/12 追記>}
ショートカットファイルの仕様の資料が次のページにあります。
・https://storage.googleapis.com/google-code-archive-downloads/v2/code.google.com/8bits/The_Windows_Shortcut_File_Format.pdf
&bold(){<2015/05/16 追記>}
gnupack-12.00 以降の Cygwin版 Emacs では、Cygwin の ln -s で作成したショートカットをシンボリックリンクとして認識してくれます。
（CYGWIN 環境変数がデフォルト設定である winsymlinks:lnk となっている場合です。Windows で作ったショートカットはシンボリックリンクとしては認識してくれません。）
・https://cygwin.com/cygwin-ug-net/using-cygwinenv.html
if set to just winsymlinks or winsymlinks:lnk, Cygwin creates symlinks &bold(){as Windows shortcuts with a special header} and the R/O attribute set.
&bold(){【本題】}
----
・【重要】Cygwin版 Emacs を使っている場合は、最初に「[[Windowsパス と UNCパス を使えるようにするための設定]]」を行ってください。
・【重要】Windows Subsystem for Linux で Emacs を使っている場合は、最初に「[[Windowsパス と UNCパス を使えるようにするための設定（WSL 設定編）]]」を行ってください。
Windows ショートカットを dired と連携して使うための設定です。「[[w32-symlinks を dired と連携して使うための設定]]」をベースに、Emacs への影響が最小限となるように見直しをしたものです。Emacs の Magic File Names を使った機能を削除し、シンプルな実装にしています。Windows系の Emacs で利用できる他、Windows Subsystem for Linux でも利用可能です。
1) w32-symlinks.el から最低限必要な以下の設定を抽出し、有効とする。（ライセンスは w32-symlinks.el に従ってください。一部、抽出元の設定から変更している箇所（by smzht のコメントがある行）があります。）
・http://www.emacswiki.org/emacs/w32-symlinks.el （抽出元）
;;; w32-symlinks.el --- MS Windows symbolic link (shortcut) support
;; Copyright (C) 2002, 2003 Francis J. Wright, 2005 Lars Hansen
;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk>
;; Last-Updated: 22-11-2005 18:00 UTC
;; By: Lars Hansen <larsh at soem dot dk>
;; URL: http://www.emacswiki.org/emacs/w32-symlinks.el
;; Keywords: convenience, files, unix
;; This file is not part of GNU Emacs.
;; w32-symlinks 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.
;; w32-symlinks 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.
(defun w32-symlinks-parse-symlink (file-name)
"Optionally parse FILE-NAME as a MS Windows symlink file, if possible."
(condition-case nil
(and (string-match "\\.lnk\\'" file-name)
(w32-symlinks-parse-shortcut file-name))
(error nil)))
(defun w32-symlinks-buffer-substring-as-int (start length)
"Return contents of part of the current buffer as an unsigned integer.
START is a character position\; LENGTH specifies the length of the
integer in bytes and should be 1, 2 or 4.
Assumes byte order is low to high (little-endian)."
(let ((idx (+ start length))
(int 0))
;; Base (radix) using unsigned char digits is 2^8 = 256.
(while (>= (setq idx (1- idx)) start)
(setq int (+ (* 256 int) (char-after idx))))
int))
(defun w32-symlinks-parse-shortcut (file)
"Return file or directory referenced by MS Windows shortcut (.lnk) FILE.
Return nil if the file cannot be parsed."
;; Based on "The Windows Shortcut File Format" as
;; reverse-engineered by Jesse Hager <jessehager at iname.com>
;; available from http://www.wotsit.org/download.asp?f=shortcut.
(with-temp-buffer
(set-buffer-multibyte nil) ; added by smzht
(let ((inhibit-file-name-handlers
(cons 'w32-symlinks-file-name-handler
(and (eq inhibit-file-name-operation 'insert-file-contents)
inhibit-file-name-handlers))))
(insert-file-contents-literally file)) ; Eli Zaretskii
(and
;; Parse the File Header Table.
;; Check for Shell Link identifier (4 bytes)
;; followed by Shell Link GUID (16 bytes):
(string= (buffer-substring 1 21) ; otherwise not a shortcut file
"L\0\0\0\x01\x14\x02\0\0\0\0\0\xC0\0\0\0\0\0\0\x46")
;; Get the main flags dword at offset 14h.
(let ((flags (w32-symlinks-buffer-substring-as-int (+ (point) ?\x14) 4))
target)
;; Skip to end of Header:
(forward-char ?\x4C)
(if (= (logand flags 1) 1)
;; Flag 0 (2^0=1) set means Shell Item Id List present, so
;; skip it. The list length is the first word, which must
;; also be skipped:
(forward-char
(+ 2 (w32-symlinks-buffer-substring-as-int (point) 2))))
(if (= (logand flags 2) 2)
;; Flag 1 (2^1=2) set means File Location Info Table
;; present, so parse it.
(progn
;; The full file pathname is (generally) stored in two
;; pieces: a head depending on whether the file is on a
;; local or network volume and a remaining pathname tail.
;; Get and check the volume flags dword at offset 8h:
(setq flags (w32-symlinks-buffer-substring-as-int
(+ (point) ?\x8) 4))
(if (/= (logand flags 3) 0) ; Must have bit 0 or 1 set.
(let ((head ; Get local or network
(save-excursion ; pathname head.
;; If bit 0 then local else network:
(if (setq flags (= (logand flags 1) 1))
;; Go to the base pathname on the local
;; system at the offset specified as a
;; dword at offset 10h:
(forward-char
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x10) 4))
;; Go to the network volume table at the
;; offset specified as a dword at offset 14h:
(forward-char
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x14) 4))
;; Go to the network share name at offset 14h:
(forward-char ?\x14))
(buffer-substring (point)
(1- (search-forward "\0")))))
(tail ; Get the remaining pathname tail
(progn ; specified as a dword at
(forward-char ; offset 18h.
(w32-symlinks-buffer-substring-as-int
(+ (point) ?\x18) 4))
(buffer-substring (point)
(1- (search-forward "\0"))))))
(setq target
;; Network share name needs trailing \ added:
(concat head
(unless (or flags (string= tail "")) "\\")
tail)))))
;; Otherwise, continue parsing...
;; NB: Shortcuts generated using WSH seem to use Unicode.
;; May be flag bit 7 indicates use of Unicode (other than in
;; the Shell Item Id List), but I have no confirmation of
;; that, so for now I use the hack below to detect Unicode.
(if (= (logand flags 4) 4)
;; Flag 2 (2^2=4) set means Description String present,
;; so skip it. The string length is the first word,
;; which must also be skipped.
(let ((len (w32-symlinks-buffer-substring-as-int (point) 2)))
(forward-char 2) ; skip length word
(forward-char
(if (eq (char-after (1+ (point))) 0) ; assume unicode
(* len 2)
len))))
(if (= (logand flags 8) 8)
;; Flag 3 (2^3=8) set means Relative Path String present,
;; so parse it. The string length is the first word.
(let ((len (w32-symlinks-buffer-substring-as-int (point) 2)))
(forward-char 2) ; skip length word
(setq target
(if (eq (char-after (1+ (point))) 0) ; assume unicode
(decode-coding-string
(buffer-substring (point) (+ (point) (* len 2)))
'utf-16le) ; modified by smzht
(buffer-substring (point) (+ (point) len)))))))
(when target
(setq target (decode-coding-string target 'undecided)) ; modified by smzht
(let ((i (length target)))
(while (>= (setq i (1- i)) 0)
(if (eq (aref target i) ?\\) (aset target i ?/))))
target)))))
(defun set-attr-symlink (file-and-attr)
(when (and (cdr file-and-attr)
(not (cadr file-and-attr))
(setcar (cdr file-and-attr) (w32-symlinks-parse-symlink (car file-and-attr))))
(aset (nth 9 file-and-attr) 0 ?l)))
2) ls-lisp を有効にする。
(require 'dired)
(require 'ls-lisp)
;; ls-lisp を使う
(setq ls-lisp-use-insert-directory-program nil)
;; dired の並び順を Explorer と同じにする
(setq ls-lisp-ignore-case t) ; ファイル名の大文字小文字無視でソート
(setq ls-lisp-dirs-first t) ; ディレクトリとファイルを分けて表示
(setq dired-listing-switches "-alG") ; グループ表示なし
(setq ls-lisp-UCA-like-collation nil) ; for 25.1 or later
3) melpa から noflet package をインストールする。
（参考） http://emacs.rubikitch.com/noflet/
4) 以下の設定を行う。
(require 'noflet)
;; dired でショートカットのターゲット名を表示するように対策する
(advice-add 'ls-lisp-insert-directory
:around
(lambda (orig-fun &rest args)
(noflet ((directory-files-and-attributes
(&rest args2)
(mapcar (lambda (x) (set-attr-symlink x) x)
(apply this-fn args2))))
(apply orig-fun args))))
(advice-add 'ls-lisp-format
:before
(lambda (&rest args)
(set-attr-symlink (cons (nth 0 args) (nth 1 args)))))
;; dired でファイル名を取得する際、ショートカットのターゲット名を返すように対策する
(advice-add 'dired-get-file-for-visit
:filter-return
(lambda (return-value)
(let ((file-name (w32-symlinks-parse-symlink return-value)))
(if file-name
(expand-file-name file-name)
return-value))))
----
<変更履歴>
・2018/09/04 このページを作成した。
・2018/06/21 Emacs-26系では、default- で始まる変数が廃止されたため、本設定が正常に動作しなくなった。その対策を行った。
・2019/05/13 Windows ショートカット作成時した際、g で dired の再表示を行わなくともリンク先の表示が行われるように改善した。
・2019/06/24 w32-symlinks-parse-shortcut 関数の中に定義されている文字列内に"\ "が含まれていたが、これは空（NULL）であることが分かったので削除した。
----
#javascript(){{
<script>
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
})(window,document,'script','//www.google-analytics.com/analytics.js','ga');
ga('create', 'UA-40267130-1', 'atwiki.jp');
ga('send', 'pageview');
</script>
}}
