;;; a tcsh-type history key facility for sub-shells
;; Last edited: Wed Nov 14 09:52:12 1990

(provide 'hist)
(require 'prompt-for-word)

(defvar hk-last-mb nil "*begin of last hk match")

(defvar hk-last-mark nil "*beginning of last hk insertion")

(defvar hk-search-pat nil "*regexp for hk search")

(defvar hk-last-point 0 "*end of last hk insertion")

(defvar hkr-last-point 0 "*end of last hk pattern search insertion")

(defvar hkr-search-pat nil "*regexp for hk user pattern search")

(defvar hk-last-user-pat nil "*user part of last pattern search")

(make-local-variable 'hk-last-mb)
(make-local-variable 'hk-last-mark)
(make-local-variable 'hk-last-point)
(make-local-variable 'hk-search-pat)
(make-local-variable 'hkr-search-pat)
(make-local-variable 'hkr-last-point)
(make-local-variable 'hk-last-user-pat)

(defvar hk-pat-table '(("*shell*" . ".*: ")
		       ("*prolog*" . "| \\?- ")
		       ("*lisp*" . ">")
		       ("*inferior-lisp*" . ">"))
  "default crux of prompt pattern, by buffer name")

(defun hist-key (&optional rpt)
  "offer a previous input, a la tcsh ^P"
  (interactive "p")
  (if (not rpt) (setq rpt 1))
  (let ((here (point))
	(pat (or hk-search-pat
		 (setq hk-search-pat
		       (concat "^" (or (cdr (assoc (buffer-name
						    (current-buffer))
						   hk-pat-table))
				       "")
			       "\\(.+\\)$")))))
    (hk-find-b rpt here pat)))

(defun hk-find-b (rpt here pat)
  "search backwards for pat, no dups, rpt times"
  (while (> rpt 0)
    (goto-char (if (= (point) hk-last-point)
		   hk-last-mb
		 (if (eobp)
		     (progn (beginning-of-line)
			    (setq hk-last-mark nil)
			    (point))
		   (error "nowhere??"))))
    (let ((keep-trying t))
      (while keep-trying
	(if (re-search-backward pat nil t)
	    (let ((entry (buffer-substring (match-beginning 1)
					   (match-end 1))))
	      (setq hk-last-mb (match-beginning 0))
	      (goto-char (or hk-last-mark here))
	      (if (looking-at (regexp-quote entry))
		  (goto-char hk-last-mb)
		(setq keep-trying nil)
		(if hk-last-mark (delete-region hk-last-mark hk-last-point))
		(setq hk-last-mark (point))
		(push-mark (point) t)
		(insert entry)
		(setq hk-last-point (point))))
	  (unwind-protect (error "no more??")
	    (goto-char (if hk-last-mark
			   hk-last-point
			 here))))))
    (setq rpt (1- rpt))))

(defun hist-key-back (&optional rpt)
  "offer a previous input, a la tcsh ^N"
  (interactive "p")
  (if (not rpt) (setq rpt 1))
  (let ((here (point))
	(pat (or hk-search-pat
		 (error "no pattern"))))
    (while (> rpt 0)
      (goto-char (if (= (point) hk-last-point)
		     hk-last-mb 
		   (error "lost context")))
      (let ((keep-trying t))
	(while keep-trying
	  (end-of-line)
	  (if (re-search-forward pat nil t)
	      (let ((entry (buffer-substring (match-beginning 1)
					     (match-end 1))))
		(setq hk-last-mb (match-beginning 0))
		(goto-char (or hk-last-mark here))
		(if (looking-at (regexp-quote entry))
		    ;; allow for back to square one
		    (if (progn (end-of-line)
			       (eobp))
			(progn (setq keep-trying nil)
			       (if hk-last-mark
				   (delete-region hk-last-mark hk-last-point)
				 (error "shouldnt"))
			       (goto-char hk-last-mark))
		      (goto-char hk-last-mb))
		  (setq keep-trying nil)
		  (if hk-last-mark (delete-region hk-last-mark hk-last-point))
		  (setq hk-last-mark (point))
		  (push-mark (point) t)
		  (insert entry)
		  (setq hk-last-point (point))))
	    (unwind-protect (error "no more??")
	      (goto-char (if hk-last-mark
			     hk-last-point
			   here))))))
      (setq rpt (1- rpt)))))

(defun hist-key-search (&optional rpt pat)
  "offer a previous input, searching backwards for a pattern"
  (interactive "p")
  (if (not rpt) (setq rpt 1))
  (let ((here (point))
	(full-pat
	 (if (= (point) hkr-last-point)
	     hkr-search-pat
	   (setq hkr-search-pat
		 (if (eobp)
		     (concat "^"
			     (or (cdr (assoc (buffer-name
					      (current-buffer))
					     hk-pat-table))
				 "")
			     "\\(.*"
			     (setq hk-last-user-pat
				   (or pat
				       (regexp-quote
					(prompt-for-word
					 "Pattern: "
					 (or hk-last-user-pat "")
					 nil nil))))
			     ".*\\)$")
		   (error "nowhere??"))))))
    (hk-find-b rpt here full-pat)
    (setq hkr-last-point hk-last-point)))

(require 'shell)

(define-key shell-mode-map "\ep" 'hist-key)
(define-key shell-mode-map "\en" 'hist-key-back)
(define-key shell-mode-map "\es" 'hist-key-search)
(define-key shell-mode-map "\e\C-i" 'shell-expand-file-name)

;;; hack in case we've been given com-int
(if (not (boundp 'inferior-lisp-mode-map))
    (require 'inf-lisp))
(define-key inferior-lisp-mode-map "\ep" 'hist-key)
(define-key inferior-lisp-mode-map "\en" 'hist-key-back)
;; note that prolog copies shell-mode-map, so no need to fix that