1

Q: Is there a publicly available plugin/modification for the speedbar.el library to mark/unmark and essentially implement speebar-get-marked-files similar to dired-mode's dired-get-marked-files?

If such a feature does not yet exist, then this thread can be used to create that new feature and combine it with the power of dired-do-create-files and dired-create-files for file management capabilities -- i.e., copy, rename, etc.

The following screenshot demonstrates the concept using dired-mode and dired+ to the right, the middle is a custom creation modifying ztree, and the left is a slightly modified version of speedbar. The goal will be to create a plugin/modification that works out-of-the-box with a generic/stock version of speedbar. Example

1

This is a working concept draft that presently only supports all files/directories being displayed in the directory tree. To add support for hiding files/directories, the increment calculations would need to be adjusted so that the hash-tables get modified accordingly. It is possible to obviate the need for hash-tables by examining text-properties on various lines of the buffer, however, this answer contemplates using the former method. This answer reassigns the keyboard shortcuts for M and U -- anyone who is interested in tinkering with this draft can restore the original bindings and choose new bindings for speedbar-mark-all and speedbar-unmark-all.

Inasmuch as this author uses a custom version of speedbar that eliminates dframe library usage, this is probably about as far as this author will be taking this particular working concept draft. Anyone who is interested in taking this draft to the next level of functionality is encouraged to do so by creating an alternative answer so everyone else can benefit from those improvements.

PART 1 OF 2 -- about 30,000 characters:

