From: Stefan Kangas Date: Fri, 8 Jul 2022 16:31:17 +0000 (+0200) Subject: Move dired-do-relsymlink from dired-x.el to dired.el X-Git-Tag: emacs-29.0.90~1447^2~1090 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=99c96f50ed2058bec44612134ccaf9aa51c9730e;p=emacs.git Move dired-do-relsymlink from dired-x.el to dired.el * lisp/dired-x.el (dired-do-relsymlink, dired-make-relative-symlink) (dired-do-relsymlink-regexp): Move from here... * lisp/dired-aux.el (dired-do-relsymlink, dired-make-relative-symlink) (dired-do-relsymlink-regexp): ...to here. (Bug#21981) * lisp/dired-x.el: Move keybinding and menu binding from here... * lisp/dired.el (dired-mode-map, dired-mode-regexp-menu): ...to here. * lisp/dired-x.el (dired-keep-marker-relsymlink): Move from here... * lisp/dired.el (dired-keep-marker-relsymlink): ...to here. Improve docstring. * doc/misc/dired-x.texi (Miscellaneous Commands): Move documentation of above commands from here... * doc/emacs/dired.texi (Operating on Files) (Transforming File Names): ...to here. --- diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index c7ef097bfb3..69450c82d67 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -844,6 +844,26 @@ This is like @samp{ln -s}. The argument @var{new} is the directory to make the links in, or (if making just one link) the name to give the link. +@findex dired-do-relsymlink +@kindex Y @r{(Dired)} +@item Y @var{new} @key{RET} +Make relative symbolic links to the specified files +(@code{dired-do-relsymlink}). The argument @var{new} is the directory +to make the links in, or (if making just one link) the name to give +the link. This is like @code{dired-do-symlink} but creates relative +symbolic links. For example: + +@example + foo -> ../bar/foo +@end example + +@noindent +It does not create absolute ones like: + +@example + foo -> /path/that/may/change/any/day/bar/foo +@end example + @findex dired-do-chmod @kindex M @r{(Dired)} @cindex changing file permissions (in Dired) @@ -1150,9 +1170,12 @@ Rename each of the selected files to a lower-case name @itemx % S @var{from} @key{RET} @var{to} @key{RET} @kindex % S @r{(Dired)} @findex dired-do-symlink-regexp -These four commands rename, copy, make hard links and make soft links, -in each case computing the new name by regular-expression substitution -from the name of the old file. +@itemx % Y @var{from} @key{RET} @var{to} @key{RET} +@kindex % Y @r{(Dired)} +@findex dired-do-relsymlink-regexp +These five commands rename, copy, make hard links, make soft links, +and make relative soft links, in each case computing the new name by +regular-expression substitution from the name of the old file. @end table The four regular-expression substitution commands effectively diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 504060f41fc..e3a2832cb03 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -920,33 +920,6 @@ to @kbd{V}. Otherwise, @code{dired-bind-rmail} will be bound. @findex dired-rmail Bound to @kbd{V} if @code{dired-bind-vm} is @code{nil}. Run Rmail on this file (assumed to be mail folder in Rmail format). - -@item dired-do-relsymlink -@cindex relative symbolic links. -@kindex Y -@findex dired-do-relsymlink -Bound to @kbd{Y}. Relative symlink all marked (or next ARG) files into a -directory, or make a relative symbolic link to the current file. This creates -relative symbolic links like - -@example - foo -> ../bar/foo -@end example - -@noindent -not absolute ones like - -@example - foo -> /ugly/path/that/may/change/any/day/bar/foo -@end example - -@item dired-do-relsymlink-regexp -@kindex %Y -@findex dired-do-relsymlink-regexp -Bound to @kbd{%Y}. Relative symlink all marked files containing -@var{regexp} to @var{newname}. See functions -@code{dired-do-rename-regexp} and @code{dired-do-relsymlink} for more -info. @end table @node Bugs diff --git a/etc/NEWS b/etc/NEWS index 1e6fb06bdcc..925bd9a212e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1057,6 +1057,14 @@ customize the user option 'dired-clean-up-buffers-too' to nil. The related user option 'dired-clean-confirm-killing-deleted-buffers' (which see) has also been moved to 'dired'. ++++ +*** 'dired-do-relsymlink' moved from dired-x to dired. +The corresponding key "Y" is now bound by default in Dired. + ++++ +*** 'dired-do-relsymlink-regexp' moved from dired-x to dired. +The corresponding key "% Y" is now bound by default in Dired. + +++ *** 'dired-info' and 'dired-man' moved from dired-x to dired. The 'dired-info' and 'dired-man' commands have been moved from the diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 5f2d1cfc9f0..b9f33036e31 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2521,6 +2521,73 @@ Also see `dired-do-revert-buffer'." (dired-do-create-files 'symlink #'make-symbolic-link "Symlink" arg dired-keep-marker-symlink)) +;;;###autoload +(defun dired-do-relsymlink (&optional arg) + "Relative symlink all marked (or next ARG) files into a directory. +Otherwise make a relative symbolic link to the current file. +This creates relative symbolic links like + + foo -> ../bar/foo + +not absolute ones like + + foo -> /ugly/file/name/that/may/change/any/day/bar/foo + +For absolute symlinks, use \\[dired-do-symlink]." + (interactive "P") + (dired-do-create-files 'relsymlink #'dired-make-relative-symlink + "RelSymLink" arg dired-keep-marker-relsymlink)) + +(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) + "Make a symbolic link (pointing to FILE1) in FILE2. +The link is relative (if possible), for example + + \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" + +results in + + \"../../tex/bin/foo\" \"/vol/local/bin/foo\"" + (interactive "FRelSymLink: \nFRelSymLink %s: \np") + (let (name1 name2 len1 len2 (index 0) sub) + (setq file1 (expand-file-name file1) + file2 (expand-file-name file2) + len1 (length file1) + len2 (length file2)) + ;; Find common initial file name components: + (let (next) + (while (and (setq next (string-search "/" file1 index)) + (< (setq next (1+ next)) (min len1 len2)) + ;; For the comparison, both substrings must end in + ;; `/', so NEXT is *one plus* the result of the + ;; string-search. + ;; E.g., consider the case of linking "/tmp/a/abc" + ;; to "/tmp/abc" erroneously giving "/tmp/a" instead + ;; of "/tmp/" as common initial component + (string-equal (substring file1 0 next) + (substring file2 0 next))) + (setq index next)) + (setq name2 file2 + sub (substring file1 0 index) + name1 (substring file1 index))) + (if (string-equal sub "/") + ;; No common initial file name found + (setq name1 file1) + ;; Else they have a common parent directory + (let ((tem (substring file2 index)) + (start 0) + (count 0)) + ;; Count number of slashes we must compensate for ... + (while (setq start (string-search "/" tem start)) + (setq count (1+ count) + start (1+ start))) + ;; ... and prepend a "../" for each slash found: + (dotimes (_ count) + (setq name1 (concat "../" name1))))) + (make-symbolic-link + (directory-file-name name1) ; must not link to foo/ + ; (trailing slash!) + name2 ok-if-already-exists))) + ;;;###autoload (defun dired-do-hardlink (&optional arg) "Add names (hard links) current file or all marked (or next ARG) files. @@ -2681,6 +2748,16 @@ See function `dired-do-rename-regexp' for more info." #'make-symbolic-link "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) +;;;###autoload +(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name) + "RelSymlink all marked files containing REGEXP to NEWNAME. +See functions `dired-do-rename-regexp' and `dired-do-relsymlink' +for more info." + (interactive (dired-mark-read-regexp "RelSymLink")) + (dired-do-create-files-regexp + #'dired-make-relative-symlink + "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) + ;;; Change case of file names diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 1e1bf9efd68..08daef71c6e 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -238,15 +238,11 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "*O" 'dired-mark-omitted) (define-key dired-mode-map "*." 'dired-mark-extension)) -(when (keymapp (lookup-key dired-mode-map "%")) - (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp)) - (define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode) (define-key dired-mode-map "\M-(" 'dired-mark-sexp) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) -(define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "V" 'dired-do-run-mail) @@ -257,12 +253,6 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." ["Find Files" dired-do-find-marked-files :help "Find current or marked files"] "Shell Command...") - (easy-menu-add-item menu '("Operate") - ["Relative Symlink to..." dired-do-relsymlink - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for current or \ -marked files"] - "Hardlink to...") (easy-menu-add-item menu '("Mark") ["Flag Extension..." dired-flag-extension :help "Flag files with a certain extension for deletion"] @@ -276,12 +266,6 @@ marked files"] :help "Mark files matching `dired-omit-files' \ and `dired-omit-extensions'"] "Unmark All") - (easy-menu-add-item menu '("Regexp") - ["Relative Symlink..." dired-do-relsymlink-regexp - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for files \ -matching regexp"] - "Hardlink...") (easy-menu-add-item menu '("Immediate") ["Omit Mode" dired-omit-mode :style toggle :selected dired-omit-mode @@ -1044,95 +1028,6 @@ See `dired-guess-shell-alist-user'." ;; If we got a return, then return default. (if (equal val "") default val)))) - -;;; Relative symbolic links - -(declare-function make-symbolic-link "fileio.c") - -(defvar dired-keep-marker-relsymlink ?S - "See variable `dired-keep-marker-move'.") - -(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists) - "Make a symbolic link (pointing to FILE1) in FILE2. -The link is relative (if possible), for example - - \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\" - -results in - - \"../../tex/bin/foo\" \"/vol/local/bin/foo\"" - (interactive "FRelSymLink: \nFRelSymLink %s: \np") - (let (name1 name2 len1 len2 (index 0) sub) - (setq file1 (expand-file-name file1) - file2 (expand-file-name file2) - len1 (length file1) - len2 (length file2)) - ;; Find common initial file name components: - (let (next) - (while (and (setq next (string-search "/" file1 index)) - (< (setq next (1+ next)) (min len1 len2)) - ;; For the comparison, both substrings must end in - ;; `/', so NEXT is *one plus* the result of the - ;; string-search. - ;; E.g., consider the case of linking "/tmp/a/abc" - ;; to "/tmp/abc" erroneously giving "/tmp/a" instead - ;; of "/tmp/" as common initial component - (string-equal (substring file1 0 next) - (substring file2 0 next))) - (setq index next)) - (setq name2 file2 - sub (substring file1 0 index) - name1 (substring file1 index))) - (if (string-equal sub "/") - ;; No common initial file name found - (setq name1 file1) - ;; Else they have a common parent directory - (let ((tem (substring file2 index)) - (start 0) - (count 0)) - ;; Count number of slashes we must compensate for ... - (while (setq start (string-search "/" tem start)) - (setq count (1+ count) - start (1+ start))) - ;; ... and prepend a "../" for each slash found: - (dotimes (_ count) - (setq name1 (concat "../" name1))))) - (make-symbolic-link - (directory-file-name name1) ; must not link to foo/ - ; (trailing slash!) - name2 ok-if-already-exists))) - -(autoload 'dired-do-create-files "dired-aux") - -;;;###autoload -(defun dired-do-relsymlink (&optional arg) - "Relative symlink all marked (or next ARG) files into a directory. -Otherwise make a relative symbolic link to the current file. -This creates relative symbolic links like - - foo -> ../bar/foo - -not absolute ones like - - foo -> /ugly/file/name/that/may/change/any/day/bar/foo - -For absolute symlinks, use \\[dired-do-symlink]." - (interactive "P") - (dired-do-create-files 'relsymlink #'dired-make-relative-symlink - "RelSymLink" arg dired-keep-marker-relsymlink)) - -(autoload 'dired-mark-read-regexp "dired-aux") -(autoload 'dired-do-create-files-regexp "dired-aux") - -(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name) - "RelSymlink all marked files containing REGEXP to NEWNAME. -See functions `dired-do-rename-regexp' and `dired-do-relsymlink' -for more info." - (interactive (dired-mark-read-regexp "RelSymLink")) - (dired-do-create-files-regexp - #'dired-make-relative-symlink - "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) - ;;; Visit all marked files simultaneously diff --git a/lisp/dired.el b/lisp/dired.el index 48dffa0e364..5769b73f638 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -210,6 +210,11 @@ If a character, new links are unconditionally marked with that character." (character :tag "Mark")) :group 'dired-mark) +(defvar dired-keep-marker-relsymlink ?S + "Controls marking of newly made relative symbolic links. +If t, they are marked if and as the files linked to were marked. +If a character, new links are unconditionally marked with that character.") + (defcustom dired-free-space 'first "Whether and how to display the amount of free disk space in Dired buffers. If nil, don't display. @@ -2090,6 +2095,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "S" #'dired-do-symlink "T" #'dired-do-touch "X" #'dired-do-shell-command + "Y" #'dired-do-relsymlink "Z" #'dired-do-compress "c" #'dired-do-compress-to "!" #'dired-do-shell-command @@ -2119,6 +2125,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "% H" #'dired-do-hardlink-regexp "% R" #'dired-do-rename-regexp "% S" #'dired-do-symlink-regexp + "% Y" #'dired-do-relsymlink-regexp "% &" #'dired-flag-garbage-files ;; Commands for marking and unmarking. "* *" #'dired-mark-executables @@ -2296,6 +2303,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ["Symlink..." dired-do-symlink-regexp :visible (fboundp 'make-symbolic-link) :help "Make symbolic links for files matching regexp"] + ["Relative Symlink..." dired-do-relsymlink-regexp + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for files matching regexp"] ["Hardlink..." dired-do-hardlink-regexp :help "Make hard links for files matching regexp"] ["Upcase" dired-upcase @@ -2365,6 +2375,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ["Symlink to..." dired-do-symlink :visible (fboundp 'make-symbolic-link) :help "Make symbolic links for current or marked files"] + ["Relative Symlink to..." dired-do-relsymlink + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for current or marked files"] ["Hardlink to..." dired-do-hardlink :help "Make hard links for current or marked files"] ["Print..." dired-do-print