;;; This file contains a bunch of commands to make the emacs shell
;;; environment better, or at least more to my liking. Functionality
;;; added or changed include:
;;;
;;; - Follow the directory: display the directory in the minibuffer after
;;;     every completed command, and track all changes. 
;;; - print out time taken for shell commands. As a bonus, it will also
;;;     "beep" if the bottom of the shell window is not visible in emacs.
;;; - Jump to the next or previous command (didn't work properly for 
;;;     earlier)
;;; - replace the shell command with one that opens multiple shells easier
;;; - make beginning-of-line work properly with the shell
;;; - display CPU activity (vmstat) in the mode line
;;; - allow use of shell CD nicknames in the minibuffer for reading or 
;;;     writing files
;;; - do replacement and completion of directories in CD lines - that is,
;;;     to change to directory /abc/def/ghi/jkl you can type 
;;;     "cd /a d g j". This is the same functionality implemented in the
;;;     MYCD shell script for bash shell, but this works for any shell
;;;     in the emacs buffer - and works for DOS path names too
;;; - Maintain a directory history, implementing "cd -" to switch to the
;;;     previous directory, and "cd =" to provide a menu of previous 
;;;     directories (works in conjunction with previous feature - 
;;;     "cd - .." goes to one up from the rpevious directory)
;;;
;;; There is some interconnection between some of these functions, so
;;; things are not guaranteed to work if you select only some of the
;;; functionality. If you select it all it is not guaranteed to work
;;; either.
;;;
;;; emacs@young-0.com

(defvar use-ansi-color t)
(defvar remote-host nil
  "keeps remote windows from messing with emacs directory")
(defvar remote-directory nil
  "keeps remote windows from messing with emacs directory")
