;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2013 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014
+;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Package: emacs
(dolist (file1 list1)
(unless (let ((list list2))
(while (and list
- (not (let* ((file2 (car list))
- (fa1 (car (cddr file1)))
- (fa2 (car (cddr file2)))
- (size1 (nth 7 fa1))
- (size2 (nth 7 fa2))
- (mtime1 (float-time (nth 5 fa1)))
- (mtime2 (float-time (nth 5 fa2))))
- (and
- (equal (car file1) (car file2))
- (not (eval predicate))))))
+ (let* ((file2 (car list))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2))))
+ (or
+ (not (equal (car file1) (car file2)))
+ (eval predicate
+ `((fa1 . ,fa1)
+ (fa2 . ,fa2)
+ (size1 . ,(nth 7 fa1))
+ (size2 . ,(nth 7 fa2))
+ (mtime1
+ . ,(float-time (nth 5 fa1)))
+ (mtime2
+ . ,(float-time (nth 5 fa2)))
+ )))))
(setq list (cdr list)))
list)
- (setq res (cons file1 res))))
+ (push file1 res)))
(nreverse res))))
(defun dired-files-attributes (dir)
(if (eq op-symbol 'touch)
(list "-t" new-attribute)
(list new-attribute)))
- (if (string-match "gnu" system-configuration)
+ (if (string-match-p "gnu" system-configuration)
'("--") nil))
files))
(dired-do-redisplay arg);; moves point if ARG is an integer
;; We used to treat empty input as DEFAULT, but that is not
;; such a good idea (Bug#9361).
(error "No file mode specified"))
- ((string-match "^[0-7]+" modes)
+ ((string-match-p "^[0-7]+" modes)
(setq num-modes (string-to-number modes 8))))
(dolist (file files)
`lpr-switches' as default."
(interactive "P")
(let* ((file-list (dired-get-marked-files t arg))
+ (lpr-switches
+ (if (and (stringp printer-name)
+ (string< "" printer-name))
+ (cons (concat lpr-printer-switch printer-name)
+ lpr-switches)
+ lpr-switches))
(command (dired-mark-read-string
"Print %s with: "
(mapconcat 'identity
(goto-char (point-min))
(while (not (eobp))
(save-excursion
- (and (not (looking-at dired-re-dir))
+ (and (not (looking-at-p dired-re-dir))
(not (eolp))
(setq file (dired-get-filename nil t)) ; nil on non-file
(progn (end-of-line)
dired-file-version-alist)))))))
(defun dired-trample-file-versions (fn)
- (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+ (let* ((start-vn (string-match-p "\\.~[0-9]+~$" fn))
base-version-list)
(and start-vn
(setq base-version-list ; there was a base version to which
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (unless (string-match "&[ \t]*\\'" command)
+ (unless (string-match-p "&[ \t]*\\'" command)
(setq command (concat command " &")))
(dired-do-shell-command command arg file-list))
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (let* ((on-each (not (string-match dired-star-subst-regexp command)))
- (no-subst (not (string-match dired-quark-subst-regexp command)))
- (star (string-match "\\*" command))
- (qmark (string-match "\\?" command)))
+ (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
+ (no-subst (not (string-match-p dired-quark-subst-regexp command)))
+ (star (string-match-p "\\*" command))
+ (qmark (string-match-p "\\?" command)))
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
(if (cond ((not (or on-each no-subst))
(substring command 0 (match-beginning 0))
command))
(stuff-it
- (if (or (string-match dired-star-subst-regexp command)
- (string-match dired-quark-subst-regexp command))
+ (if (or (string-match-p dired-star-subst-regexp command)
+ (string-match-p dired-quark-subst-regexp command))
(lambda (x)
(let ((retval command))
(while (string-match
(if new-file
(let ((start (point)))
;; Remove any preexisting entry for the name NEW-FILE.
- (condition-case nil
- (dired-remove-entry new-file)
- (error nil))
+ (ignore-errors (dired-remove-entry new-file))
(goto-char start)
;; Now replace the current line with an entry for NEW-FILE.
(dired-update-file-line new-file) nil)
;; Avoid calling ls for files that are going to be omitted anyway.
(let ((omit-re (dired-omit-regexp)))
(or (string= omit-re "")
- (not (string-match omit-re
- (cond
- ((eq 'no-dir dired-omit-localp)
- filename)
- ((eq t dired-omit-localp)
- (dired-make-relative filename))
- (t
- (dired-make-absolute
- filename
- (file-name-directory filename)))))))))
+ (not (string-match-p omit-re
+ (cond
+ ((eq 'no-dir dired-omit-localp)
+ filename)
+ ((eq t dired-omit-localp)
+ (dired-make-relative filename))
+ (t
+ (dired-make-absolute
+ filename
+ (file-name-directory filename)))))))))
;; Do it!
(progn
(setq filename (directory-file-name filename))
;; else try to find correct place to insert
(if (dired-goto-subdir directory)
(progn ;; unhide if necessary
- (if (looking-at "\r")
+ (if (looking-at-p "\r")
;; Point is at end of subdir line.
(dired-unhide-subdir))
;; found - skip subdir and `total' line
(eq t (car attrs))
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
- ;; This is a directory.
(copy-directory from to preserve-time)
- ;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
(if (stringp (car attrs))
(arg
(if whole-name nil current-prefix-arg))
(regexp
- (dired-read-regexp
- (concat (if whole-name "Abs. " "") operation " from (regexp): ")))
+ (read-regexp
+ (concat (if whole-name "Abs. " "") operation " from (regexp): ")
+ nil 'dired-regexp-history))
(newname
(read-string
(concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
(and (not switches) cons (setq switches (cdr cons)))
(dired-insert-subdir-validate dirname switches)
;; case-fold-search is nil now, so we can test for capital `R':
- (if (setq switches-have-R (and switches (string-match "R" switches)))
+ (if (setq switches-have-R (and switches (string-match-p "R" switches)))
;; avoid duplicated subdirs
(setq mark-alist (dired-kill-tree dirname t)))
(if elt
(mapcar
(function
(lambda (x)
- (or (eq (null (string-match x real-switches))
- (null (string-match x dired-actual-switches)))
+ (or (eq (null (string-match-p x real-switches))
+ (null (string-match-p x dired-actual-switches)))
(error
"Can't have dirs with and without -%s switches together" x))))
;; all switches that make a difference to dired-get-filename:
(defun dired-insert-subdir-newpos (new-dir)
;; Find pos for new subdir, according to tree order.
;;(goto-char (point-max))
- (let ((alist dired-subdir-alist) elt dir pos new-pos)
+ (let ((alist dired-subdir-alist) elt dir new-pos)
(while alist
(setq elt (car alist)
alist (cdr alist)
(and selective-display
(save-excursion
(dired-goto-subdir dir)
- (looking-at "\r"))))
+ (looking-at-p "\r"))))
;;;###autoload
(defun dired-hide-subdir (arg)
"Test whether the current search hit is a file name.
Return non-nil if the text from BEG to END is part of a file
name (has the text property `dired-filename')."
- (if dired-isearch-filenames
- (text-property-not-all (min beg end) (max beg end)
- 'dired-filename nil)
- t))
+ (text-property-not-all (min beg end) (max beg end)
+ 'dired-filename nil))
;;;###autoload
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward)))
+ (isearch-forward nil t)))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward-regexp)))
+ (isearch-forward-regexp nil t)))
\f
;; Functions for searching in tags style among marked files.
HCoop / bpt / emacs.git / blobdiff