X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b63bfac4d4d97c1389187b57e6c4e8c425ace441..3a0f6aac0db3b1961c759a278d2bc67b501ddd0a:/lisp/dired-x.el diff --git a/lisp/dired-x.el b/lisp/dired-x.el index f5e6250b47..5495d64913 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1,21 +1,19 @@ ;;; dired-x.el --- extra Dired functionality -*-byte-compile-dynamic: t;-*- +;; Copyright (C) 1993, 1994, 1997, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + ;; Author: Sebastian Kremer ;; Lawrence R. Dodd ;; Maintainer: Romain Francoise -;; Version: 2.37+ -;; Date: 1994/08/18 19:27:42 ;; Keywords: dired extensions files -;; Copyright (C) 1993, 1994, 1997, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. - ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -23,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -45,8 +41,12 @@ ;; (add-hook 'dired-load-hook ;; (function (lambda () ;; (load "dired-x") -;; ;; Set variables here. For example: +;; ;; Set global variables here. For example: ;; ;; (setq dired-guess-shell-gnutar "gtar") +;; ))) +;; (add-hook 'dired-mode-hook +;; (function (lambda () +;; ;; Set buffer-local variables here. For example: ;; ;; (dired-omit-mode 1) ;; ))) ;; @@ -168,8 +168,7 @@ plus those ending with extensions in `dired-omit-extensions'." (revert-buffer))) ;; For backward compatibility -(defvaralias 'dired-omit-files-p 'dired-omit-mode) -(make-obsolete-variable 'dired-omit-files-p 'dired-omit-mode) +(define-obsolete-variable-alias 'dired-omit-files-p 'dired-omit-mode "22.1") (defcustom dired-omit-files "^\\.?#\\|^\\.$\\|^\\.\\.$" "*Filenames matching this regexp will not be displayed. @@ -332,7 +331,7 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key global-map "\C-x4\C-j" 'dired-jump-other-window))) -;;; Install into appropriate hooks. +;; Install into appropriate hooks. (add-hook 'dired-mode-hook 'dired-extra-startup) (add-hook 'dired-after-readin-hook 'dired-omit-expunge) @@ -421,7 +420,7 @@ Remove expanded subdir of deleted dir, if any." ;;; EXTENSION MARKING FUNCTIONS. -;;; Mark files with some extension. +;; Mark files with some extension. (defun dired-mark-extension (extension &optional marker-char) "Mark all files with a certain EXTENSION for use in later commands. A `.' is *not* automatically prepended to the string entered." @@ -443,7 +442,7 @@ A `.' is *not* automatically prepended to the string entered." (interactive "sFlagging extension: ") (dired-mark-extension extension dired-del-marker)) -;;; Define some unpopular file extensions. Used for cleaning and omitting. +;; Define some unpopular file extensions. Used for cleaning and omitting. (defvar dired-patch-unclean-extensions '(".rej" ".orig") @@ -538,8 +537,8 @@ buffer and try again." ;;; OMITTING. -;;; Enhanced omitting of lines from directory listings. -;;; Marked files are never omitted. +;; Enhanced omitting of lines from directory listings. +;; Marked files are never omitted. ;; should probably get rid of this and always use 'no-dir. ;; sk 28-Aug-1991 09:37 @@ -648,7 +647,16 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." (and fn (string-match regexp fn)))) msg))) -;;; REDEFINE. +;; Compiler does not get fset. +(declare-function dired-omit-old-add-entry "dired-x") + +;; REDEFINE. +;; Redefine dired-aux.el's version of `dired-add-entry' +;; Save old defun if not already done: +(or (fboundp 'dired-omit-old-add-entry) + (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry))) + +;; REDEFINE. (defun dired-omit-new-add-entry (filename &optional marker-char relative) ;; This redefines dired-aux.el's dired-add-entry to avoid calling ls for ;; files that are going to be omitted anyway. @@ -675,18 +683,13 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." ;; omitting is not turned on at all (dired-omit-old-add-entry filename marker-char relative))) -;;; REDEFINE. -;;; Redefine dired-aux.el's version of `dired-add-entry' -;;; Save old defun if not already done: -(or (fboundp 'dired-omit-old-add-entry) - (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry))) ;; Redefine it. (fset 'dired-add-entry 'dired-omit-new-add-entry) ;;; VIRTUAL DIRED MODE. -;;; For browsing `ls -lR' listings in a dired-like fashion. +;; For browsing `ls -lR' listings in a dired-like fashion. (defalias 'virtual-dired 'dired-virtual) (defun dired-virtual (dirname &optional switches) @@ -742,7 +745,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." ;; decent subdir headerline: (goto-char (point-min)) (or (looking-at dired-subdir-regexp) - (insert " " + (insert " " (directory-file-name (file-name-directory default-directory)) ":\n")) (dired-mode dirname (or switches dired-listing-switches)) @@ -790,35 +793,32 @@ nil." (revert-buffer))) ;; A zero-arg version of dired-virtual. -;; You need my modified version of set-auto-mode for the -;; `buffer-contents-mode-alist'. -;; Or you use infer-mode.el and infer-mode-alist, same syntax. (defun dired-virtual-mode () "Put current buffer into Virtual Dired mode (see `dired-virtual'). -Useful on `buffer-contents-mode-alist' (which see) with the regexp +Useful on `magic-mode-alist' with the regexp - \"^ \\(/[^ /]+\\)/?+:$\" + \"^ \\\\(/[^ /]+\\\\)+/?:$\" to put saved dired buffers automatically into Virtual Dired mode. -Also useful for `auto-mode-alist' (which see) like this: +Also useful for `auto-mode-alist' like this: - \(setq auto-mode-alist (cons '(\"[^/]\\.dired\\'\" . dired-virtual-mode) - auto-mode-alist)\)" + (add-to-list 'auto-mode-alist + '(\"[^/]\\\\.dired\\\\'\" . dired-virtual-mode))" (interactive) (dired-virtual (dired-virtual-guess-dir))) ;;; SMART SHELL. -;;; An Emacs buffer can have but one working directory, stored in the -;;; buffer-local variable `default-directory'. A Dired buffer may have -;;; several subdirectories inserted, but still has but one working directory: -;;; that of the top level Dired directory in that buffer. For some commands -;;; it is appropriate that they use the current Dired directory instead of -;;; `default-directory', e.g., `find-file' and `compile'. This is a general -;;; mechanism is provided for special handling of the working directory in -;;; special major modes. +;; An Emacs buffer can have but one working directory, stored in the +;; buffer-local variable `default-directory'. A Dired buffer may have +;; several subdirectories inserted, but still has but one working directory: +;; that of the top level Dired directory in that buffer. For some commands +;; it is appropriate that they use the current Dired directory instead of +;; `default-directory', e.g., `find-file' and `compile'. This is a general +;; mechanism is provided for special handling of the working directory in +;; special major modes. ;; It's easier to add to this alist than redefine function ;; default-directory while keeping the old information. @@ -836,33 +836,42 @@ Knows about the special cases in variable `default-directory-alist'." (or (eval (cdr (assq major-mode default-directory-alist))) default-directory)) -(defun dired-smart-shell-command (cmd &optional insert) +(defun dired-smart-shell-command (command &optional output-buffer error-buffer) "Like function `shell-command', but in the current Virtual Dired directory." - (interactive (list (read-from-minibuffer "Shell command: " - nil nil nil 'shell-command-history) - current-prefix-arg)) + (interactive + (list + (minibuffer-with-setup-hook + (lambda () + (set (make-local-variable 'minibuffer-default-add-function) + 'minibuffer-default-add-shell-commands)) + (read-shell-command "Shell command: " nil nil + (cond + (buffer-file-name (file-relative-name buffer-file-name)) + ((eq major-mode 'dired-mode) (dired-get-filename t t))))) + current-prefix-arg + shell-command-default-error-buffer)) (let ((default-directory (dired-default-directory))) - (shell-command cmd insert))) + (shell-command command output-buffer error-buffer))) ;;; LOCAL VARIABLES FOR DIRED BUFFERS. -;;; Brief Description: +;; Brief Description: ;;; -;;; * `dired-extra-startup' is part of the `dired-mode-hook'. +;; * `dired-extra-startup' is part of the `dired-mode-hook'. ;;; -;;; * `dired-extra-startup' calls `dired-hack-local-variables' +;; * `dired-extra-startup' calls `dired-hack-local-variables' ;;; -;;; * `dired-hack-local-variables' checks the value of +;; * `dired-hack-local-variables' checks the value of ;;; `dired-local-variables-file' ;;; -;;; * Check if `dired-local-variables-file' is a non-nil string and is a +;; * Check if `dired-local-variables-file' is a non-nil string and is a ;;; filename found in the directory of the Dired Buffer being created. ;;; -;;; * If `dired-local-variables-file' satisfies the above, then temporarily +;; * If `dired-local-variables-file' satisfies the above, then temporarily ;;; include it in the Dired Buffer at the bottom. ;;; -;;; * Set `enable-local-variables' temporarily to the user variable +;; * Set `enable-local-variables' temporarily to the user variable ;;; `dired-enable-local-variables' and run `hack-local-variables' on the ;;; Dired Buffer. @@ -905,8 +914,7 @@ dired." (message "File `./%s' already exists." dired-local-variables-file) ;; Create `dired-local-variables-file'. - (save-excursion - (set-buffer (get-buffer-create " *dot-dired*")) + (with-current-buffer (get-buffer-create " *dot-dired*") (erase-buffer) (insert "Local Variables:\ndired-omit-mode: t\nEnd:\n") (write-file dired-local-variables-file) @@ -919,37 +927,37 @@ dired." ;;; GUESS SHELL COMMAND. -;;; Brief Description: +;; Brief Description: ;;; -;;; `dired-do-shell-command' is bound to `!' by dired.el. +;; `dired-do-shell-command' is bound to `!' by dired.el. ;;; -;;; * Redefine `dired-do-shell-command' so it calls +;; * Redefine `dired-read-shell-command' so it calls ;;; `dired-guess-shell-command'. ;;; -;;; * `dired-guess-shell-command' calls `dired-guess-default' with list of +;; * `dired-guess-shell-command' calls `dired-guess-default' with list of ;;; marked files. ;;; -;;; * Parse `dired-guess-shell-alist-user' and +;; * Parse `dired-guess-shell-alist-user' and ;;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP ;;; that matches the first file in the file list. ;;; -;;; * If the REGEXP matches all the entries of the file list then evaluate +;; * If the REGEXP matches all the entries of the file list then evaluate ;;; COMMAND, which is either a string or a Lisp expression returning a ;;; string. COMMAND may be a list of commands. ;;; -;;; * Return this command to `dired-guess-shell-command' which prompts user -;;; with it. The list of commands is temporarily put into the history list. +;; * Return this command to `dired-guess-shell-command' which prompts user +;;; with it. The list of commands is put into the list of default values. ;;; If a command is used successfully then it is stored permanently in ;;; `dired-shell-command-history'. -;;; Guess what shell command to apply to a file. +;; Guess what shell command to apply to a file. (defvar dired-shell-command-history nil "History list for commands that read dired-shell commands.") -;;; Default list of shell commands. +;; Default list of shell commands. -;;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not -;;; install GNU zip's version of zcat. +;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not +;; install GNU zip's version of zcat. (defvar dired-guess-shell-alist-default (list @@ -1054,6 +1062,8 @@ dired." '("\\.dvi$" "xdvi" "dvips") ; preview and printing '("\\.au$" "play") ; play Sun audiofiles '("\\.mpe?g$\\|\\.avi$" "xine -p") + '("\\.ogg$" "ogg123") + '("\\.mp3$" "mpg123") '("\\.wav$" "play") '("\\.uu$" "uudecode") ; for uudecoded files '("\\.hqx$" "mcvert") @@ -1113,6 +1123,9 @@ to a string. If several COMMANDs are given, the first one will be the default and the rest will be added temporarily to the history and can be retrieved with \\[previous-history-element] (M-p) . +The variable `dired-guess-shell-case-fold-search' controls whether +REGEXP is matched case-sensitively. + You can set this variable in your ~/.emacs. For example, to add rules for `.foo' and `.bar' files, write @@ -1126,11 +1139,17 @@ You can set this variable in your ~/.emacs. For example, to add rules for :group 'dired-x :type '(alist :key-type regexp :value-type (repeat sexp))) +(defcustom dired-guess-shell-case-fold-search t + "If non-nil, `dired-guess-shell-alist-default' and +`dired-guess-shell-alist-user' are matched case-insensitively." + :group 'dired-x + :type 'boolean) + (defun dired-guess-default (files) "Guess a shell commands for FILES. Return command or list of commands. See `dired-guess-shell-alist-user'." - (let* ((case-fold-search t) + (let* ((case-fold-search dired-guess-shell-case-fold-search) ;; Prepend the user's alist to the default alist. (alist (append dired-guess-shell-alist-user dired-guess-shell-alist-default)) @@ -1165,59 +1184,31 @@ See `dired-guess-shell-alist-user'." (defun dired-guess-shell-command (prompt files) "Ask user with PROMPT for a shell command, guessing a default from FILES." - (let ((default (dired-guess-default files)) - default-list old-history val (failed t)) - + default-list val) (if (null default) ;; Nothing to guess (read-from-minibuffer prompt nil nil nil 'dired-shell-command-history) - - ;; Save current history list - (setq old-history dired-shell-command-history) - (if (listp default) - ;; More than one guess (setq default-list default default (car default) prompt (concat prompt (format "{%d guesses} " (length default-list)))) - ;; Just one guess (setq default-list (list default))) + ;; Put the first guess in the prompt but not in the initial value. + (setq prompt (concat prompt (format "[%s] " default))) + ;; All guesses can be retrieved with M-n + (setq val (read-from-minibuffer prompt nil nil nil + 'dired-shell-command-history + default-list)) + ;; If we got a return, then return default. + (if (equal val "") default val)))) - ;; Push all guesses onto history so that they can be retrieved with M-p - ;; and put the first guess in the prompt but not in the initial value. - (setq dired-shell-command-history - (append default-list dired-shell-command-history) - prompt (concat prompt (format "[%s] " default))) - - ;; The unwind-protect returns VAL, and we too. - (unwind-protect - ;; BODYFORM - (progn - (setq val (read-from-minibuffer prompt nil nil nil - 'dired-shell-command-history) - failed nil) - ;; If we got a return, then use default. - (if (equal val "") - (setq val default)) - val) - - ;; UNWINDFORMS - ;; Undo pushing onto the history list so that an aborted - ;; command doesn't get the default in the next command. - (setq dired-shell-command-history old-history) - (if (not failed) - (or (equal val (car-safe dired-shell-command-history)) - (setq dired-shell-command-history - (cons val dired-shell-command-history)))))))) - - -;;; REDEFINE. -;;; Redefine dired-aux.el's version: +;; REDEFINE. +;; Redefine dired-aux.el's version: (defun dired-read-shell-command (prompt arg files) "Read a dired shell command prompting with PROMPT (using read-string). ARG is the prefix arg and may be used to indicate in the prompt which @@ -1232,6 +1223,8 @@ This is an extra function so that you can redefine it." ;;; RELATIVE SYMBOLIC LINKS. +(declare-function make-symbolic-link "fileio.c") + (defvar dired-keep-marker-relsymlink ?S "See variable `dired-keep-marker-move'.") @@ -1316,27 +1309,27 @@ for more info." ;;; VISIT ALL MARKED FILES SIMULTANEOUSLY. -;;; Brief Description: +;; Brief Description: ;;; -;;; `dired-do-find-marked-files' is bound to `F' by dired-x.el. +;; `dired-do-find-marked-files' is bound to `F' by dired-x.el. ;;; -;;; * Use `dired-get-marked-files' to collect the marked files in the current +;; * Use `dired-get-marked-files' to collect the marked files in the current ;;; Dired Buffer into a list of filenames `FILE-LIST'. ;;; -;;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with +;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with ;;; `dired-do-find-marked-files''s prefix argument NOSELECT. ;;; -;;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the +;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the ;;; list each time. ;;; -;;; * If NOSELECT is non-nil then just run `find-file-noselect' on each +;; * If NOSELECT is non-nil then just run `find-file-noselect' on each ;;; element of FILE-LIST. ;;; -;;; * If NOSELECT is nil then calculate the `size' of the window for each file +;; * If NOSELECT is nil then calculate the `size' of the window for each file ;;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is ;;; cognizant of the window-configuration. ;;; -;;; * If `size' is too small abort, otherwise run `find-file' on each element +;; * If `size' is too small abort, otherwise run `find-file' on each element ;;; of FILE-LIST giving each a window of height `size'. (defun dired-do-find-marked-files (&optional noselect) @@ -1398,7 +1391,7 @@ NOSELECT the files are merely found but not selected." ;;; MISCELLANEOUS COMMANDS. -;;; Run man on files. +;; Run man on files. (defun dired-man () "Run man on this file. Display old buffer if buffer name matches filename. @@ -1411,14 +1404,14 @@ Uses `man.el' of \\[manual-entry] fame." "Man command: " (list file))))) (Man-getpage-in-background file))) -;;; Run Info on files. +;; Run Info on files. (defun dired-info () "Run info on this file." (interactive) (info (dired-get-filename))) -;;; Run mail on mail folders. +;; Run mail on mail folders. ;; Avoid compiler warning. (eval-when-compile @@ -1458,12 +1451,14 @@ See also variable `dired-vm-read-only-folders'." ;;; MISCELLANEOUS INTERNAL FUNCTIONS. +(declare-function dired-old-find-buffer-nocreate "dired-x") + (or (fboundp 'dired-old-find-buffer-nocreate) (fset 'dired-old-find-buffer-nocreate (symbol-function 'dired-find-buffer-nocreate))) -;;; REDEFINE. -;;; Redefines dired.el's version of `dired-find-buffer-nocreate' +;; REDEFINE. +;; Redefines dired.el's version of `dired-find-buffer-nocreate' (defun dired-find-buffer-nocreate (dirname &optional mode) (if (and dired-find-subdir ;; don't try to find a wildcard as a subdirectory @@ -1494,33 +1489,31 @@ See also variable `dired-vm-read-only-folders'." (setq list (cdr list))) more-recent))) -;;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 -;;; (defun dired-buffers-for-dir-exact (dir) -;;; ;; Return a list of buffers that dired DIR (a directory or wildcard) -;;; ;; at top level, or as subdirectory. -;;; ;; Top level matches must match the wildcard part too, if any. -;;; ;; The list is in reverse order of buffer creation, most recent last. -;;; ;; As a side effect, killed dired buffers for DIR are removed from -;;; ;; dired-buffers. -;;; (let ((alist dired-buffers) result elt) -;;; (while alist -;;; (setq elt (car alist) -;;; alist (cdr alist)) -;;; (let ((buf (cdr elt))) -;;; (if (buffer-name buf) -;;; ;; Top level must match exactly against dired-directory in -;;; ;; case one of them is a wildcard. -;;; (if (or (equal dir (save-excursion (set-buffer buf) -;;; dired-directory)) -;;; (assoc dir (save-excursion (set-buffer buf) -;;; dired-subdir-alist))) -;;; (setq result (cons buf result))) -;;; ;; else buffer is killed - clean up: -;;; (setq dired-buffers (delq elt dired-buffers))))) -;;; result)) - -;;; REDEFINE. -;;; Redefines dired.el's version of `dired-initial-position' +;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 +;; (defun dired-buffers-for-dir-exact (dir) +;; ;; Return a list of buffers that dired DIR (a directory or wildcard) +;; ;; at top level, or as subdirectory. +;; ;; Top level matches must match the wildcard part too, if any. +;; ;; The list is in reverse order of buffer creation, most recent last. +;; ;; As a side effect, killed dired buffers for DIR are removed from +;; ;; dired-buffers. +;; (let ((alist dired-buffers) result elt) +;; (while alist +;; (setq elt (car alist) +;; alist (cdr alist)) +;; (let ((buf (cdr elt))) +;; (if (buffer-name buf) +;; ;; Top level must match exactly against dired-directory in +;; ;; case one of them is a wildcard. +;; (if (or (equal dir (with-current-buffer buf dired-directory)) +;; (assoc dir (with-current-buffer buf dired-subdir-alist))) +;; (setq result (cons buf result))) +;; ;; else buffer is killed - clean up: +;; (setq dired-buffers (delq elt dired-buffers))))) +;; result)) + +;; REDEFINE. +;; Redefines dired.el's version of `dired-initial-position' (defun dired-initial-position (dirname) "Where point should go in a new listing of DIRNAME. Point assumed at beginning of new subdir line. @@ -1636,8 +1629,8 @@ Similarly for `dired-x-find-file-other-window' over `find-file-other-window'. If you change this variable after `dired-x.el' is loaded then do \\[dired-x-bind-find-file].") -;;; Bind `dired-x-find-file{-other-window}' over wherever -;;; `find-file{-other-window}' is bound? +;; Bind `dired-x-find-file{-other-window}' over wherever +;; `find-file{-other-window}' is bound? (defun dired-x-bind-find-file () "Bind `dired-x-find-file' in place of `find-file' \(or reverse\). Similarly for `dired-x-find-file-other-window' and `find-file-other-window'. @@ -1664,8 +1657,8 @@ This function is part of `after-init-hook'." ;; Clear mini-buffer. (message nil)) -;;; Now call it so binding is correct and put on `after-init-hook' in case -;;; user changes binding. +;; Now call it so binding is correct and put on `after-init-hook' in case +;; user changes binding. (dired-x-bind-find-file) (add-hook 'after-init-hook 'dired-x-bind-find-file) @@ -1750,8 +1743,8 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." ;; Fixme: get rid of this later. -;;; This section is provided for reports. It uses Barry A. Warsaw's -;;; reporter.el which is bundled with GNU Emacs v19. +;; This section is provided for reports. It uses Barry A. Warsaw's +;; reporter.el which is bundled with GNU Emacs v19. (defconst dired-x-help-address "bug-gnu-emacs@gnu.org" "Address(es) accepting submission of reports on dired-x.el.")