Commit: b68a84da62e37509a68950a416f4b06ed6a1afe2 - myprojects-hg-reborn (hg)

Commit MetaInfo

• Revisión: b68a84da62e37509a68950a416f4b06ed6a1afe2 (tree)
• Tiempo: 2008-06-04 08:59:42
• Autor: iselllo
• Commiter: iselllo

Log Message

I added the file shell-command.el which I need to have autocompletion in a BASG open under emacs.

Cambiar Resumen

• add: emacs_files/shell-command.el

Diferencia incremental

diff -r ef469dfeef4d -r b68a84da62e3 emacs_files/shell-command.el
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/emacs_files/shell-command.el	Tue Jun 03 23:59:42 2008 +0000
@@ -0,0 +1,405 @@
+;;; shell-command.el --- enables tab-completion for `shell-command'
+
+;; Copyright (C) 1998-2007 TSUCHIYA Masatoshi <[e-mail]>
+
+;; Author: TSUCHIYA Masatoshi <[e-mail]>
+;; Keywords: shell
+;; Version: $Revision: 1.38 $
+
+;; This program 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.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This is an enhancement of shell-command, shell-command-on-region,
+;; grep, grep-find, and compile, that enables tab-completion of
+;; commands and dir/filenames within their input contexts.
+
+;; The latest version of this program can be downloaded from
+;; http://namazu.org/~tsuchiya/elisp/shell-command.el.
+
+;;; Install:
+
+;; Install this file to appropriate directory, and put these lines
+;; into your ~/.emacs.
+
+;;     (require 'shell-command)
+;;     (shell-command-completion-mode)
+
+;;; Code:
+(eval-when-compile
+  (require 'shell)
+  (require 'comint))
+
+(eval-and-compile
+  ;; Stuffs to keep compatibility between Emacsen.
+  (if (locate-library "custom")
+      (require 'custom)
+    (or (fboundp 'defgroup)
+	(defmacro defgroup (symbol members doc &rest args) nil))
+    (or (fboundp 'defcustom)
+	(defmacro defcustom (symbol value doc &rest args)
+	  (list 'defvar symbol value doc))))
+  ;; These macros, such as `when' and `unless' are imported from
+  ;; subr.el of Emacs-21.2.
+  (or (fboundp 'when)
+      (progn
+	(defmacro when (cond &rest body)
+	  "If COND yields non-nil, do BODY, else return nil."
+	  (list 'if cond (cons 'progn body)))
+	(put 'when 'edebug-form-spec '(form body))
+	(put 'when 'lisp-indent-function 1)))
+  (or (fboundp 'unless)
+      (progn
+	(defmacro unless (cond &rest body)
+	  "If COND yields nil, do BODY, else return nil."
+	  (cons 'if (cons cond (cons nil body))))
+	(put 'unless 'edebug-form-spec '(form body))
+	(put 'unless 'lisp-indent-function 1))))
+
+(defgroup shell-command nil
+  "Enable Tab completions for `shell-command' and related commands."
+  :group 'shell)
+
+(defcustom shell-command-complete-functions
+  '(shell-dynamic-complete-environment-variable
+    shell-dynamic-complete-command
+    shell-replace-by-expanded-directory
+    comint-dynamic-complete-filename)
+  "*Function list to complete shell commands."
+  :type '(repeat function)
+  :group 'shell-command)
+
+(defcustom shell-command-prompt
+  "Shell command [%w]%$ "
+  "*The prompt string for `shell-command' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom shell-command-on-region-prompt
+  "Shell command on region [%w]%$ "
+  "*Prompt string of `shell-command-on-region' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom shell-command-on-region-prompt-if-region-inactive
+  "Shell command on buffer [%w]%$ "
+  "*Prompt string of `shell-command-on-region' when tab-completion is enabled.
+This string is used if `shell-command-on-region' is called when
+there is no active region.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom grep-prompt
+  "Run grep [%w]%$ "
+  "*Prompt string of `grep' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom grep-find-prompt
+  "Run find [%w]%$ "
+  "*Prompt string of `grep-find' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(defcustom compile-prompt
+  "Compile command [%w]%$ "
+  "*Prompt string of `compile' when tab-completion is enabled.
+Some %-sequences are available to customize this variable.  For more
+detail, see the document of `shell-command-make-prompt-string'."
+  :type 'string
+  :group 'shell-command)
+
+(put 'shell-command/static-if 'lisp-indent-function 2)
+(defmacro shell-command/static-if (cond then &rest else)
+  (if (eval cond) then (cons 'progn else)))
+
+(defun shell-command-make-prompt-string (format-string current-directory) "\
+Function to generate prompt string
+
+Use FORMAT-STRING to generate prompt string at the directory
+CURRENT-DIRECTORY.  The following `%' escapes are available for use in
+FORMAT-STRING:
+
+%d     the date in \"Weekday Month Date\" format \(e.g., \"Tue May 26\"\)
+%h     the hostname up to the first `.'
+%H     the hostname
+%t     the current time in 24-hour HH:MM:SS format
+%T     the current time in 12-hour HH:MM:SS format
+%@     the current time in 12-hour am/pm format
+%u     the username of the current user
+%w     the current working directory
+%W     the basename of the current working directory
+%$     if the effective UID is 0, a #, otherwise a $
+%%     Insert a literal `%'.
+"
+  (let ((case-fold-search nil)
+	start buf
+	(list (list format-string))
+	(alist (let ((system-name (system-name))
+		     host-name
+		     fqdn-name
+		     (time (current-time))
+		     (dir (directory-file-name
+			   (abbreviate-file-name current-directory))))
+		 (shell-command/static-if (featurep 'xemacs)
+		     (cond
+		      ((string= dir (user-home-directory))
+		       (setq dir "~"))
+		      ((string-match (concat "^"
+					     (regexp-quote
+					      (file-name-as-directory
+					       (user-home-directory))))
+				     dir)
+		       (setq dir
+			     (concat "~/" (substring dir (match-end 0)))))))
+		 (if (string-match "^\\([^.]+\\)\\.[^.]" system-name)
+		     (setq fqdn-name system-name
+			   host-name (match-string 1 system-name))
+		   (setq host-name system-name
+			 fqdn-name
+			 (cond
+			  ((and (boundp 'mail-host-address)
+				(stringp mail-host-address)
+				(string-match "\\." mail-host-address))
+			   mail-host-address)
+			  ((and user-mail-address
+				(string-match "\\." user-mail-address)
+				(string-match "@\\(.*\\)\\'"
+					      user-mail-address))
+			   (match-string 1 user-mail-address))
+			  (t system-name))))
+		 `(("%%" . "%")
+		   ("%d" . ,(format-time-string "%a %b %e" time))
+		   ("%h" . ,host-name)
+		   ("%H" . ,fqdn-name)
+		   ("%t" . ,(format-time-string "%H:%M:%S" time))
+		   ("%T" . ,(format-time-string "%I:%M:%S" time))
+		   ("%@" . ,(format-time-string "%I:%M%p" time))
+		   ("%u" . ,(user-login-name))
+		   ("%w" . ,dir)
+		   ("%W" . ,(file-name-nondirectory
+			     (directory-file-name current-directory)))
+		   ("%\\$" . ,(if (= (user-uid) 0) "#" "$"))))))
+    (while alist
+      (setq buf nil)
+      (while list
+	(setq start 0)
+	(while (string-match (car (car alist)) (car list) start)
+	  (setq buf (cons (cdr (car alist))
+			  (cons (substring (car list) start
+					   (match-beginning 0))
+				buf))
+		start (match-end 0)))
+	(setq buf (cons (substring (car list) start) buf)
+	      list (cdr list)))
+      (setq list (nreverse buf)
+	    alist (cdr alist)))
+    (apply 'concat list)))
+
+(defmacro shell-command/minibuffer-prompt-end ()
+  (if (fboundp 'minibuffer-prompt-end)
+      '(minibuffer-prompt-end)
+    '(point-min)))
+
+(defun shell-command-read-minibuffer
+  (format-string current-directory &optional initial-contents
+		 user-keymap read hist)
+  "Read a command string in the minibuffer, with completion."
+  (let ((keymap (make-sparse-keymap))
+	(prompt (shell-command-make-prompt-string
+		 format-string current-directory)))
+    (set-keymap-parent keymap (or user-keymap minibuffer-local-map))
+    (define-key keymap "\t"
+      (lambda ()
+	(interactive)
+	(let ((orig-function (symbol-function 'message)))
+	  (unwind-protect
+	      (progn
+		(defun message (string &rest arguments)
+		  (let* ((s1 (concat prompt
+				     (buffer-substring
+				      (shell-command/minibuffer-prompt-end)
+				      (point-max))))
+			 (s2 (apply (function format) string arguments))
+			 (w (- (window-width)
+			       (string-width s1)
+			       (string-width s2)
+			       1)))
+		    (funcall orig-function
+			     (if (>= w 0)
+				 (concat s1 (make-string w ?\ ) s2)
+			       s2))
+		    (if (sit-for 0.3) (funcall orig-function s1))
+		    s2))
+		(require 'shell)
+		(require 'comint)
+		(run-hook-with-args-until-success
+		 'shell-command-complete-functions))
+	    (fset 'message orig-function)))))
+    (read-from-minibuffer prompt initial-contents keymap read hist)))
+
+;; This local bind of `current-load-list' is requred to keep the
+;; position where real `shell-command' is defined.  If this local bind
+;; is removed, `find-function' will tell that `shell-command' is
+;; defined in shell-command.el instaed of simple.el.
+(let (current-load-list)
+  (defadvice shell-command
+    (before shell-command-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `shell-command-prompt'."
+    (interactive
+     (list
+      (shell-command-read-minibuffer shell-command-prompt
+				     default-directory
+				     nil nil nil 'shell-command-history)
+      current-prefix-arg))))
+
+(let (current-load-list)
+  (defadvice shell-command-on-region
+    (before shell-command-on-region-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  This advice also makes
+`shell-command-on-region' to use this current buffer as its input when
+a region is visible and inactive.
+Its prompt string is kept by `shell-command-on-region-prompt' and
+`shell-command-on-region-prompt-if-region-inactive'."
+    (interactive
+     (let (beg end prompt)
+       (if (shell-command/static-if (featurep 'xemacs)
+	       (and zmacs-regions (not (region-active-p)))
+	     (and transient-mark-mode (not mark-active)))
+	   (setq beg (point-min)
+		 end (point-max)
+		 prompt shell-command-on-region-prompt-if-region-inactive)
+	 (unless (mark)
+	   (error "The mark is not set now, so there is no region"))
+	 (setq beg (region-beginning)
+	       end (region-end)
+	       prompt shell-command-on-region-prompt))
+       (list beg end
+	     (shell-command-read-minibuffer prompt default-directory
+					    nil nil nil 'shell-command-history)
+	     current-prefix-arg
+	     current-prefix-arg
+	     shell-command-default-error-buffer)))))
+
+(let (current-load-list)
+  (defadvice grep
+    (before grep-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `grep-prompt'."
+    (interactive
+     (let (grep-default (arg current-prefix-arg))
+       (unless grep-command
+	 (grep-compute-defaults))
+       (when arg
+	 (let* ((tag-default
+		 (funcall (or find-tag-default-function
+			      (get major-mode 'find-tag-default-function)
+			      'grep-tag-default))))
+	   (setq grep-default (or (car grep-history) grep-command))
+	   (when (string-match
+		  "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)"
+		  grep-default)
+	     (setq grep-default
+		   (replace-match tag-default t t grep-default 2)))))
+       (list (shell-command-read-minibuffer grep-prompt
+					    default-directory
+					    (or grep-default grep-command)
+					    nil nil 'grep-history))))))
+
+(let (current-load-list)
+  (defadvice grep-find
+    (before grep-find-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `grep-find-prompt'."
+    (interactive
+     (progn
+       (unless grep-find-command
+	 (grep-compute-defaults))
+       (list (shell-command-read-minibuffer grep-find-prompt
+					    default-directory
+					    grep-find-command
+					    nil nil 'grep-find-history))))))
+
+(let (current-load-list)
+  (defadvice compile
+    (before compile-with-completion disable compile)
+    "Defined in shell-command.el, to enable tab-completion of commands
+and dir/filenames within the input context.  Its prompt string is kept
+by `compile-prompt'."
+    (interactive
+     (if (or compilation-read-command current-prefix-arg)
+	 (list (shell-command-read-minibuffer compile-prompt
+					      default-directory
+					      (eval compile-command) nil nil
+					      '(compile-history . 1)))
+       (list (eval compile-command))))))
+
+(defun shell-command-custom-set (symbol value)
+  "Set SYMBOL's value to VALUE, and enable or disable tab-completion
+for following commands: `shell-command', `shell-command-on-region',
+`grep', `grep-find' and `compile'."
+  (let ((commands
+	 '(shell-command shell-command-on-region grep grep-find compile)))
+    (while commands
+      (funcall (if value 'ad-enable-advice 'ad-disable-advice)
+	       (car commands)
+	       'before
+	       (intern (concat (symbol-name (car commands))
+			       "-with-completion")))
+      (ad-activate (car commands))
+      (setq commands (cdr commands))))
+  (set-default symbol value))
+
+(defcustom shell-command-completion-mode nil
+  "*Non-nil means that tab-completion for some commands is enabled.
+The commands are `shell-command', `shell-command-on-region', `grep',
+`grep-find' and `compile'."
+  :type 'boolean
+  :set 'shell-command-custom-set
+  :group 'shell-command)
+
+;;;###autoload
+(defun shell-command-completion-mode (&optional arg)
+  "Enable or disable tab-completion for some commands.
+The commands are `shell-command', `shell-command-on-region', `grep',
+`grep-find' and `compile'."
+  (interactive "P")
+  (prog1 (shell-command-custom-set 'shell-command-completion-mode
+				   (if arg
+				       (> (prefix-numeric-value arg) 0)
+				     (not shell-command-completion-mode)))
+    (when (interactive-p)
+      (message "Tab-completion is %s"
+	       (if shell-command-completion-mode "enabled" "disabled")))))
+
+(provide 'shell-command)
+
+;;; shell-command.el ends here