(require 'speedbar)
(require 'dired-aux)

(setq speedbar-directory-unshown-regexp "^$") ;; show everything
(setq speedbar-show-unknown-files t)

(setq speedbar-initial-expansion-mode-alist '(
    ("buffers"
      speedbar-buffer-easymenu-definition
      speedbar-buffers-key-map
      speedbar-buffer-buttons)
    ("quick buffers"
      speedbar-buffer-easymenu-definition
      speedbar-buffers-key-map
      speedbar-buffer-buttons-temp)
    ("files"
    ;; removed `speedbar-directory-buttons' from the files alist; and,
    ;; incorporated certain portions into `speedbar-default-directory-list'.
      speedbar-easymenu-definition-special
      speedbar-file-key-map
      speedbar-default-directory-list)))

(define-key speedbar-file-key-map "c" 'dired-do-copy)
(define-key speedbar-file-key-map "C" 'speedbar-item-copy)
(define-key speedbar-file-key-map "d" 'speedbar-delete-file)
(define-key speedbar-file-key-map "D" 'speedbar-item-delete)
(define-key speedbar-file-key-map "m" 'speedbar-mark)
(define-key speedbar-file-key-map "M" 'speedbar-mark-all)
;; (define-key speedbar-file-key-map "M" 'speedbar-create-directory)
(define-key speedbar-file-key-map "p" 'speedbar-path)
(define-key speedbar-file-key-map "r" 'dired-do-rename)
(define-key speedbar-file-key-map "R" 'speedbar-item-rename)
(define-key speedbar-file-key-map "u" 'speedbar-unmark)
(define-key speedbar-file-key-map "U" 'speedbar-unmark-all)
;; (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
(define-key speedbar-file-key-map [up] 'speedbar-previous-line)
(define-key speedbar-file-key-map [down] 'speedbar-next-line)
(define-key speedbar-file-key-map [C-up] 'speedbar-up-directory)

(defvar speedbar-line-to-node-table nil
  "Hash table used to find absolute filename based on line number.")

(defvar speedbar-node-to-line-table nil
  "Hash table used to find line number based on absolute filename.")

(defvar speedbar-node-regexp
  "^\\([0-9]+:\\s-*[[<{][+-\?][]>}]\s\\)\\(.*\\)$"
  "A regexp where the second group is the filename or directory.")

(defun speedbar-node-of-line (line)
"Find absolute filename based on line number."
  (gethash line speedbar-line-to-node-table))

(defun speedbar-line-of-node (node)
"Find line number based on absolute filename."
  (gethash node speedbar-node-to-line-table))

(defface speedbar-marked-face
  '((t (:background "purple" :foreground "green")))
"Face for `speedbar-marked-face'."
  :group 'speedbar)

(defun speedbar-cursor-align ()
  (unless (= (point-at-bol) (point-min))
    (goto-char (point-at-bol))
    (re-search-forward
      "^\\([0-9]+\\):\\s-*[[<{][+-\?][]>}]\s\\|^[0-9:\s>]+"
      (point-at-eol) t)))

(defun speedbar-next-line ()
(interactive "^")
  (let ((inhibit-point-motion-hooks t))
    (next-line 1)
    (speedbar-cursor-align)))

(defun speedbar-previous-line ()
(interactive "^")
  (let ((inhibit-point-motion-hooks t))
    (unless (= (line-number-at-pos) 1)
      (previous-line 1)
      (speedbar-cursor-align))))

(defun speedbar-path ()
(interactive)
  (let ((path (speedbar-node-of-line (line-number-at-pos))))
    (when path
      (kill-new path)
      (message "%s" path))))

(defun speedbar-mark (&optional absolute-filename)
(interactive)
  (if
      (and
        (region-active-p)
        (null absolute-filename))
    (speedbar-mark-all)
    (let* (
        beg
        end
        (current-node (speedbar-node-of-line (line-number-at-pos)))
        (line-of-absolute-filename
          (when absolute-filename
            (speedbar-line-of-node absolute-filename))) )
      (unless (equal current-node default-directory)
        (save-excursion
          (when
              (and
                absolute-filename
                line-of-absolute-filename
                (not (equal current-node absolute-filename)))
            (goto-line line-of-absolute-filename))
          (unless (eq (point) (point-at-eol))
            (goto-char (point-at-eol)))
          (when (looking-back speedbar-node-regexp)
            (setq beg (match-beginning 2))
            (setq end (point-at-eol))
            (unless (memq 'speedbar-marked-face
                 (mapcar (function (lambda (ovr)
                  (overlay-get ovr 'face))) (overlays-in beg end)))
              (overlay-put (make-overlay beg end)
                'face 'speedbar-marked-face))))))))

(defun speedbar-unmark ()
(interactive)
  (let* (
      (beg (point-at-bol))
      (end (point-at-eol))
      (current-node (speedbar-node-of-line (line-number-at-pos))) )
    (unless (equal current-node default-directory)
      (save-excursion
        (unless (eq (point) end)
          (goto-char end))
        (re-search-backward speedbar-node-regexp beg t)
        (setq beg (point)))
      (remove-overlays beg end 'face 'speedbar-marked-face))))

(defun speedbar-mark-all ()
(interactive)
  (let* (
      (opoint (point))
      (current-node (speedbar-node-of-line (line-number-at-pos)))
      (speedbar-active-region (region-active-p))
      (region-beg (when speedbar-active-region (region-beginning)))
      (region-end (when speedbar-active-region (region-end))) )
    (save-excursion
      (catch 'done
          (if speedbar-active-region
            (goto-char region-end)
            (goto-char (point-max)))
        (while t
          (setq current-node (speedbar-node-of-line (line-number-at-pos)))
          (speedbar-mark current-node)
          (re-search-backward "\n" nil t)
          (when
              (or
                (and speedbar-active-region (<= (point) region-beg))
                (equal current-node default-directory))
            (throw 'done nil))))))
    (setq mark-active nil))

(defun speedbar-unmark-all ()
(interactive)
  (remove-overlays nil nil))

(defun speedbar-get-marked-files ()
  (let* (
      beg
      end
      current-node
      marked-list
      (point-min (point-min)) )
    (save-excursion
      (goto-char (point-max))
      (catch 'done
        (while t
          (setq end (point-at-eol))
          (setq current-node (speedbar-node-of-line (line-number-at-pos)))
          (unless (eq (point) end)
            (goto-char end))
          (when (looking-back speedbar-node-regexp)
            (setq beg (match-beginning 2))
            (when
              (memq 'speedbar-marked-face
                (mapcar (function (lambda (ovr)
                  (overlay-get ovr 'face))) (overlays-in beg end)))
              (push current-node marked-list)))
          (when (equal current-node default-directory)
            (throw 'done nil))
          (re-search-backward "\n" point-min t))))
      (when
          (and
            (not (eq this-command 'speedbar-refresh))
            (null marked-list))
        (push (speedbar-node-of-line (line-number-at-pos)) marked-list)
        (delete-dups (delq nil marked-list)))
    marked-list))

(defun speedbar-delete-file (&optional file recursive trash)
(interactive)
  (let* (
      (trashing t)
      (trash (if trash trash t))
      (recursive (if recursive recursive 'always))
      (files (if file file (speedbar-get-marked-files)))
      (arg (length files)) )
    (when
        (dired-mark-pop-up ;; returns t if yes or nil if no.
           " *Deletions*" 'delete files dired-deletion-confirmer
           (format "%s %s "
             (if trashing "Trash" "Delete")
             (dired-mark-prompt arg files)))
      (if (listp files)
        (mapcar
          (lambda (x)
            (dired-delete-file x recursive trash))
          files)
        (dired-delete-file files recursive trash))
      (speedbar-refresh) )))

(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
  "At LEVEL, insert a generic multi-level alist LST.
Associations with lists get {+} tags (to expand into more nodes) and
those with positions just get a > as the indicator.  {+} buttons will
have the function EXPAND-FUN and the token is the cdr list.  The token
name will have the function FIND-FUN and not token."
  ;; Remove imenu rescan button
  (when (string= (car (car lst)) "*Rescan*")
      (setq lst (cdr lst)))
  ;; Get, and set up variables that define how we treat these tags.
  (let* (
      expand-button
      tag-button
      (f
        (save-excursion
          (forward-line -1)
          (or
            (speedbar-line-file)
            (speedbar-line-directory)))) )
    (save-excursion
      (when (get-file-buffer f)
        (set-buffer (get-file-buffer f)))
      (setq expand-button speedbar-generic-list-group-expand-button-type
        tag-button speedbar-generic-list-tag-button-type))
     ;; Adjust the list.
    (setq lst (speedbar-create-tag-hierarchy lst))
    (let* (
        (current-line (1- (line-number-at-pos)))
        (increment (length lst))
        (copied-line-to-node-table
        (copy-hash-table speedbar-line-to-node-table))
        (copied-node-to-line-table
          (copy-hash-table speedbar-node-to-line-table)) )
      (maphash
        (lambda (line filename)
          (when (> line current-line)
            (puthash (+ line increment) filename speedbar-line-to-node-table)))
        copied-line-to-node-table)
      (maphash
        (lambda (filename line)
          (when (> line current-line)
            (puthash filename (+ line increment) speedbar-node-to-line-table)))
        copied-node-to-line-table))
      ;; insert the parts
      (while lst
        (cond ((null (car-safe lst)) nil)  ;this would be a separator
       ((speedbar-generic-list-tag-p (car lst))
        (speedbar-make-tag-line tag-button
              nil nil nil ;no expand button data
              (car (car lst)) ;button name
              find-fun ;function
              (cdr (car lst)) ;token is position
              'speedbar-tag-face
              (1+ level)))
       ((speedbar-generic-list-positioned-group-p (car lst))
        (speedbar-make-tag-line expand-button
              ?+ expand-fun (cdr (cdr (car lst)))
              (car (car lst)) ;button name
              find-fun ;function
              (car (cdr (car lst))) ;token is posn
              'speedbar-tag-face
              (1+ level)))
       ((speedbar-generic-list-group-p (car lst))
        (speedbar-make-tag-line expand-button
              ?+ expand-fun (cdr (car lst))
              (car (car lst)) ;button name
              nil nil 'speedbar-tag-face
              (1+ level)))
       (t (message "speedbar-insert-generic-list: malformed list!")))
       (setq lst (cdr lst)))))

(defun speedbar-delete-subblock (indent)
  "Delete text from point to indentation level INDENT or greater.
Handles end-of-sublist smartly."
  (speedbar-with-writable
    (let* (
        start
        end-line
        increment
        copied-line-to-node-table
        copied-node-to-line-table
        (beg-line (line-number-at-pos)))
      (save-excursion
        (end-of-line)
        (forward-char 1)
        (setq start (point))
        (while
            (and
              (looking-at "^\\([0-9]+\\):")
              (> (string-to-number (match-string 1)) indent)
              (not (eobp)))
          (setq end-line (line-number-at-pos))
          (remhash end-line speedbar-line-to-node-table)
          (remhash (speedbar-node-of-line end-line) speedbar-node-to-line-table)
          (forward-line 1)
          (unless (eobp)
            (beginning-of-line)))
        (setq increment (- end-line beg-line))
        (setq copied-line-to-node-table
          (copy-hash-table speedbar-line-to-node-table))
        (setq copied-node-to-line-table
          (copy-hash-table speedbar-node-to-line-table))
        (delete-region start (point))
        (maphash
          (lambda (line filename)
            (when (> line beg-line)
              (puthash (- line increment) filename speedbar-line-to-node-table)
              (remhash line speedbar-line-to-node-table)))
          copied-line-to-node-table)
        (maphash
          (lambda (filename line)
            (when (> line beg-line)
              (puthash filename (- line increment) speedbar-node-to-line-table)
              (remhash filename speedbar-node-to-line-table)))
          copied-node-to-line-table)))))

(defun speedbar-default-directory-list (directory index)
"Insert files for DIRECTORY with level INDEX at point.
This function is used by `speedbar-update-directory-contents' and `speedbar-dired'."
  ;; previously a separate function -- `speedbar-insert-files-at-point'.
  (let* (
      (files (speedbar-file-lists directory))
      (dirs (car files))
      (lst (car (cdr files))) )
    (cond
      ((= (buffer-size) 0)
        (setq default-directory directory)
        (setq speedbar-line-to-node-table (make-hash-table))
        (setq speedbar-node-to-line-table (make-hash-table :test 'equal))
        (puthash 1 directory speedbar-line-to-node-table)
        (puthash directory 1 speedbar-node-to-line-table)
        (let (
            path
            (displayme (expand-file-name directory))
            (p (point)) )
          (insert displayme "\n")
          (save-excursion
            (goto-char p)
            (speedbar-make-button p (1+ p)
              'speedbar-directory-face
              'speedbar-highlight-face
              'speedbar-directory-buttons-follow "/")
            (put-text-property p (1+ p) 'help-echo "\"/\"")
            (while (re-search-forward "\\([^/\\]+\\)[/\\]" nil t)
              (setq path
                (if
                    (and
                      (= (match-beginning 1) p)
                      (not (char-equal (char-after (+ p 1)) ?:)))
                  (expand-file-name "~/")  ;the tilde
                  (buffer-substring-no-properties p (match-end 0))))
              (speedbar-make-button (match-beginning 1) (match-end 1)
                 'speedbar-directory-face
                 'speedbar-highlight-face
                 'speedbar-directory-buttons-follow path)
              (put-text-property (match-beginning 1) (match-end 1)
                'help-echo path)))))
      (t
        (let* (
            (current-line (1- (line-number-at-pos)))
            (increment (+ (length dirs) (length lst)))
            (copied-line-to-node-table
              (copy-hash-table speedbar-line-to-node-table))
            (copied-node-to-line-table
              (copy-hash-table speedbar-node-to-line-table)) )
          (maphash
            (lambda (line filename)
              (when (> line current-line)
                (puthash (+ line increment) filename speedbar-line-to-node-table)))
            copied-line-to-node-table)
          (maphash
            (lambda (filename line)
              (when (> line current-line)
                (puthash filename (+ line increment) speedbar-node-to-line-table)))
            copied-node-to-line-table))))
    (while dirs
      (puthash (line-number-at-pos (point))
        (expand-file-name (car dirs)) speedbar-line-to-node-table)
      (puthash (expand-file-name (car dirs)) (line-number-at-pos (point))
        speedbar-node-to-line-table)
      (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
        (car dirs) 'speedbar-dir-follow nil 'speedbar-directory-face index)
      (setq dirs (cdr dirs)))
    (let ((case-fold-search t))
      (while lst
        (let* (
            (known (string-match speedbar-file-regexp (car lst)))
            (expchar (if known ?+ ??))
            (fn (if known 'speedbar-tag-file nil)) )
          (when (or speedbar-show-unknown-files (/= expchar ??))
            (puthash (line-number-at-pos (point))
              (expand-file-name (car lst)) speedbar-line-to-node-table)
            (puthash (expand-file-name (car lst))
              (line-number-at-pos (point)) speedbar-node-to-line-table)
            (speedbar-make-tag-line 'bracket expchar fn (car lst)
              (car lst) 'speedbar-find-file nil 'speedbar-file-face index)))
        (setq lst (cdr lst)))))
  (speedbar-reset-scanners)
  (if (= index 0)
      (let ((sf (cdr (reverse speedbar-shown-directories))))
  (setq speedbar-shown-directories
        (list (expand-file-name default-directory)))
  ;; Expand them all as we find them.
  (while sf
    (if (speedbar-goto-this-file (car sf))
        (progn
    (beginning-of-line)
    (if (looking-at "[0-9]+:[ ]*<")
        (progn
          (goto-char (match-end 0))
          (speedbar-do-function-pointer)))))
    (setq sf (cdr sf))))))

(defun speedbar-update-directory-contents ()
  "Update the contents of the speedbar buffer based on the current directory."
    (let* (
        (cbd (expand-file-name default-directory))
        cbd-parent
        (funclst (speedbar-initial-expansion-list))
        (cache speedbar-full-text-cache)
        ;; disable stealth during update
        ;; (speedbar-stealthy-function-list nil)
        (use-cache nil)
        (expand-local nil)
        ;; Because there is a bug I can't find just yet
        (inhibit-quit nil) )
      (set-buffer speedbar-buffer)
      ;; If we are updating contents to where we are, then this is
      ;; really a request to update existing contents, so we must be
      ;; careful with our text cache!
      (if (member cbd speedbar-shown-directories)
    (progn
      (setq cache nil)
      ;; If the current directory is not the last element in the dir
      ;; list, then we ALSO need to zap the list of expanded directories
      (if (/= (length (member cbd speedbar-shown-directories)) 1)
    (setq speedbar-shown-directories (list cbd))))
  ;; Build cbd-parent, and see if THAT is in the current shown
  ;; directories.  First, go through pains to get the parent directory
  (if (and speedbar-smart-directory-expand-flag
     (save-match-data
       (setq cbd-parent cbd)
       (if (string-match "[/\\]$" cbd-parent)
           (setq cbd-parent (substring cbd-parent 0
               (match-beginning 0))))
       (setq cbd-parent (file-name-directory cbd-parent)))
     (member cbd-parent speedbar-shown-directories))
      (setq expand-local t)
    ;; If this directory is NOT in the current list of available
    ;; directories, then use the cache, and set the cache to our new
    ;; value.  Make sure to unhighlight the current file, or if we
    ;; come back to this directory, it might be a different file
    ;; and then we get a mess!
    (if (> (point-max) 1)
        (progn
    (speedbar-clear-current-file)
    (setq speedbar-full-text-cache (cons speedbar-shown-directories (buffer-string)))))
    ;; Check if our new directory is in the list of directories
    ;; shown in the text-cache
    (if (member cbd (car cache))
        (setq speedbar-shown-directories (car cache)
        use-cache t)
      ;; default the shown directories to this list...
      (setq speedbar-shown-directories (list cbd)))))
      (if (not expand-local) (setq speedbar-last-selected-file nil))
      (speedbar-with-writable
        (if (and expand-local
           ;; Find this directory as a speedbar node.
           (speedbar-directory-line cbd))
            ;; Open it.
            (speedbar-expand-line)
          (let* ((window (get-buffer-window speedbar-buffer 0))
           (p (window-point window))
           (start (window-start window)))
            (erase-buffer)
            (remove-overlays)
            (cond
              (use-cache
                (setq default-directory
                   (nth (1- (length speedbar-shown-directories))
                     speedbar-shown-directories))
                (insert (cdr cache)))
              (t
                 (dolist (func funclst)
                   ;; func = `speedbar-default-directory-list' ******
                   (funcall func cbd 0))))
            (goto-char (point-min))
            (set-window-point window p)
            (set-window-start window start)
            (speedbar-reconfigure-keymaps)
            (when (not speedbar-stealthy-update-recurse)
              (let* (
                  (l (speedbar-initial-stealthy-functions))
                  (speedbar-stealthy-update-recurse t))
                (unwind-protect
                  (while (and l (funcall (car l)))
                    (setq l (cdr l))) ))))))))
| improve this answer | |
0

PART 2 OF 2 -- a continuation of part 1 of 2 due to character limits:

;; modification of function from built-in library `dired-aux.el`
(defun dired-do-create-files (op-symbol file-creator operation arg
  &optional marker-char op1 how-to)
  (or op1 (setq op1 operation))
  (let* (
      skip-overwrite-confirmation
      (max-mini-window-height 0.25)
      (fn-list
        (cond
          ((eq major-mode 'dired-mode)
            (dired-get-marked-files nil arg))
          ((eq major-mode 'speedbar-mode)
            (speedbar-get-marked-files))) )
      (rfn-list (mapcar (function dired-make-relative) fn-list))
      (dired-one-file  ; fluid variable inside dired-create-files
        (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
      (target-dir
        (cond
          (dired-one-file
            (cond
              ((eq major-mode 'dired-mode)
                (dired-get-file-for-visit))
              ((eq major-mode 'speedbar-mode)
                (speedbar-node-of-line (line-number-at-pos)))))
          (t  ;; directory of multiple files
            (cond
              ((eq major-mode 'dired-mode)
                (dired-dwim-target-directory))
              ((eq major-mode 'speedbar-mode)
                (let ((tentative-target (car fn-list)))
                  (cond
                    ((file-directory-p tentative-target)
                      tentative-target)
                    ((not (file-directory-p tentative-target))
                      (directory-file-name
                        (file-name-directory tentative-target))))))))))
      (default (and dired-one-file
              (expand-file-name (file-name-nondirectory (car fn-list))
              target-dir)) )
      (defaults (dired-dwim-target-defaults fn-list target-dir))
      (target (expand-file-name ; fluid variable inside dired-create-files
        (minibuffer-with-setup-hook (lambda ()
          (set (make-local-variable 'minibuffer-default-add-function) nil)
          (setq minibuffer-default defaults))
          (dired-mark-read-file-name
             (concat (if dired-one-file op1 operation) " %s to:  ")
             target-dir op-symbol arg rfn-list default))))
      (unmodified-initial-target target)
      (into-dir (cond ((null how-to)
        (if (and (memq system-type '(ms-dos windows-nt cygwin))
           (eq op-symbol 'move)
           dired-one-file
           (string= (downcase
               (expand-file-name (car fn-list)))
              (downcase
               (expand-file-name target)))
           (not (string=
           (file-name-nondirectory (car fn-list))
           (file-name-nondirectory target))))
            nil
          (file-directory-p target)))
       ((eq how-to t) nil)
       (t (funcall how-to target)))) )
    (if (and (consp into-dir) (functionp (car into-dir)))
        (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
      (or into-dir (setq target (directory-file-name target)))
      ;; create new directories if they do not exist.
      (when
          (and
            (not (file-directory-p (file-name-directory target)))
            (file-exists-p (directory-file-name (file-name-directory target))))
        (let ((debug-on-quit nil))
          (signal 'quit `(
            "A file with the same name as the proposed directory already exists."))))
      (when
          (and
            (not (file-exists-p (directory-file-name (expand-file-name target))))
            (or
              (and
                (null dired-one-file)
                (not (string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target)))
              (not (file-directory-p (file-name-directory target)))
              (string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target)) )
        (let* (
            new
            list-of-directories
            list-of-shortened-directories
            string-of-directories-a
            string-of-directories-b
            (max-mini-window-height 3)
            (expanded (directory-file-name (expand-file-name target)))
            (try expanded) )
          ;; Find the topmost nonexistent parent dir (variable `new')
          (while (and try (not (file-exists-p try)) (not (equal new try)))
            (push try list-of-directories)
            (setq new try
            try (directory-file-name (file-name-directory try))))
          (setq list-of-shortened-directories
              (mapcar
                (lambda (x) (concat "..." (car (cdr (split-string x try)))))
                list-of-directories))
          (setq string-of-directories-a
            (combine-and-quote-strings list-of-shortened-directories))
          (setq string-of-directories-b (combine-and-quote-strings
            (delete (car (last list-of-shortened-directories))
              list-of-shortened-directories)))
          (if
              (and
                ;; not trailing forward slash
                (not (string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target))
                ;; just one file
                dired-one-file
                ;; that one file exists
                (file-exists-p dired-one-file)
                ;; that one file is not a directory
                (not (file-directory-p dired-one-file)))
            (if (y-or-n-p
                  (format "Is `%s` a directory?" (car (last list-of-directories))))
              (progn
                (or (y-or-n-p (format "@ `%s`, create:  %s" try string-of-directories-a))
                    (let ((debug-on-quit nil))
                      (signal 'quit `("You have exited the function."))))
                (make-directory expanded t)
                (setq into-dir t))
              (if (equal (file-name-directory target)
                (file-name-directory dired-one-file))
                (setq new nil)
                (or (y-or-n-p
                      (format "@ `%s`, create:  %s" try string-of-directories-b))
                    (let ((debug-on-quit nil))
                      (signal 'quit `("You have exited the function."))))
                (make-directory (car (split-string
                  (car (last list-of-directories))
                  (concat "/" (file-name-nondirectory target)))) t)
                (setq target (file-name-directory target))
                (setq into-dir t) ))
            (or (y-or-n-p (format "@ `%s`, create:  %s" try string-of-directories-a))
                (let ((debug-on-quit nil))
                  (signal 'quit `("You have exited the function."))))
            (make-directory expanded t)
            ;; e.g., copying several marked directories to a new directory
            (setq into-dir t))
          (when new
            (dired-add-file new)
            (dired-move-to-filename))
          (setq skip-overwrite-confirmation t) ))
      (dired-create-files file-creator operation fn-list
        (if into-dir      ; target is a directory
          (function (lambda (from)
            (expand-file-name (file-name-nondirectory from) target)))
          (function (lambda (_from) target)))
       marker-char skip-overwrite-confirmation ))))

;; modification of function from built-in library `dired-aux.el`
(defun dired-create-files (file-creator operation fn-list name-constructor
          &optional marker-char skip-overwrite-confirmation)
  (let (dired-create-files-failures failures
  skipped (success-count 0) (total (length fn-list)))
    (let (to overwrite-query overwrite-backup-query)
      (dolist (from fn-list)
        (setq to (funcall name-constructor from))
        (if (equal to from)
            (progn
              (setq to nil)
              (dired-log "Cannot %s to same file: %s\n"
                         (downcase operation) from)))
        (if (not to)
            (setq skipped (cons (dired-make-relative from) skipped))
          (let* ((overwrite (file-exists-p to))
                 (dired-overwrite-confirmed ; for dired-handle-overwrite
                  (and overwrite (not skip-overwrite-confirmation)
                       (let ((help-form '(format "\
Type SPC or `y' to overwrite file `%s',
DEL or `n' to skip to next,
ESC or `q' to not overwrite any of the remaining files,
`!' to overwrite all remaining files with no more questions." to)))
                         (dired-query 'overwrite-query
                                      "Overwrite `%s'?" to))))
                 ;; must determine if FROM is marked before file-creator
                 ;; gets a chance to delete it (in case of a move).
                 (actual-marker-char
                  (cond  ((integerp marker-char) marker-char)
                         (marker-char (dired-file-marker from)) ; slow
                         (t nil))))
            (let ((destname (file-name-directory to)))
              (when (and (file-directory-p from)
                         (file-directory-p to)
                         (eq file-creator 'dired-copy-file))
                (setq to destname))
        ;; If DESTNAME is a subdirectory of FROM, not a symlink,
        ;; and the method in use is copying, signal an error.
        (and (eq t (car (file-attributes destname)))
       (eq file-creator 'dired-copy-file)
       (file-in-directory-p destname from)
       (error "Cannot copy `%s' into its subdirectory `%s'"
        from to)))
            (condition-case err
                (progn
                  (funcall file-creator from to dired-overwrite-confirmed)
                  (if overwrite
                      ;; If we get here, file-creator hasn't been aborted
                      ;; and the old entry (if any) has to be deleted
                      ;; before adding the new entry.
                      (dired-remove-file to))
                  (setq success-count (1+ success-count))
                  (message "%s: %d of %d" operation success-count total)
                  (dired-add-file to actual-marker-char))
              (file-error    ; FILE-CREATOR aborted
               (progn
                 (push (dired-make-relative from)
                       failures)
                 (dired-log "%s `%s' to `%s' failed:\n%s\n"
                            operation from to err))))))))
    (cond
     (dired-create-files-failures
      (setq failures (nconc failures dired-create-files-failures))
      (dired-log-summary
       (format "%s failed for %d file%s in %d requests"
    operation (length failures)
    (dired-plural-s (length failures))
    total)
       failures))
     (failures
      (dired-log-summary
       (format "%s failed for %d of %d file%s"
    operation (length failures)
    total (dired-plural-s total))
       failures))
     (skipped
      (dired-log-summary
       (format "%s: %d of %d file%s skipped"
    operation (length skipped) total
    (dired-plural-s total))
       skipped))
     (t
      (message "%s: %s file%s"
         operation success-count (dired-plural-s success-count)))))
  (cond
    ((eq major-mode 'dired-mode)
      (dired-move-to-filename)
      (run-hooks 'dired-mode-hook))
    ((eq major-mode 'speedbar-mode)
      (speedbar-refresh))))
| improve this answer | |

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.