(make-variable-buffer-local 'remote-host)
(make-variable-buffer-local 'remote-directory)

(defun is-dos () (string-match ";c:" (getenv "PATH")))
(defun is-unix() (not (is-dos)))

(when (is-dos)
  ;; Sets the dos prompt properly so emacs can find it.
  ;; For Unix the init file should have something like
  ;;	set prompt="RWY>%/<RWY> " only for emacs, of course.
  (defun set-dos-prompt ()
	(send-invisible "prompt RWY$G$P$LRWY$G ")
	)
  ;; Change the path separator for dos
  (defvar *no-dos-seps* ())
  (defun dos-pathize-string (string &optional unix) 
	"Change path separators in a string from / to \ or the other way around
If UNIX is nil then all '/'s are changed to '\'. To keep a '/' in the string 
double it to '//'. If UNIX is t then all '\'s are changed to '/'."
	(let* ((from (if unix "\\" "/"))
		   (to (if unix "/" "\\"))
		   (regexp (concat (regexp-quote from) "\\(" (regexp-quote from) "\\)?"))
		   (start -1))
	  (while (setq start (string-match regexp string (1+ start)))
		(setq string (replace-match (if (match-beginning 1) from to) nil t string))))
	string)

  (defun dos-pathize (&optional unix)
	"Change path separators on the current line from / to \ or the other way around
If UNIX is nil then all '/'s are changed to '\'. To keep a '/' in the string 
double it to '//'. If UNIX is t then all '\'s are changed to '/'."
	(interactive)
	(if (not (member (buffer-name) *no-dos-seps*))
		(let* ((from (if unix "\\" "/"))
			   (to (if unix "/" "\\"))
			   (regexp (concat (regexp-quote from) "\\(" (regexp-quote from) "\\)?"))
			   (point (point))
			  (end (line-end-position)))
		  (beginning-of-line)
		  (while (re-search-forward regexp end t)
			(replace-match (if (match-beginning 1) from to) nil t))
		  (goto-char point))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Track the prompt. My company uses very long directory names,
;; and if they are displayed in the prompt the lines are all too
;; long. This stuff removes the directory from the prompt and displays
;; it in the minibuffer. It also reliably tracks the current
;; directory.
;;
;; It might be good if you use this also to alias "cd" so it prints
;; out the new directory when it is changed. This way when you review
;; the shell buffer you can find which directory you were in at any
;; point.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *visible-prompt* "[-:a-zA-Z0-9/_# ]*[%$>] "
  "A RE matching the prompt that should be echoed in the shell")

;;; so the actual prompt should be, for instance,
;;; "RWY>/the/directory/goes/here<RWY% " if you want to see a prompt of "% "
(defvar *hidden-prompt* "RWY>\\(.*\\)<RWY"
  "A RE coming at the front of the actual prompt that passes directory info and is stripped off
Must contain a grouping for the directory")

(defvar cd-dir-stack ()
  "Holds the shell CD history")
(make-variable-buffer-local 'cd-dir-stack)
(defvar cd-dir-stack-size 10
  "Maximum number of directories to keep in the shell history")

;;; The command to switch drives cannot be sent to dos during the
;;; CD because there is still a command pending. Use DOS-HACK to
;;; save the change request until it can be safely sent. This 
;;; requires both cd tracking and cd shortcuts to be used - search
;; this file for `dos-hack'

(defvar dos-hack nil
  "used to make drive match for dos")
(make-variable-buffer-local 'dos-hack)

(defvar es-max-title-length 70
  "Maximum length to use when displaying the current dir in the frame title.
If the dir name exceeds this length it is truncated from the beginning 
so it is shorter."
)

(defun count-shells ()
  (reduce (lambda (x y) (if (string-match "\*shell\*" (buffer-name y)) (1+ x) x)) (cons 0 (buffer-list)))
  )

(defvar es-dir-in-minibuffer t
  "display the current directory in the minibuffer after shell command completion")
(defvar es-dir-in-title t
  "display the current directory in the frame title after shell command completion
If there are more than one shells open the shell buffer name is prepended to 
the directory. Also, if the name is longer than ES-MAX-TITLE-LENGTH then it is
trincated from the front so it does not exceed that length")
  
(defun es-display-dir (dir &optional no-frame)
  (and es-dir-in-minibuffer (message dir))
  (and (not no-frame) 
	   es-dir-in-title
	   (let ((len (length dir))
			 (shell (if (> (count-shells) 1) (concat (buffer-name) ": ") ""))
			 )
		 (modify-frame-parameters 
		  nil 
		  (list (cons 'title (concat shell
									 (if (> es-max-title-length len) dir
									   (concat "..." (substring dir (string-match "/" dir (- len es-max-title-length)))))))))
		 )))

(defun my-synch-dirs (text) 
  "Filters the current directory from the prompt and put it in the minibuffer"
  (if (string-match (format "^%s\\(%s.*\\)" *hidden-prompt* *visible-prompt*) text)
	  (let* ((dir (match-string 1 text))
			 (command (concat (substring text 0 (match-beginning 0)) (match-string 2 text)))
			)
		(es-display-dir dir remote-host)
		(if remote-host
			(setq remote-directory dir)
		  (shell-cd dir))    ; update emacs with the current directory
;		(message dir)     ; display directory in message area
		(unless (equal (car cd-dir-stack) dir)
		  (setq cd-dir-stack (cons dir (delete dir cd-dir-stack)))
		  (and cd-dir-stack-size 
			   (> (length cd-dir-stack) cd-dir-stack-size)
			   (setf (nthcdr cd-dir-stack-size cd-dir-stack) nil)))
		(when dos-hack
		  (send-invisible dos-hack)
		  (setq dos-hack nil))
		command)          ; return string sans directory
	text))                ; no directory string, return entire input



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Report on execution time
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar shell-minimum-report-time 5
  "Only report execution times greater than this
nil to disable reporting")

(defvar shell-start-time nil)
(make-variable-buffer-local 'shell-start-time)

(defun shell-timer-start (x) 
  (or shell-start-time (setq shell-start-time (current-time)))
  x)

(defun report-execution-time (text) 
  (if (string-match (concat *visible-prompt* "$") text)
	  (let ((delta (time-diff (current-time) shell-start-time))
			;; beep if location not visible
			(window (get-buffer-window (current-buffer))))
		(if (or (not window)
				(not (pos-visible-in-window-p (buffer-size) window)))
			(beep))
		(setq shell-start-time nil)
		(if (and shell-minimum-report-time (>= delta shell-minimum-report-time))
			(concat "Command took " (format-seconds delta) "\n" text)
		  text
		  ))
	text))

(defun time-diff (a b)
  (if (and a b) (+ (* 65536 (- (first a) (first b))) (- (second a) (second b)))
	0))

(defun plural (x) (if (= x 1) "" "s"))
(defun format-seconds (secs)
  (let* (result hours mins h-s m-s s-s)
	(setq hours (/ secs 3600)
		  secs (- secs (* hours 3600))
		  mins (/ secs 60)
		  secs (- secs (* 60 mins)))
	(if (> hours 0)
		(format "%s hour%s %s minute%s %s second%s" hours (plural hours) mins (plural mins) secs (plural secs))
	  (if (> mins 0)
		  (format "%s minute%s %s second%s" mins (plural mins) secs (plural secs))
		(format "%s second%s" secs (plural secs))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; These functions do not work as I am used to. I assume there is some
;; way to configure emacs to do what I want, but it is faster to
;; replace the original functions.
;;
;; These functions all require font-lock to be on in the shell.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun test-for-prompt (ptr) 
  (equal (get-char-property ptr 'face) 'comint-highlight-prompt))

(defun prev-command (&optional blank)
  (interactive)
  (backward-char)
  ;; skip empty command lines
  (if (not (re-search-backward (concat "^" *visible-prompt* (if blank "[\n.]" ".")) nil t))
	  (forward-char)
	(forward-char (- (match-end 0) (match-beginning 0) 1))
	(unless (test-for-prompt (- (point) 2))
	  (backward-char 3)
	  (prev-command))))

(defun next-command (&optional blank)
  (interactive)
  (if (not (re-search-forward (concat "^" *visible-prompt* (if blank "[\n.]" ".")) nil t))
	(end-of-buffer)
	(if (test-for-prompt (- (point) 3))
		(backward-char 1)
	  (next-command))
	))

(defun shell-beginning-of-line ()
  (interactive)
  (beginning-of-line)
  (if (test-for-prompt (point))
	  (goto-char (next-char-property-change (point)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Implements all features in this file for shell buffers
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if use-ansi-color (require 'ansi-color))

(defun my-add-hook (hook func)
  (or (member func (symbol-value hook))
	  (setf (symbol-value hook) (cons func (symbol-value hook)))))
;(setq shell-mode-hook nil)
(add-hook 'shell-mode-hook (lambda () 
							 (if use-ansi-color (ansi-color-for-comint-mode-on))
							 ;; time reporting (must preceed directory tracking)
							 (my-add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt)
							 (my-add-hook 'comint-input-filter-functions 'shell-timer-start)
							 (my-add-hook 'comint-preoutput-filter-functions 'report-execution-time)
							 ;; cd shorthand function
							 (my-add-hook 'comint-input-filter-functions 'enhanced-cd)
							 ;; directory following
							 ;; remove the default tracker
							 (remove-hook 'comint-input-filter-functions 'shell-directory-tracker t)
							 (my-add-hook 'comint-preoutput-filter-functions 'my-synch-dirs)
							 (when (is-dos) (set-dos-prompt)
								   (setq comint-process-echoes t)
								   (defadvice comint-send-input (before fix-seperator activate) 
									 ;; Should this always do  it, or just for cd?
									 ;;	       (beginning-of-line) (if (looking-at "cd") (dos-pathize))
									 (dos-pathize))
								   (define-key comint-mode-map '[C-return] 'dos-pathize))
							 ;; force confirmation on kill shell buffers
							 (my-add-hook 'kill-buffer-hook 'confirm-kill-shell)
							 ;; shell adjustment
							 (define-key shell-mode-map "
" 'shell-beginning-of-line)
							 (define-key shell-mode-map "" 'find-file-at-point)
							 (define-key shell-mode-map [\M-up] 'prev-command)
							 (define-key shell-mode-map [\M-down] 'next-command)
							 ;; see global-find.el
							 (define-key shell-mode-map "" 'global-find)
							 (or (member 'expand-dir-nn comint-dynamic-complete-functions)
								 (setq comint-dynamic-complete-functions (cons 'expand-dir-nn comint-dynamic-complete-functions)))
							 )
		  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Replace the M-x shell command with one that will prompt to open up
;; new shell buffers when invoked.  (otherwise you need to change the
;; name of the existing shell buffer before opening a new one)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun get-shell-name () 
  (let ((name (read-from-minibuffer "*shell* exists, new shell name: ")))
	(if (equal name "") nil (concat name "-*shell*"))))


;;; short name so it will supercede shell
(defun shel ()
  (interactive)
  (let ((name (if (get-buffer "*shell*") (get-shell-name) "*shell*")))
	(shell name)))

(defun confirm-kill-shell () 
  "Require confirmation before ^x-k a shell buffer"
  (if (equal major-mode 'shell-mode)
	  (or (y-or-n-p "Really kill a shell buffer? ")
		  (error "Cancelled"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; BONUS: VMSTAT in mode line
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar vmstat-save-output t
  "if non-nil keep the output in the vmstat buffer, otherwise discard")

(defvar vmstat-default-interval 2
  "Default interval to use for vmstat command")

(defvar vmstat-auto-off 600
  "If numeric, will shut off vmstat after that number of seconds
(nil to disable)")

(defvar vmstat-path "/bin/vmstat"
  "path to vmstat command")

(defvar vmstat-start-time nil)
(defvar vmstat-buffer "*vmstat*")
(defvar vmstat-mode-string nil
  "String to add to mode line to display vmstat results")

(or (member 'vmstat-mode-string global-mode-string)
	(setq global-mode-string (append global-mode-string (list 'vmstat-mode-string))))

(global-set-key "" 'vmstat)

(make-face 'vm-stress-face)
(set-face-background 'vm-stress-face "red")

(defun vm-set-stress (props stress)
  (if stress (append props '(face vm-stress-face)) props))

(defun vmstat-filter (string)
  (if (and vmstat-auto-off 
		   (< vmstat-auto-off (time-diff (current-time) vmstat-start-time)))
	  (vmstat-off)
	(if (string-match "\\([0-9]+\\) +\\([0-9]+\\) +\\([0-9]+\\)$" string)
	  (let* ((user (concat " U:" (match-string 1 string)))
			 (sys (concat " S:" (match-string 2 string)))
			 (idle (concat " I:" (match-string 3 string)))
			 (ptr 1))
		(add-text-properties 1 (length user) (vm-set-stress '(help-echo "User CPU") (string-match ":[5-9]." user)) user)
		(add-text-properties 1 (length sys) (vm-set-stress '(help-echo "System CPU") (string-match ":[5-9]." sys)) sys)
		(add-text-properties 1 (length idle) (vm-set-stress '(help-echo "Idle CPU") (string-match ":1?.$" idle)) idle)
		(setq vmstat-mode-string (concat user sys idle))
		)))
	(if vmstat-save-output string ""))

(defun vmstat-off ()
  (when vmstat-start-time
	(set-buffer (get-buffer-create vmstat-buffer))
	(and (get-process "vmstat") (comint-kill-subjob))      ; shut off currently running process
	(setq vmstat-mode-string nil
		  vmstat-start-time nil)))

(defun vmstat-on (secs)
  (set-buffer (get-buffer-create vmstat-buffer))
  (erase-buffer)
  (setq vmstat-start-time (current-time))
  ;; The following should not be needed, but seems to be anyway
  (make-variable-buffer-local 'comint-preoutput-filter-functions)
  (setq comint-preoutput-filter-functions nil)
  (add-hook 'comint-preoutput-filter-functions 'vmstat-filter)
  (make-comint-in-buffer "vmstat" vmstat-buffer vmstat-path nil (number-to-string secs)))

(defun vmstat (&optional secs)
  "Toggles displaying CPU activity in the mode line
If called with SECS a positive int runs vmstat with that delay. If
SECS is <= 0 or nonnumeric stop vmstat. If not given, use
vmstat-default-interval as repeat time. Also see vmstat-auto-off."
  (interactive)
  (if (or vmstat-start-time 
		  (and secs (or (not (numberp secs)) (<= secs 0))))
	  (vmstat-off)
	(vmstat-on (or secs current-prefix-arg vmstat-default-interval))
	))
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; CD Aliasing:
;;
;; Some shells, like C shell or TCSH, allow CD aliasing where if a
;; string does not match a subdirectory of the given directory, it is
;; interpreted as a shell variable, and if it exists with a value
;; beginning with "/", the shell does a CD to it. These definitions
;; let the emacs minibuffer use the same definitions.
;;
;; To access them preceed the path segment with a comma. For instance,
;; if there is a shell variable
;; wa=/users/home/me/a/long/complicated/path you can edit files there
;; by ^X^F, and for the path type ",nn" followed by TAB or SPACE to go
;; to the same directory.
;; 
;; To use, in your .emacs load this file and call the function
;; (get-nicks-from-shell) to set up the directory nicknames
;;
;; For non-unix systems the variable dir-nickname-alist can be set
;; directly. It is an alist composed of (nickname . directory_name). 
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;; Configuration variables
(defvar nn-max-length 3
  "Maximum length of nickname to allow")

(defvar nn-ignore-list '("owd" "cwd")
  "Aliases to skip when setting up the directory nickname list
These are other short variable names in the shell which will appear
as directory aliases unless explicitely removed.")

(defvar nn-default-dest "~"
  "Destination to use for empty alias '(that is, path of 'xxxxx/,')")

(defvar dir-nickname-alist nil
  "Nicknames to expand, filled in by get-nicks-from-shell
For non-unix systems this can be filled in manually as an alist of
pairs '(nickname . directory_name)")

(defvar nn-prefix ","
  "prefix used to signal a nickname expansion")
(defun show-nicknames ()
  "Display a list of available nicknames in the minibuffer
'(it helps to have resize-minibuffer-mode on)"
  (interactive) 
  (message (mapconcat (lambda (x) (format "%s%s: %s" nn-prefix (car x) (cdr x))) dir-nickname-alist "\n"))
  )

(defun get-nname-dir (name) 
  (if (and (stringp name)
		   (string-match "\\([^,;]*\\)\\(;\\([a-z0-9]+\\)\\)?$" name))
      (let* ((nname (match-string 1 name))
			 (start-dir (cdr (assoc nname dir-nickname-alist)))
			 (substitute (match-string 3 name)))
		(or (and substitute
				 (replace-in-string (getenv "LOGNAME") (user-complete substitute) start-dir))
			start-dir))))

(defun dir-nickname (op name &rest args)
  (let ((inhibit-file-name-handlers
		 (cons 'dir-nickname
			   (and (eq inhibit-file-name-operation op)
					inhibit-file-name-handlers)))
		(inhibit-file-name-operation op))
    (apply op (or (get-nname-dir name) name) args)))

(defun get-nicks-from-shell (&optional no-init)
  "Opens a shell to get a list of shell variables, and finds which are legal aliases"
  (let ((str (shell-command-to-string "set"))
		(ptr 0)
		(nicknames (if no-init ()
					 (list (cons "" nn-default-dest))))      ; home dir
		nn dir)
	(while (string-match "\n\\([a-zA-Z0-9_]+\\)\t\\(/[^:,\n]+\\)\n" str ptr)
	  (setq ptr (match-end 2)
			nn (match-string 1 str)
			dir (match-string 2 str)
			dir (if (string-match "/$" dir) dir (concat dir "/")))
	  ;; check if the current variable def is (probably) an alias
	  (if (and (<= (length nn) nn-max-length)            ; length looks good
			   (not (assoc nn nicknames))       ; not already included
			   (not (member nn nn-ignore-list))          ; not on ignore list
			   (file-directory-p dir))                   ; is a directory
		  (setq nicknames (cons (cons nn dir) nicknames)))
	  )
	nicknames))

(defun replace-nn (old new)
  "replace a nickname with its expanded version
Point should be one before the start of the nickname"
  (forward-char)
  (delete-char (length old))
  (insert new)
  t)

(defun expand-dir-nn ()
  "Expand the directory nickname at point"
  (interactive)
  (if (re-search-backward "[^a-z0-9]\\([a-z0-9]+\\)\\=" nil t)
	  (let* ((curr (match-string 1))
			 (point (match-end 0))
			 (dir (cdr (assoc curr dir-nickname-alist))))
		(if dir (replace-nn curr dir)
		  (goto-char point)
		  nil))))



;; build the list of nicknames
;; Notice that if a non-default value of nn-default-dest is desired
;; it must be set before this, or get-nicks-from-shell must be called
;; again after it has been set.
;; This must be run to update the variable whenever a new shell
;; variable is set.
(if (is-unix) (setq dir-nickname-alist (get-nicks-from-shell)))

;;; This puts expansion into the regular minibuffer keys
(let* ((exp-re (format "/,[^/,;]\\{0,%s\\}\\(;[a-z0-9]+\\)?$" nn-max-length))
	   (entry (cons exp-re 'dir-nickname))
	   )
  (if (not (member entry file-name-handler-alist))
      (setq file-name-handler-alist (cons entry file-name-handler-alist)))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This emulates my MYCD shell script - it allows typing of cd with
;; expansion and aliases. For instance, "cd em li pro" on my machine
;; will go to /usr/local/share/emacs/21.1/lisp/progmodes, assuming $em
;; points to /usr/local/share/emacs/21.1. Subsequent arguments are
;; appended directly if they are complete directory names, if not it
;; looks for directories beginning with that string. If there is just
;; one, it changes to it silently, if more than one it offers a menu
;; of selections.
;;
;; If the first directory is '-' it is replaced with the previous directory
;; (as is done in many shells). If it is '=' emacas puts up a menu of
;; previous directories to select from.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar cd-selection-menu-size 10
  "maximum size of menu to display
I think Emacs limits this to 10 or so.")

(defvar cd-show-hidden nil
  "Determines whether to show hidden files on selection menu")

(defvar cd-trailing-options t
  "Enhanced CD: Put the menu selection letter both before and after the choice
Useful if the directories in the menu are very long")

(defvar cd-replace-target-string nil
  "If non-nil, replace the entered target string with the actual new directory")

(defvar cd-use-menus t
  "Use menus to select the new directory via interactive cd (from typing '?')
If nil then use minibuffer completion"
)

;; useful little functions
(defun trim (str) 
  "trim whitespace from the front and back of a string"
;  (string-match "^[ \t\n]*\\(\\(.\\|\n\\)*\\)[ \t\n]*$" str)
;  (match-string 1 str))
  (let* ((whitespace "[ \t\n]*")
		 (start (progn (string-match (concat "^" whitespace) str) (match-end 0)))
		 (end (progn (string-match (concat whitespace "$") str) (match-beginning 0))))
	(substring str start end)))

(defun xor (a b)
  (or (and a (not b)) (and (not a) b)))

(defun flatten (a &optional include-nil)
  "Useful function to flatten nested lists into a single level one
Normally nil is treated as an empty list, and removed. If INCLUDE-NIL
is non-nil then nil is treated as an element, and included in the output"
  (if include-nil 
	  (mapcan (lambda (x) (if (and (listp x) x) (flatten x t) (list x))) a)
	(mapcan (lambda (x) (if (listp x) (flatten x nil) (list x))) a)))

(defun trailing-/ (path)
  "Make sure a path ename ends with /"
  (save-match-data
	(if (string-match "/$" path) path (concat path "/"))))

(defun *-to-re (string)
  "Makes a RE out of a path name - replaces '*' with '\\\\*' and '.' with '\\\\.'"
  (let ((ptr 0)
		(new "")
		(optr 0))
	(while (setq ptr (string-match "\\*\\|\\." string ptr))
	  (setq new (concat new (substring string optr ptr) 
						(if (equal (match-string 0 string) "*") ".*" "\\."))
			ptr (1+ ptr)
			optr ptr))
	(concat "^" new (substring string optr))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Main functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun enhanced-cd (text)
  "Provides several shorthand ways of entering a directory to CD to in a shell
These include:
    - : switches to the previous directory
    -- : switches to the 2nd previous directory
    = : displays a menu of previous directories to select from
    ? : allows interactive entering of the directory through minibuffer completion
        or menu selection
    p1 p2 p3... : looks for a path p1*/p2*/p3*..., presenting a menu to
        select from if their is more than one choice.
        P1 can be absolute or relative, or it can be a shell variable
        referring to a directory - that is, if em = '/usr/local/share/emacs/21.1/'
        then 'cd em pro' will cd to /usr/local/share/emacs/21.1/progmodes.
    ;stub : replace the current user name with the user obtained by completing STUB.
        (this is a special function useful at my company, which uses very long
        directory names with the user name embedded a couple places)
On a dos machine it converts the path name from using '\\' as a
separator to '/' internally, and then back. It will also take a drive
name under dos, and will switch to the proper drive after changing the
directory.

Menu selection displays a page of up to `cd-selection-menu-size' choices. If 
there are more they can be paged through using SPACE to page down and BACKSPACE 
to page up. ENTER selects the current level.
"
  
  (if (is-dos) (setq text (dos-pathize-string text t))) ; make unix pathname
  (and (not remote-host)
	   (string-match "^ *cd +\\(;\\([a-z]+\\) *\\)?\\([a-z]:\\)?\\(/\\|--?\\|~\\|=\\|\\([^ \n]*\\)\\)" text)
	   (let* ((substitute (match-string 2 text))
			  (start (match-end 4))
			  (drive (match-string 3 text))	; for dos only
			  (first (match-string 4 text))
			  (dir (cond ((equal first "-")	(second cd-dir-stack))
						 ((equal first "--")	(third cd-dir-stack))
						 ((equal first "=")	(choose-subdir (cdr cd-dir-stack) default-directory))
						 ((equal first "/")	(concat (or drive "") "/"))
						 ((equal first "~") (getenv "HOME"))
						 ((equal first "") (getenv "HOME"))
						 (t (cdr (assoc first dir-nickname-alist))))))
		 (or dir (setq start (match-beginning 4)
					   dir (or drive default-directory)))
		 (if substitute (setq dir (replace-in-string (getenv "LOGNAME") (user-complete substitute) dir)))
		 (setq dir (cd-expand-dir (trailing-/ dir) text start))
		 (and dir (listp dir) 
			  (setq dir (choose-subdir (flatten dir) default-directory)))
		 ;; result is here, below is simply processing it
		 (if (not dir) (cd-report-error)
		   (setq dir (expand-file-name dir))
		   (if (is-dos) (setq dir (cd-back-to-dos dir)))
		   (replace-command text (concat "cd " dir))))))

(defun cd-expand-dir (dir string start)
  (setq dir (trailing-/ dir))
  (if (string-match " *\\([^ \n/]+\\)\\(/\\)?" string start)
	  (let* ((start (match-end 0))
			 (curr (match-string 1 string))
			 (complete (match-end 2))
			 (path (concat dir curr))
			 (result (cond ((equal curr "?") (interactive-cd dir))
						   ((file-directory-p path) (cd-expand-dir path string start))
						   ((and complete (string-match "\\*" curr)) nil)
						   (t (remove nil (mapcar (lambda (x) (cd-expand-dir (concat dir x) string start)) 
												  (directory-subdirs dir (*-to-re curr))))))))
		(or (and (listp result) (= (length result) 1) (car result))
			result))
	dir))

(defun cd-report-error ()
  ;; I like this error report better
  (insert "No matching directories\n")
  (setq input "")
;  (message "No matching directory")
;  (beep)
;  (sleep-for 1)
)

(defun cd-back-to-dos (dir)
  (setq dir (dos-pathize-string dir))
  (string-match "^[a-z]:" dir)
  ;; this way of checking avoids case not matching
  (or (equal 0 (string-match (substring dir 0 2) (car cd-dir-stack)))
	  (setq dos-hack (substring dir 0 2)))
  dir)

(defun replace-command (old new)
  "replaces the original CD target with the computed expanded one"
  ;; NOTICE: This INPUT refers to a value back in comint.el. It must not be changed.
  (setq	input new)
  (when (and cd-replace-target-string (re-search-backward (regexp-quote old) nil t))
	(delete-char (length old))
	(insert (concat new "\n"))))


(defun choose-subdir (candidates curr-dir &optional start)
  "Puts up a menu of choices and has the user select one
If there are more than CD-SELECTION-MENU-SIZE selections it puts up multiple
pages. Active keys:
    SPACE: page down
    BACKSPACE: page up
    ENTER: return current selection"
  (or start (setq start 0))
  (if candidates
	  (let* ((page (nthcdr start candidates))
			 (count (1- ?a))
			 (fstr (if cd-trailing-options "%s\n%c %s %c" "%s\n%c %s" ))
			 (more nil)
			 (message (reduce (lambda (x y) (setq count (1+ count))
								(if (> count (+ ?a cd-selection-menu-size)) 
									(if (not more) (setq more (concat x "\n(more...)")) x)
								  (format fstr x count y count)))
							  (cons (concat "Current: " curr-dir (if (> start 0) "\n(...more)" "")) page)))
;;;		 (choice (- (read-char message)) ?0))  ; read-char limits the message length
			 (choice (progn (message message) (read-char))))
		(cond ((equal choice ? ) (if more (choose-subdir candidates curr-dir (+ start cd-selection-menu-size))))
			  ((equal choice 127) (if (> start 0) (choose-subdir candidates curr-dir (- start cd-selection-menu-size))))
			  ((equal choice ?
) nil)
			  ((and (<= ?a choice) (<= choice count)) (nth (- choice ?a) page))
			  (t (throw 'no-such-dir " Selection out of range"))))))

(defun directory-subdirs (dir &optional regexp) 
  "finds all subdirectories of DIR matching regular expression REGEXP"
  (or (mapcar (lambda (x) (concat x "/")) 
			  (delete* nil (directory-files dir nil regexp) 
					   :test (lambda (x y) (or (not (file-directory-p (concat dir y)))
											   (and  (not cd-show-hidden) (string-match "^\\.[^.]?$" y))))))
	  (and (equal regexp "^") (list "./"))))


;; from dired
(defun replace-in-string (regexp newtext string)
  ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
  ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
  (let ((result "") (start 0) mb me)
    (while (string-match regexp string start)
      (setq mb (match-beginning 0)
	    me (match-end 0)
	    result (concat result (substring string start mb) newtext)
	    start me))
    (concat result (substring string start))))

(defun user-complete (stub)
  (let* ((users (mapcar (lambda (x) (if (not (string-match "^\\." x)) (list x))) (directory-files "/home/user")))
		 (possible (all-completions stub users)))
	(or (and (member stub possible) stub)
		(and (= 1 (length possible)) (car possible))
		(completing-read "User: " users nil t stub))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Completion functions (for interactive selection)
;;
;; Put a ? at the end of a cd string to select the new directory
;; interactively
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun interactive-cd (&optional dir)
  "front end to select between minibuffer completion and menu completion for cd in a shell buffer"
  (if cd-use-menus 
	  (interactive-cd-menu dir)
	(interactive-cd-minibuffer dir))
  )

;; Menu completion
(defun interactive-cd-menu (dir)
  "Use menu selection to select a directory"
  (let ((contrib (choose-subdir (directory-subdirs (expand-file-name dir)) dir)))
	(if contrib (interactive-cd-menu (expand-file-name (concat (trailing-/ dir) contrib))) dir)))

;; minibuffer completion
(defun interactive-cd-minibuffer (&optional dir)
  "Use minibuffer completion to select a directory"
  (let ((result (completing-read "cd to: " 'cd-complete-dirname nil t dir 'cd-dir-stack)))
	(if (file-directory-p result) (trailing-/ result))))

;; minibuffer completion support functions
(defun cd-complete-dirname (string pred var)
  "TABLE function for COMPLETING-READ in INTERACTIVE-CD"
  (let* ((dir (trailing-/ (or (file-name-directory string) default-directory)))
		 (candidates (directory-subdirs (trailing-/ (file-name-directory string)) 
										(concat "^" (file-name-nondirectory string)))))
	(if var candidates
	  (if candidates (expand-file-name (concat dir (reduce (lambda (x y) (substring x 0 (mismatch x y)))
														   candidates)))
		string))))
(provide 'shell-enhancements)