-;;; dired-aux.el --- all of dired except what people usually use
+;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
"Change the mode of the marked (or next ARG) files.
This calls chmod, thus symbolic modes like `g+w' are allowed."
(interactive "P")
- (dired-do-chxxx "Mode" "chmod" 'chmod arg))
+ (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
;;;###autoload
(defun dired-do-chgrp (&optional arg)
"Change the group of the marked (or next ARG) files."
(interactive "P")
+ (if (memq system-type '(ms-dos windows-nt))
+ (error "chgrp not supported on this system."))
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
;;;###autoload
(defun dired-do-chown (&optional arg)
"Change the owner of the marked (or next ARG) files."
(interactive "P")
+ (if (memq system-type '(ms-dos windows-nt))
+ (error "chown not supported on this system."))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
;; Process all the files in FILES in batches of a convenient size,
(let* ((file-list (dired-get-marked-files t arg))
(command (dired-mark-read-string
"Print %s with: "
- (mapconcat 'concat (append (list lpr-command)
- lpr-switches) " ")
+ (mapconcat 'identity
+ (cons lpr-command
+ (if (stringp lpr-switches)
+ (list lpr-switches)
+ lpr-switches))
+ " ")
'print arg file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(forward-line 1)))))
(defun dired-collect-file-versions (fn)
- ;; "If it looks like file FN has versions, return a list of the versions.
- ;;That is a list of strings which are file names.
- ;;The caller may want to flag some of these files for deletion."
- (let* ((base-versions
- (concat (file-name-nondirectory fn) ".~"))
- (bv-length (length base-versions))
- (possibilities (file-name-all-completions
- base-versions
- (file-name-directory fn)))
- (versions (mapcar 'backup-extract-version possibilities)))
- (if versions
- (setq dired-file-version-alist (cons (cons fn versions)
- dired-file-version-alist)))))
+ (let ((fn (file-name-sans-versions fn)))
+ ;; Only do work if this file is not already in the alist.
+ (if (assoc fn dired-file-version-alist)
+ nil
+ ;; If it looks like file FN has versions, return a list of the versions.
+ ;;That is a list of strings which are file names.
+ ;;The caller may want to flag some of these files for deletion.
+ (let* ((base-versions
+ (concat (file-name-nondirectory fn) ".~"))
+ (bv-length (length base-versions))
+ (possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn)))
+ (versions (mapcar 'backup-extract-version possibilities)))
+ (if versions
+ (setq dired-file-version-alist
+ (cons (cons fn versions)
+ dired-file-version-alist)))))))
(defun dired-trample-file-versions (fn)
(let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
(dired-mark-pop-up
nil 'shell files
(function read-string)
- (format prompt (dired-mark-prompt arg files))))
+ (format prompt (dired-mark-prompt arg files))
+ nil 'shell-command-history))
;; The in-background argument is only needed in Emacs 18 where
;; shell-command doesn't understand an appended ampersand `&'.
(error
(setq failure err)))
(setq elc-file (byte-compile-dest-file filename))
+ (or (file-exists-p elc-file)
+ (setq failure t))
(if failure
(progn
(dired-log "Byte compile error for %s:\n%s\n" filename failure)
(if arg (read-string "Switches for listing: " dired-actual-switches)))
(message "Redisplaying...")
;; message much faster than making dired-map-over-marks show progress
+ (dired-uncache
+ (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename)))
(message "Redisplaying... %s" fname)
(dired-update-file-line fname))
;; Entry is always for files, even if they happen to also be directories
(let ((opoint (point))
(cur-dir (dired-current-directory))
+ (orig-file-name filename)
(directory (file-name-directory filename))
reason)
(setq filename (file-name-nondirectory filename)
(let ((default-directory directory))
(insert-directory filename
(concat dired-actual-switches "d")))
+ ;; Compensate for a bug in ange-ftp.
+ ;; It inserts the file's absolute name, rather than
+ ;; the relative one. That may be hard to fix since it
+ ;; is probably controlled by something in ftp.
+ (goto-char opoint)
+ (let ((inserted-name (dired-get-filename 'no-dir)))
+ (if (file-name-directory inserted-name)
+ (progn
+ (end-of-line)
+ (delete-char (- (length inserted-name)))
+ (insert filename)
+ (forward-char 1))
+ (forward-line 1)))
+ ;; Give each line a text property recording info about it.
(dired-insert-set-properties opoint (point))
(forward-line -1)
(if dired-after-readin-hook;; the subdir-alist is not affected...
(dired-normalize-subdir
(dired-replace-in-string regexp newtext (car elt)))))))
\f
-;; Cloning replace-match to work on strings instead of in buffer:
-;; The FIXEDCASE parameter of replace-match is not implemented.
-;;;###autoload
-(defun dired-string-replace-match (regexp string newtext
- &optional literal global)
- "Replace first match of REGEXP in STRING with NEWTEXT.
-If it does not match, nil is returned instead of the new string.
-Optional arg LITERAL means to take NEWTEXT literally.
-Optional arg GLOBAL means to replace all matches."
- (if global
- (let ((result "") (start 0) mb me)
- (while (string-match regexp string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result
- (substring string start mb)
- (if literal
- newtext
- (dired-expand-newtext string newtext)))
- start me))
- (if mb ; matched at least once
- (concat result (substring string start))
- nil))
- ;; not GLOBAL
- (if (not (string-match regexp string 0))
- nil
- (concat (substring string 0 (match-beginning 0))
- (if literal newtext (dired-expand-newtext string newtext))
- (substring string (match-end 0))))))
-
-(defun dired-expand-newtext (string newtext)
- ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
- ;; Note that in Emacs 18 match data are clipped to current buffer
- ;; size...so the buffer should better not be smaller than STRING.
- (let ((pos 0)
- (len (length newtext))
- (expanded-newtext ""))
- (while (< pos len)
- (setq expanded-newtext
- (concat expanded-newtext
- (let ((c (aref newtext pos)))
- (if (= ?\\ c)
- (cond ((= ?\& (setq c
- (aref newtext
- (setq pos (1+ pos)))))
- (substring string
- (match-beginning 0)
- (match-end 0)))
- ((and (>= c ?1) (<= c ?9))
- ;; return empty string if N'th
- ;; sub-regexp did not match:
- (let ((n (- c ?0)))
- (if (match-beginning n)
- (substring string
- (match-beginning n)
- (match-end n))
- "")))
- (t
- (char-to-string c)))
- (char-to-string c)))))
- (setq pos (1+ pos)))
- expanded-newtext))
-\f
;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
(defun dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char)
;; which will be added. The user will be queried if the file already
;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
;; rename), it is FILE-CREATOR's responsibility to update dired
-;; buffers. FILE-CREATOR must abort by signalling a file-error if it
+;; buffers. FILE-CREATOR must abort by signaling a file-error if it
;; could not create newfile. The error is caught and logged.
;; OPERATION (a capitalized string, e.g. `Copy') describes the
"Copy all marked (or next ARG) files, or copy the current file.
This normally preserves the last-modified date when copying.
When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new symbolic links are made in that directory
+When operating on multiple or marked files, you specify a directory,
+and new copies of these files are made in that directory
with the same names that the files currently have."
(interactive "P")
(dired-do-create-files 'copy (function dired-copy-file)
;;;###end dired-ins.el
+\f
+;; Functions for searching in tags style among marked files.
+
+;;;###autoload
+(defun dired-do-search (regexp)
+ "Search through all marked files for a match for REGEXP.
+Stops when a match is found.
+To continue searching for next match, use command \\[tags-loop-continue]."
+ (interactive "sSearch marked files (regexp): ")
+ (tags-search regexp '(dired-get-marked-files)))
+
+;;;###autoload
+(defun dired-do-query-replace (from to &optional delimited)
+ "Do `query-replace-regexp' of FROM with TO, on all marked files.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
+with the command \\[tags-loop-continue]."
+ (interactive
+ "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
+ (tags-query-replace from to delimited '(dired-get-marked-files)))
+\f
+
(provide 'dired-aux)
;;; dired-aux.el ends here
HCoop / bpt / emacs.git / blobdiff