;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; shell-enhancements
;;
;; Provides several enhancements to the emacs shell environment. These include:
;;  - emacs nickname expansion: expands shell directory nicknames in minibuffer
;;      and shell buffer
;;  - dynamic directory tracking: replaces the emacs default directory tracker
;;      with a dynamic one which reads the actual directory from the prompt,
;;      which assures it can't get out of sync
;;  - displays the time a command was rn and its directory in a tooltip over the
;;      command
;;  - reports execution time of shell commands
;;  - puts a marker in the buffer at midnight to make it easy to see when 
;;      commands are typed in a new day
;;
;; In addition, there is the emacs shell cd replacement function
;; 'enhanced-cd.  This provides all the functionality in the shell cd
;; replacement. It was written before I wrote the shell version.
;; Though it is a little nicer, there isn't much reason to use it when
;; the shell version is available, but I left the code here just in case.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'shell-screen)
(eval-and-compile (require 'cl))

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

(defvar nn-prefix ","
  "prefix used to signal a nickname expansion")

(setq es-dir-in-title t)
(defvar es-dir-in-title nil
  "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")

(defvar es-dir-in-minibuffer t
  "display the current directory in the minibuffer after shell command completion")

(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."
)

(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")

;;
;; private variables for system use
;;

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

(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)))

;; 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))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; cd replacement
;;
;; This uses the command line preprocessor (shell-screen) to
;; intercept cd calls and replace the destination of desired.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

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

(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")

(defvar *enhanced-cd-funcs* '(cd-expand-standard 
							  cd-expand-history
							  cd-expand-match 
							  cd-expand-star 
							  cd-expand-nn
							  cd-expand-complete)
  "Contains a list of functions which process the raw input of the 'cd' command")

(defun cd-expand-match (first)
  "does a cd if the argument actually matches a subdirectory"
  (if (file-directory-p first) first))
  
(defun cd-expand-history (first)
  "Recognizes '-' cd options"
  (if (string-match "^-\\( *$\\|\\(-\\)\\|\\([0-9]*\\)\\)" first)
	  (let ((n (cond ((match-string 2 first) 2)
					 ((match-string 3 first) (string-to-number (match-string 3 first)))
					 (t 1))))
		(if n (nth n cd-dir-stack)))))

(defun cd-expand-standard (first)
  (cond ((equal first "=")    
		 (choose-from (concat "Current: " default-directory) (cdr cd-dir-stack)))
		((equal first "") 
		 (getenv "HOME"))
		((equal (substring first 0 1) "~") first)))

