/[emacs]/emacs/lisp/dired-x.el
ViewVC logotype

Diff of /emacs/lisp/dired-x.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44 by pj, Sat Jan 5 19:00:24 2002 UTC revision 1.44.4.1 by miles, Fri Apr 4 06:20:03 2003 UTC
# Line 7  Line 7 
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    
# Line 33  Line 33 
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    
# Line 470  buffer and try again." Line 470  buffer and try again."
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
# Line 570  This functions works by temporarily bind Line 570  This functions works by temporarily bind
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'."
# Line 998  You can set this variable in your ~/.ema Line 998  You can set this variable in your ~/.ema
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))
# Line 1122  results in Line 1126  results in
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))
# Line 1140  results in Line 1144  results in
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))
# Line 1168  This creates relative symbolic links lik Line 1172  This creates relative symbolic links lik
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.
# Line 1560  to test if that file exists.  Use minibu Line 1564  to test if that file exists.  Use minibu
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
# Line 1583  perfect - point must be in middle of or Line 1586  perfect - point must be in middle of or
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    

Legend:
Removed from v.1.44  
changed lines
  Added in v.1.44.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26