diff options
| author | Michael Albinus | 2021-01-10 13:26:29 +0100 |
|---|---|---|
| committer | Michael Albinus | 2021-01-10 13:26:29 +0100 |
| commit | aa6ee3302f81f2e1727d06f9b2a7e64d1390fdaa (patch) | |
| tree | b4bf715d447ceb980bf1a58d72f0e8a330653370 /lisp | |
| parent | ac9c4ca8c9456ea4e0cbfea2317579ac57b13289 (diff) | |
| download | emacs-aa6ee3302f81f2e1727d06f9b2a7e64d1390fdaa.tar.gz emacs-aa6ee3302f81f2e1727d06f9b2a7e64d1390fdaa.zip | |
Rework parts of Tramp's insert-directory, bug#45691
* lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Fix some
unibyte/multibyte inconsistencies. (Bug#45691)
* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory-one-file):
New test.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/net/tramp-sh.el | 153 |
1 files changed, 75 insertions, 78 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b43b4485fec..72873157f08 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -2601,7 +2601,7 @@ The method used must be an out-of-band method." | |||
| 2601 | (t nil))))))))) | 2601 | (t nil))))))))) |
| 2602 | 2602 | ||
| 2603 | (defun tramp-sh-handle-insert-directory | 2603 | (defun tramp-sh-handle-insert-directory |
| 2604 | (filename switches &optional wildcard full-directory-p) | 2604 | (filename switches &optional wildcard full-directory-p) |
| 2605 | "Like `insert-directory' for Tramp files." | 2605 | "Like `insert-directory' for Tramp files." |
| 2606 | (setq filename (expand-file-name filename)) | 2606 | (setq filename (expand-file-name filename)) |
| 2607 | (unless switches (setq switches "")) | 2607 | (unless switches (setq switches "")) |
| @@ -2636,66 +2636,65 @@ The method used must be an out-of-band method." | |||
| 2636 | v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" | 2636 | v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" |
| 2637 | switches filename (if wildcard "yes" "no") | 2637 | switches filename (if wildcard "yes" "no") |
| 2638 | (if full-directory-p "yes" "no")) | 2638 | (if full-directory-p "yes" "no")) |
| 2639 | ;; If `full-directory-p', we just say `ls -l FILENAME'. | 2639 | ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we |
| 2640 | ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. | 2640 | ;; chdir to the parent directory, then say `ls -ld BASENAME'. |
| 2641 | (if full-directory-p | 2641 | (if full-directory-p |
| 2642 | (tramp-send-command | 2642 | (tramp-send-command |
| 2643 | v | 2643 | v (format "%s %s %s 2>%s" |
| 2644 | (format "%s %s %s 2>%s" | 2644 | (tramp-get-ls-command v) |
| 2645 | (tramp-get-ls-command v) | 2645 | switches |
| 2646 | switches | 2646 | (if wildcard |
| 2647 | (if wildcard | 2647 | localname |
| 2648 | localname | 2648 | (tramp-shell-quote-argument (concat localname "."))) |
| 2649 | (tramp-shell-quote-argument (concat localname "."))) | 2649 | (tramp-get-remote-null-device v))) |
| 2650 | (tramp-get-remote-null-device v))) | ||
| 2651 | (tramp-barf-unless-okay | 2650 | (tramp-barf-unless-okay |
| 2652 | v | 2651 | v (format "cd %s" (tramp-shell-quote-argument |
| 2653 | (format "cd %s" (tramp-shell-quote-argument | 2652 | (tramp-run-real-handler |
| 2654 | (tramp-run-real-handler | 2653 | #'file-name-directory (list localname)))) |
| 2655 | #'file-name-directory (list localname)))) | ||
| 2656 | "Couldn't `cd %s'" | 2654 | "Couldn't `cd %s'" |
| 2657 | (tramp-shell-quote-argument | 2655 | (tramp-shell-quote-argument |
| 2658 | (tramp-run-real-handler #'file-name-directory (list localname)))) | 2656 | (tramp-run-real-handler #'file-name-directory (list localname)))) |
| 2659 | (tramp-send-command | 2657 | (tramp-send-command |
| 2660 | v | 2658 | v (format "%s %s %s 2>%s" |
| 2661 | (format "%s %s %s 2>%s" | 2659 | (tramp-get-ls-command v) |
| 2662 | (tramp-get-ls-command v) | 2660 | switches |
| 2663 | switches | 2661 | (if (or wildcard |
| 2664 | (if (or wildcard | 2662 | (zerop (length |
| 2665 | (zerop (length | 2663 | (tramp-run-real-handler |
| 2666 | (tramp-run-real-handler | 2664 | #'file-name-nondirectory (list localname))))) |
| 2667 | #'file-name-nondirectory (list localname))))) | 2665 | "" |
| 2668 | "" | 2666 | (tramp-shell-quote-argument |
| 2669 | (tramp-shell-quote-argument | 2667 | (tramp-run-real-handler |
| 2670 | (tramp-run-real-handler | 2668 | #'file-name-nondirectory (list localname)))) |
| 2671 | #'file-name-nondirectory (list localname)))) | 2669 | (tramp-get-remote-null-device v)))) |
| 2672 | (tramp-get-remote-null-device v)))) | 2670 | |
| 2673 | 2671 | (let ((beg-marker (point-marker)) | |
| 2674 | (save-restriction | 2672 | (end-marker (point-marker)) |
| 2675 | (let ((beg (point)) | 2673 | (emc enable-multibyte-characters)) |
| 2676 | (emc enable-multibyte-characters)) | 2674 | (set-marker-insertion-type beg-marker nil) |
| 2677 | (narrow-to-region (point) (point)) | 2675 | (set-marker-insertion-type end-marker t) |
| 2678 | ;; We cannot use `insert-buffer-substring' because the Tramp | 2676 | ;; We cannot use `insert-buffer-substring' because the Tramp |
| 2679 | ;; buffer changes its contents before insertion due to calling | 2677 | ;; buffer changes its contents before insertion due to calling |
| 2680 | ;; `expand-file-name' and alike. | 2678 | ;; `expand-file-name' and alike. |
| 2681 | (insert | 2679 | (insert (with-current-buffer (tramp-get-buffer v) (buffer-string))) |
| 2682 | (with-current-buffer (tramp-get-buffer v) | 2680 | |
| 2683 | (buffer-string))) | 2681 | ;; We must enable unibyte strings, because the "--dired" |
| 2684 | 2682 | ;; output counts in bytes. | |
| 2685 | ;; Check for "--dired" output. We must enable unibyte | 2683 | (set-buffer-multibyte nil) |
| 2686 | ;; strings, because the "--dired" output counts in bytes. | 2684 | (save-restriction |
| 2687 | (set-buffer-multibyte nil) | 2685 | (narrow-to-region beg-marker end-marker) |
| 2686 | ;; Check for "--dired" output. | ||
| 2688 | (forward-line -2) | 2687 | (forward-line -2) |
| 2689 | (when (looking-at-p "//SUBDIRED//") | 2688 | (when (looking-at-p "//SUBDIRED//") |
| 2690 | (forward-line -1)) | 2689 | (forward-line -1)) |
| 2691 | (when (looking-at "//DIRED//\\s-+") | 2690 | (when (looking-at "//DIRED//\\s-+") |
| 2692 | (let ((databeg (match-end 0)) | 2691 | (let ((beg (match-end 0)) |
| 2693 | (end (point-at-eol))) | 2692 | (end (point-at-eol))) |
| 2694 | ;; Now read the numeric positions of file names. | 2693 | ;; Now read the numeric positions of file names. |
| 2695 | (goto-char databeg) | 2694 | (goto-char beg) |
| 2696 | (while (< (point) end) | 2695 | (while (< (point) end) |
| 2697 | (let ((start (+ beg (read (current-buffer)))) | 2696 | (let ((start (+ (point-min) (read (current-buffer)))) |
| 2698 | (end (+ beg (read (current-buffer))))) | 2697 | (end (+ (point-min) (read (current-buffer))))) |
| 2699 | (if (memq (char-after end) '(?\n ?\ )) | 2698 | (if (memq (char-after end) '(?\n ?\ )) |
| 2700 | ;; End is followed by \n or by " -> ". | 2699 | ;; End is followed by \n or by " -> ". |
| 2701 | (put-text-property start end 'dired-filename t)))))) | 2700 | (put-text-property start end 'dired-filename t)))))) |
| @@ -2703,18 +2702,18 @@ The method used must be an out-of-band method." | |||
| 2703 | (goto-char (point-at-bol)) | 2702 | (goto-char (point-at-bol)) |
| 2704 | (while (looking-at "//") | 2703 | (while (looking-at "//") |
| 2705 | (forward-line 1) | 2704 | (forward-line 1) |
| 2706 | (delete-region (match-beginning 0) (point))) | 2705 | (delete-region (match-beginning 0) (point)))) |
| 2707 | ;; Reset multibyte if needed. | 2706 | ;; Reset multibyte if needed. |
| 2708 | (set-buffer-multibyte emc) | 2707 | (set-buffer-multibyte emc) |
| 2709 | 2708 | ||
| 2709 | (save-restriction | ||
| 2710 | (narrow-to-region beg-marker end-marker) | ||
| 2710 | ;; Some busyboxes are reluctant to discard colors. | 2711 | ;; Some busyboxes are reluctant to discard colors. |
| 2711 | (unless | 2712 | (unless |
| 2712 | (string-match-p "color" (tramp-get-connection-property v "ls" "")) | 2713 | (string-match-p "color" (tramp-get-connection-property v "ls" "")) |
| 2713 | (save-excursion | 2714 | (goto-char (point-min)) |
| 2714 | (goto-char beg) | 2715 | (while (re-search-forward tramp-display-escape-sequence-regexp nil t) |
| 2715 | (while | 2716 | (replace-match ""))) |
| 2716 | (re-search-forward tramp-display-escape-sequence-regexp nil t) | ||
| 2717 | (replace-match "")))) | ||
| 2718 | 2717 | ||
| 2719 | ;; Now decode what read if necessary. Stolen from `insert-directory'. | 2718 | ;; Now decode what read if necessary. Stolen from `insert-directory'. |
| 2720 | (let ((coding (or coding-system-for-read | 2719 | (let ((coding (or coding-system-for-read |
| @@ -2729,36 +2728,32 @@ The method used must be an out-of-band method." | |||
| 2729 | ;; If no coding system is specified or detection is | 2728 | ;; If no coding system is specified or detection is |
| 2730 | ;; requested, detect the coding. | 2729 | ;; requested, detect the coding. |
| 2731 | (if (eq (coding-system-base coding) 'undecided) | 2730 | (if (eq (coding-system-base coding) 'undecided) |
| 2732 | (setq coding (detect-coding-region beg (point) t))) | 2731 | (setq coding (detect-coding-region (point-min) (point) t))) |
| 2733 | (if (not (eq (coding-system-base coding) 'undecided)) | 2732 | (unless (eq (coding-system-base coding) 'undecided) |
| 2734 | (save-restriction | 2733 | (setq coding-no-eol |
| 2735 | (setq coding-no-eol | 2734 | (coding-system-change-eol-conversion coding 'unix)) |
| 2736 | (coding-system-change-eol-conversion coding 'unix)) | 2735 | (goto-char (point-min)) |
| 2737 | (narrow-to-region beg (point)) | 2736 | (while (not (eobp)) |
| 2738 | (goto-char (point-min)) | 2737 | (setq pos (point) |
| 2739 | (while (not (eobp)) | 2738 | val (get-text-property (point) 'dired-filename)) |
| 2740 | (setq pos (point) | 2739 | (goto-char (next-single-property-change |
| 2741 | val (get-text-property (point) 'dired-filename)) | 2740 | (point) 'dired-filename nil (point-max))) |
| 2742 | (goto-char (next-single-property-change | 2741 | ;; Force no eol conversion on a file name, so that |
| 2743 | (point) 'dired-filename nil (point-max))) | 2742 | ;; CR is preserved. |
| 2744 | ;; Force no eol conversion on a file name, so | 2743 | (decode-coding-region |
| 2745 | ;; that CR is preserved. | 2744 | pos (point) (if val coding-no-eol coding)) |
| 2746 | (decode-coding-region pos (point) | 2745 | (if val (put-text-property pos (point) 'dired-filename t)))))) |
| 2747 | (if val coding-no-eol coding)) | ||
| 2748 | (if val | ||
| 2749 | (put-text-property pos (point) | ||
| 2750 | 'dired-filename t))))))) | ||
| 2751 | 2746 | ||
| 2752 | ;; The inserted file could be from somewhere else. | 2747 | ;; The inserted file could be from somewhere else. |
| 2753 | (when (and (not wildcard) (not full-directory-p)) | 2748 | (when (and (not wildcard) (not full-directory-p)) |
| 2754 | (goto-char (point-max)) | 2749 | (goto-char (point-max)) |
| 2755 | (when (file-symlink-p filename) | 2750 | (when (file-symlink-p filename) |
| 2756 | (goto-char (search-backward "->" beg 'noerror))) | 2751 | (goto-char (search-backward "->" (point-min) 'noerror))) |
| 2757 | (search-backward | 2752 | (search-backward |
| 2758 | (if (directory-name-p filename) | 2753 | (if (directory-name-p filename) |
| 2759 | "." | 2754 | "." |
| 2760 | (file-name-nondirectory filename)) | 2755 | (file-name-nondirectory filename)) |
| 2761 | beg 'noerror) | 2756 | (point-min) 'noerror) |
| 2762 | (replace-match (file-relative-name filename) t)) | 2757 | (replace-match (file-relative-name filename) t)) |
| 2763 | 2758 | ||
| 2764 | ;; Try to insert the amount of free space. | 2759 | ;; Try to insert the amount of free space. |
| @@ -2769,9 +2764,11 @@ The method used must be an out-of-band method." | |||
| 2769 | ;; Replace "total" with "total used", to avoid confusion. | 2764 | ;; Replace "total" with "total used", to avoid confusion. |
| 2770 | (replace-match "\\1 used in directory") | 2765 | (replace-match "\\1 used in directory") |
| 2771 | (end-of-line) | 2766 | (end-of-line) |
| 2772 | (insert " available " available))) | 2767 | (insert " available " available)))) |
| 2773 | 2768 | ||
| 2774 | (goto-char (point-max))))))) | 2769 | (prog1 (goto-char end-marker) |
| 2770 | (set-marker beg-marker nil) | ||
| 2771 | (set-marker end-marker nil)))))) | ||
| 2775 | 2772 | ||
| 2776 | ;; Canonicalization of file names. | 2773 | ;; Canonicalization of file names. |
| 2777 | 2774 | ||