(defun cd-expand-star (first &optional dir)
  "Handles embedded stars in shell cd command"
  (save-match-data (directory-files (or dir ".") nil 
									(concat "^" 
											(mapconcat 'identity (split-string first "\\*") ".*") 
											"$"))))

(defun cd-expand-nn (first) 
  "handles nickname substitution in cd shell command"
  (cdr (assoc first dir-nickname-alist)))

(defun cd-expand-complete (stub &optional dir)
  "Completes initial stub in shell command"
  (if (string-match "^/" stub)
	  (setq dir "/"
			stub (substring stub 1)))
  (remove nil (mapcar (lambda (x) (if (file-directory-p x) x))
					  (directory-files (or dir ".") t (concat "^" stub)))))


(defun enhanced-cd-candidates (first &optional rest)
  "Calls the processing functions on the input to the 'cd' function
Returns a list of potential destinations"
  (let ((dir (some (lambda (x) (funcall x first)) *enhanced-cd-funcs*)))
	(if (listp dir) dir (list dir))))

(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
    @ : modules in path
    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.

If all else fails it looks in the directory history and changes to the
most recent directory with a substring matching p1.

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 +" text)
	   (let* ((args (split-string (substring-no-properties text (match-end 0)) " +\\|\n" t))
			  (interactive (and (equal (car (last args)) "?") 
								(setq args (or (butlast args 1) '(".")))))
			  (dirs (enhanced-cd-candidates (car args))))
		 (if dirs (setq args (cdr args))
		   (setq dirs (list default-directory)))
		 (setq dirs (flatten (mapcar (lambda (x) (dir-find-leaves (expand-file-name x) args)) dirs))
			   dirs (if (= 1 (length dirs)) (car dirs)
					 (choose-from "Directory: " dirs)))
		 (and dirs interactive (setq dirs (interactive-cd dirs)))
		 (if dirs (setq text (format "cd \"%s\"" (expand-file-name dirs)))
		   (setq text "echo no matching directory"))))
  text)
		  
(defun dir-find-leaves (dir rest)
	(if rest
		(if (equal (car rest) "..")
			(substring dir 0 (string-match "[^/]*/?$" dir))
		  (remove nil (mapcar (lambda (x) (dir-find-leaves x (cdr rest)))
							  (cd-expand-complete (car rest) dir))))
	dir))

(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 interactive-cd (dir)
  "Gets a directory from menus in the minibuffer"
  (let ((chosen nil))
	(while (setq chosen (choose-from (concat "Current: " dir) 
									 (remove nil (mapcar (lambda (x) (if (file-directory-p x) x))
														 (directory-files dir t)))))
	  (setq dir (expand-file-name chosen)))
	dir))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Shell directory nicknames
;;
;; This section is to make emacs recognize the shell
;; nicknames. Nicknames are used in several places: in a shell buffer,
;; hit <TAB> after a nickname will expand it (useful, for instance, in 
;;     $ find sa<TAB> -name FILE-NAME)
;;
;; Also, minibuffer completion will recognize nicknames. After a "/"
;; in the minibuffer (for instance, C-x C-f), type "," followed by the
;; nickname followed by <TAB> or <SPACE>. The nickname will expand to
;; its full directory path.
;;
;; My shell environment also recognizes nicknames, the cd replacement I
;; use performs nickname replacement. 
;;
;; The shell-screen application also checks for use of the "nn" command,
;; and automatically adds new nicknames to the emacs environment
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar nn-prompt "Update emacs nicknames by M-x nicks-load-from-shell")

(shell-screen-output-add-descriptor nn-prompt 'grab-nn-from-buffer)

(defun grab-nn-from-buffer (x)
  (let* ((start 0) 
	 (msg "Set nicknames:") 
	 nn dir assoc)
    (while (setq start (string-match "\\([a-z][a-z0-9]*\\) => \\([^ \t\n]+\\)" x start))
      (setq nn (match-string 1 x)
	    dir (match-string 2 x)
	    start (match-end 0))
      (or (string-match "/$" dir) (setq dir (concat dir "/")))
	  (if (setq assoc (assoc nn dir-nickname-alist))
		  (unless (equal dir (cdr assoc))
			(setf (cdr assoc) dir)
			(setq msg (format "%s\nReplaced %s : %s" msg nn dir)))
		(setq dir-nickname-alist (cons (cons nn dir) dir-nickname-alist)
			  msg (format "%s\nAdded %s : %s" msg nn dir))))
    (message msg))
  (if (string-match "\n$" x) "" (substring x -2)))

(defun nicks-load-from-shell ()
  "Opens a shell to get a list of shell variables, and finds which are legal aliases"
  (interactive)
  (setq dir-nickname-alist
        (remove nil (mapcar (lambda (x) (if (string-match "^nn_\\([^=]+\\)=\\(.*\\)" x)
                                            (cons (match-string 1 x) (match-string 2 x))))
                            (split-string (with-output-to-string
                                            (with-current-buffer
                                                standard-output
                                              (call-process shell-file-name nil t nil "-c" "-i" "set"))))))
        )
  )

(if (is-unix) (nicks-load-from-shell))

(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" (car x) (cdr x))) dir-nickname-alist "\n"))
  )

;;
;; put nickname expansion into minibuffer
;;
(defun get-nname-dir (name) 
  (if (and (stringp name)
           (string-match (format "\\([^%s;]*\\)\\(;\\([a-z0-9]+\\)\\)?$" nn-prefix) 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)))

;;; This puts expansion into the regular minibuffer keys
(let* ((exp-re (format "/%s[^/,;]\\{0,%s\\}\\(;[a-z0-9]+\\)?$" nn-prefix 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)))
  )


(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 (cond ((equal curr "-") (second cd-dir-stack))
			((equal curr "--") (third cd-dir-stack))
			(t (cdr (assoc curr dir-nickname-alist))))))
        (if dir (replace-nn curr dir)
          (goto-char point)
          nil))
    (if (re-search-backward ",\\=" nil t)
        (progn (delete-char 1) 
               (insert default-directory) t))
))


;; This adds the special nicknames "_" and "__" to stand for the directories 
;; of the previous 2 files visited
(defun add-current-dir-to-dir-alist ()
  "hook function to store visited file directories in the _ and __ variables"
  (or (assoc "_" dir-nickname-alist)
      (setq dir-nickname-alist (append '(("_" . ".") ("__" . ".") ("" . "~/")) dir-nickname-alist)))
  (when (and buffer-file-name 
             (not (equal (file-name-directory buffer-file-name)
                         (cdr (assoc "_" dir-nickname-alist)))))
    (setf (cdr (assoc "__" dir-nickname-alist)) (cdr (assoc "_" dir-nickname-alist)))
    (setf (cdr (assoc "_" dir-nickname-alist)) (file-name-directory buffer-file-name)))
  )
(add-hook 'post-command-hook 'add-current-dir-to-dir-alist)

;; make sure shell cd works for them too
;(shell-screen-input-add-descriptor "^ *cd +\\(__?\\)" 'cd-_)
(shell-screen-input-add-descriptor "^ *cd" 'enhanced-cd)

(defun cd-_ (input)
  (format "cd %s" (cdr (assoc (match-string 1 input) dir-nickname-alist))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; directory tracking
;;
;; My own replacement for emacs directory tracking, reads the actual directory
;; from out of the shell prompt
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *setup-cmds-unix* '("PS1='RWY>\\w<RWY$ '" "export TERM=ansi" "export LINES=1000"))
(defvar *setup-cmds-dos* '("prompt RWY$G$P$LRWY$G "))
(defun set-prompt ()
  (let ((proc (get-buffer-process (current-buffer))))
    (mapcar (lambda (x) (funcall comint-input-sender proc (concat x "\n"))) (if (is-dos) *setup-cmds-dos* *setup-cmds-unix*))))

  ;; 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))
          (if (looking-at "$") (delete-char -1))

          (goto-char point))))


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

(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) ": ") ""))
			 (display-dir (es-directory-abbrev dir es-max-title-length)))
         (modify-frame-parameters 
          nil 
          (list (cons 'title (concat shell display-dir)))))))

(setq es-directory-abbrev-list
	  '(("^/var/www/v3xsdk/quantenna-sdk-v3x/buildroot/package/qwebphpif/www" . "(mimosa root) ")
		("^/var/www/build/v3xsdk/quantenna-sdk-v3x/buildroot/package/qwebphpif/www" . "(BUILD root) ")
		))

(defun es-directory-abbrev (&optional directory maxlen)
  (or directory (setq directory default-directory))
  (setq directory (expand-file-name directory))
  (let ((changed nil)
		(rules es-directory-abbrev-list))
	(while (car rules)
	  (if (string-match (caar rules) directory)
		  (setq changed t
				directory (concat (substring directory 0 (match-beginning 0)) 
								  (cdar rules)
								  (substring directory (match-end 0)))))
	  (setq rules (cdr rules)))
	(unless changed
	  (when (and maxlen (< maxlen (length directory)))
		(setq directory (concat "..." 
								(substring directory (string-match "/\\|\\\\" directory
																   (- (length directory)
																	  maxlen)))))))
	directory))


							
	  
;;
;; Besides actively synching the shell and emacs directories, this inserts the 
;; time and current directory into a tooltip fo each shell command
;;

;; Removes the default directory tracker and adds dynamic nickname completion
;; to shell buffer
(add-hook 'shell-mode-hook 
          (lambda () 
            (remove-hook 'comint-input-filter-functions 'shell-directory-tracker t)
            (set-prompt)
            (or (member 'expand-dir-nn comint-dynamic-complete-functions)
                (setq comint-dynamic-complete-functions 
                      (cons 'expand-dir-nn comint-dynamic-complete-functions)))
            (when (is-dos)
              (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-p] 'comint-previous-matching-input-from-input)
            ;; I like these definitions better
            (define-key shell-mode-map "p" 'comint-previous-matching-input-from-input)
            (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)
            
            ))

;; adds the dynamic directory tracker
(shell-screen-output-add-descriptor 
 (format "%s\\(%s.*\\)" *hidden-prompt* *visible-prompt*)
 'my-synch-dirs)

;;; This shuts off the default tooltip so the directory can be put there
(setq comint-highlight-input nil)

(defvar shell-dir-in-title t)

(defun my-synch-dirs (text) 
  "Filters the current directory from the prompt and put it in the minibuffer"
  (let* ((dir (match-string 1 text))
         (rest (substring text 0 (match-beginning 0)))
         (prompt (match-string 2 text))
         (command (substring text (match-end 2)))
		 (desc (list 'help-echo
					 (concat (format-time-string "%H:%M:%S %A\n") dir))
			   ))
    (add-text-properties 0 (length prompt) desc prompt)
    (es-display-dir dir remote-host)
    (when (file-exists-p dir)
      (if remote-host
		  (setq remote-directory dir)
		(shell-cd dir))    ; update emacs with the current directory
                                        ;       (message dir)     ; display directory in message area
      ;; Disabled: maintain emacs cd history stack (needed if using enhanced-cd
      (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))
      )
    (concat rest prompt command)))          ; return string sans directory


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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 ()
  (interactive)
  (let* ((pos (1- (let ((inhibit-field-text-motion t)) (line-beginning-position)))))
    (while (and (> pos (point-min)) (not (test-for-prompt pos)))
      (setq pos (previous-single-char-property-change pos 'face))
      )
    (if (= pos (point-min))  (error "First line")
      (goto-char pos)
      (end-of-line))))

(defun next-command (&optional no-check blank)
  (interactive)
  (let* ((pos (line-end-position)))
    (while (and (< pos (point-max)) (not (test-for-prompt pos)))
      (setq pos (next-single-char-property-change pos 'face))
      )
	(goto-char pos)
	(end-of-line)))

(defun get-dir-for-yank ()
  "Pushes the current directory onto the kill ring"
  (interactive)
  (kill-new default-directory)
  (message "directory %s" default-directory))

(global-set-key "\M-k" 'get-dir-for-yank)

(defun next-command-noc ()
  (interactive)
  (next-command t))

(defun shell-beginning-of-line ()
  "Moves to prompt, then if repeated moves to beginning of line.
BEGINNING-OF-LINE does not cross field boundaries, so in a shell it does not
cross the prompt. This function will go to the actual beginning of the line,
if repeated. "
  (interactive)
  (if (looking-at "^") (let ((inhibit-field-text-motion t)) (end-of-line)))
  (let ((point (point)))
	(beginning-of-line)
	(if (equal point (point))
		(forward-line 0))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Put up banner at start of new day
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar daily-timer-set nil)

(or daily-timer-set
    (setq daily-timer-set (run-at-time "24:00" 86400 'insert-new-day-in-shell)))

;;; Emacs can be up for days at a time. My prompt gives a time but not a date, 
;;; this separates the days in case I am looking way back
(defun insert-new-day-in-shell ()
  (mapcar (lambda (x)
            (when (string-match "\\*shell\\*$" (buffer-name x))
              (set-buffer x)
              (goto-char (point-max))
              (insert "\n\n##################################################################
##             The day is now " (format-time-string "%A, %B %e" (current-time)) "
##################################################################\n\n"
               )
              (goto-char (point-max))
              (comint-set-process-mark))) (buffer-list)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Report on execution time
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

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

(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) 
  (let ((start (string-match (concat *visible-prompt* "$") text)))
  (if start
      (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 (substring text 0 start)  "Command took " (format-seconds delta) "\n" (substring text start))
          text
          ))
    text)))

(defun time-diff (a b)
  (if (and a b) (+ (* 65536 (- (car a) (car b))) (- (cadr a) (cadr 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))))))

(add-hook 'shell-mode-hook
          (lambda ()
            (add-hook 'comint-input-filter-functions 'shell-timer-start)
            (add-hook 'comint-preoutput-filter-functions 'report-execution-time)
			))

;;; It is too easy to kill a shell buffer by accident, this confirms 
;;; it really is the intent to kill the shell buffer
(defun confirm-kill-shell () 
  "Require confirmation before C-x k a shell buffer"
  (if (equal major-mode 'shell-mode)
      (or (y-or-n-p "Really kill a shell buffer? ")
          (error "Cancelled"))))
(add-hook 'kill-buffer-hook 'confirm-kill-shell)

;; This fixes nickname shell completion - for some reason in version 23 Emacs
;; gets rid of the initial '/', so the nickname is appended to rather than 
;; replacing the current path. See 'rwy' for the changed line
(defun completion--do-completion (&optional try-completion-function)
  "Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
E = after completion we now have an Exact match.

 MCE
 000  0 no possible completion
 001  1 was already an exact and unique completion
 010  2 no completion happened
 011  3 was already an exact completion
 100  4 ??? impossible
 101  5 ??? impossible
 110  6 some completion happened
 111  7 completed to an exact completion"
  (let* ((beg (field-beginning))
         (end (field-end))
         (string (buffer-substring beg end))
         (comp (funcall (or try-completion-function
			    'completion-try-completion)
			string
			minibuffer-completion-table
			minibuffer-completion-predicate
			(- (point) beg))))
    (cond
     ((null comp)
      (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil))
     ((eq t comp) (minibuffer--bitset nil nil t)) ;Exact and unique match.
     (t
      ;; `completed' should be t if some completion was done, which doesn't
      ;; include simply changing the case of the entered string.  However,
      ;; for appearance, the string is rewritten if the case changes.
      (let* ((comp-pos (cdr comp))
	     (completion (car comp))
	     (completed (not (eq t (compare-strings completion nil nil
						    string nil nil t))))
	     (unchanged (eq t (compare-strings completion nil nil
					       string nil nil nil))))
        (unless unchanged

          ;; Insert in minibuffer the chars we got.
	  (if (string-match "^/," string) (setq beg (1+ beg)))		; rwy
          (goto-char end)
          (insert completion)
          (delete-region beg end))
	;; Move point.
	(goto-char (+ beg comp-pos))

        (if (not (or unchanged completed))
	   ;; The case of the string changed, but that's all.  We're not sure
	   ;; whether this is a unique completion or not, so try again using
	   ;; the real case (this shouldn't recurse again, because the next
	   ;; time try-completion will return either t or the exact string).
           (completion--do-completion try-completion-function)

          ;; It did find a match.  Do we match some possibility exactly now?
          (let ((exact (test-completion completion
					minibuffer-completion-table
					minibuffer-completion-predicate)))
            (unless completed
              ;; Show the completion table, if requested.
              (cond
               ((not exact)
                (if (case completion-auto-help
                      (lazy (eq this-command last-command))
                      (t completion-auto-help))
                    (minibuffer-completion-help)
                  (minibuffer-message "Next char not unique")))
               ;; If the last exact completion and this one were the same,
               ;; it means we've already given a "Complete but not unique"
               ;; message and the user's hit TAB again, so now we give him help.
               ((eq this-command last-command)
                (if completion-auto-help (minibuffer-completion-help)))))

            (minibuffer--bitset completed t exact))))))))

(provide 'shell-enhancements)