7 |
;; Date: 1994/08/18 19:27:42 |
;; Date: 1994/08/18 19:27:42 |
8 |
;; Keywords: dired extensions files |
;; Keywords: dired extensions files |
9 |
|
|
10 |
;; Copyright (C) 1993, 1994, 1997, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1994, 1997, 2001, 2003 Free Software Foundation, Inc. |
11 |
|
|
12 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
13 |
|
|
33 |
;; been removed or renamed in order to work properly with dired of GNU |
;; been removed or renamed in order to work properly with dired of GNU |
34 |
;; Emacs. All suggestions or comments are most welcomed. |
;; Emacs. All suggestions or comments are most welcomed. |
35 |
|
|
36 |
;; |
;; |
37 |
;; Please, PLEASE, *PLEASE* see the info pages. |
;; Please, PLEASE, *PLEASE* see the info pages. |
38 |
;; |
;; |
39 |
|
|
40 |
;; BUGS: Type M-x dired-x-submit-report and a report will be generated. |
;; BUGS: Type M-x dired-x-submit-report and a report will be generated. |
41 |
|
|
470 |
(defvar dired-omit-localp 'no-dir |
(defvar dired-omit-localp 'no-dir |
471 |
"The LOCALP argument `dired-omit-expunge' passes to `dired-get-filename'. |
"The LOCALP argument `dired-omit-expunge' passes to `dired-get-filename'. |
472 |
If it is 'no-dir, omitting is much faster, but you can only match |
If it is 'no-dir, omitting is much faster, but you can only match |
473 |
against the basename of the file. Set it to nil if you need to match the |
against the non-directory part of the file name. Set it to nil if you |
474 |
whole pathname.") |
need to match the entire file name.") |
475 |
|
|
476 |
;; \017=^O for Omit - other packages can chose other control characters. |
;; \017=^O for Omit - other packages can chose other control characters. |
477 |
(defvar dired-omit-marker-char ?\017 |
(defvar dired-omit-marker-char ?\017 |
570 |
;; Returns t if any work was done, nil otherwise. |
;; Returns t if any work was done, nil otherwise. |
571 |
(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) |
(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp) |
572 |
"Mark unmarked files matching REGEXP, displaying MSG. |
"Mark unmarked files matching REGEXP, displaying MSG. |
573 |
REGEXP is matched against the complete pathname. |
REGEXP is matched against the entire file name. |
574 |
Does not re-mark files which already have a mark. |
Does not re-mark files which already have a mark. |
575 |
With prefix argument, unflag all those files. |
With prefix argument, unflag all those files. |
576 |
Second optional argument LOCALP is as in `dired-get-filename'." |
Second optional argument LOCALP is as in `dired-get-filename'." |
998 |
:group 'dired-x |
:group 'dired-x |
999 |
:type '(alist :key-type regexp :value-type (repeat sexp))) |
:type '(alist :key-type regexp :value-type (repeat sexp))) |
1000 |
|
|
1001 |
|
(defvar dired-guess-shell-case-fold-search nil |
1002 |
|
"*If non-nil, `dired-guess-shell-alist-default' and |
1003 |
|
`dired-guess-shell-alist-user' are matched case-insensitively.") |
1004 |
|
|
1005 |
(defun dired-guess-default (files) |
(defun dired-guess-default (files) |
1006 |
"Guess a shell commands for FILES. Return command or list of commands. |
"Guess a shell commands for FILES. Return command or list of commands. |
1007 |
See `dired-guess-shell-alist-user'." |
See `dired-guess-shell-alist-user'." |
1008 |
|
|
1009 |
(let* ((case-fold-search nil) ; case-sensitive matching |
(let* ((case-fold-search dired-guess-shell-case-fold-search) |
1010 |
;; Prepend the user's alist to the default alist. |
;; Prepend the user's alist to the default alist. |
1011 |
(alist (append dired-guess-shell-alist-user |
(alist (append dired-guess-shell-alist-user |
1012 |
dired-guess-shell-alist-default)) |
dired-guess-shell-alist-default)) |
1126 |
file2 (expand-file-name file2) |
file2 (expand-file-name file2) |
1127 |
len1 (length file1) |
len1 (length file1) |
1128 |
len2 (length file2)) |
len2 (length file2)) |
1129 |
;; Find common initial pathname components: |
;; Find common initial file name components: |
1130 |
(let (next) |
(let (next) |
1131 |
(while (and (setq next (string-match "/" file1 index)) |
(while (and (setq next (string-match "/" file1 index)) |
1132 |
(setq next (1+ next)) |
(setq next (1+ next)) |
1144 |
sub (substring file1 0 index) |
sub (substring file1 0 index) |
1145 |
name1 (substring file1 index))) |
name1 (substring file1 index))) |
1146 |
(if (string-equal sub "/") |
(if (string-equal sub "/") |
1147 |
;; No common initial pathname found |
;; No common initial file name found |
1148 |
(setq name1 file1) |
(setq name1 file1) |
1149 |
;; Else they have a common parent directory |
;; Else they have a common parent directory |
1150 |
(let ((tem (substring file2 index)) |
(let ((tem (substring file2 index)) |
1172 |
|
|
1173 |
not absolute ones like |
not absolute ones like |
1174 |
|
|
1175 |
foo -> /ugly/path/that/may/change/any/day/bar/foo" |
foo -> /ugly/file/name/that/may/change/any/day/bar/foo" |
1176 |
(interactive "P") |
(interactive "P") |
1177 |
(dired-do-create-files 'relsymlink (function dired-make-relative-symlink) |
(dired-do-create-files 'relsymlink (function dired-make-relative-symlink) |
1178 |
"RelSymLink" arg dired-keep-marker-relsymlink)) |
"RelSymLink" arg dired-keep-marker-relsymlink)) |
1179 |
|
|
1180 |
(defun dired-do-relsymlink-regexp (regexp newname &optional whole-path) |
(defun dired-do-relsymlink-regexp (regexp newname &optional whole-name) |
1181 |
"RelSymlink all marked files containing REGEXP to NEWNAME. |
"RelSymlink all marked files containing REGEXP to NEWNAME. |
1182 |
See functions `dired-do-rename-regexp' and `dired-do-relsymlink' |
See functions `dired-do-rename-regexp' and `dired-do-relsymlink' |
1183 |
for more info." |
for more info." |
1184 |
(interactive (dired-mark-read-regexp "RelSymLink")) |
(interactive (dired-mark-read-regexp "RelSymLink")) |
1185 |
(dired-do-create-files-regexp |
(dired-do-create-files-regexp |
1186 |
(function dired-make-relative-symlink) |
(function dired-make-relative-symlink) |
1187 |
"RelSymLink" nil regexp newname whole-path dired-keep-marker-relsymlink)) |
"RelSymLink" nil regexp newname whole-name dired-keep-marker-relsymlink)) |
1188 |
|
|
1189 |
|
|
1190 |
;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. |
;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. |
1564 |
(find-file-other-window (expand-file-name filename))) |
(find-file-other-window (expand-file-name filename))) |
1565 |
|
|
1566 |
;;; Internal functions. |
;;; Internal functions. |
|
(defun dired-filename-at-point () |
|
1567 |
|
|
1568 |
|
;; Fixme: This should probably use `thing-at-point'. -- fx |
1569 |
|
(defun dired-filename-at-point () |
1570 |
"Get the filename closest to point, but do not change position. |
"Get the filename closest to point, but do not change position. |
1571 |
Has a preference for looking backward when not directly on a symbol. Not |
Has a preference for looking backward when not directly on a symbol. Not |
1572 |
perfect - point must be in middle of or end of filename." |
perfect - point must be in middle of or end of filename." |
1573 |
|
|
1574 |
(let ((filename-chars ".a-zA-Z0-9---_/:$+@") ; fixme: allow non-ASCII |
(let ((filename-chars "-.[:alnum:]_/:$+@") |
|
(bol (save-excursion (beginning-of-line) (point))) |
|
|
(eol (save-excursion (end-of-line) (point))) |
|
1575 |
start end filename prefix) |
start end filename prefix) |
1576 |
|
|
1577 |
(save-excursion |
(save-excursion |
1586 |
(if (string-match (concat "[" filename-chars "]") |
(if (string-match (concat "[" filename-chars "]") |
1587 |
(char-to-string (following-char))) |
(char-to-string (following-char))) |
1588 |
(progn |
(progn |
1589 |
(skip-chars-backward filename-chars) |
(if (re-search-backward (concat "[^" filename-chars "]") nil t) |
1590 |
|
(forward-char) |
1591 |
|
(goto-char (point-min))) |
1592 |
(setq start (point)) |
(setq start (point)) |
1593 |
(setq prefix |
(setq prefix |
1594 |
(and (string-match "^\\w+@" |
(and (string-match |
1595 |
(buffer-substring start eol)) |
"^\\w+@" |
1596 |
|
(buffer-substring start (line-beginning-position))) |
1597 |
"/")) |
"/")) |
1598 |
(goto-char start) |
(goto-char start) |
1599 |
(if (string-match "[/~]" (char-to-string (preceding-char))) |
(if (string-match "[/~]" (char-to-string (preceding-char))) |
1600 |
(setq start (1- start))) |
(setq start (1- start))) |
1601 |
(skip-chars-forward filename-chars)) |
(re-search-forward (concat "\\=[" filename-chars "]*") nil t)) |
1602 |
|
|
1603 |
(error "No file found around point!")) |
(error "No file found around point!")) |
1604 |
|
|