diff shared/hist.el @ 0:107d592c5f4a

DICE versions, used by pers/common, recursive, I think/hope
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Mon, 08 Feb 2021 11:44:37 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/shared/hist.el	Mon Feb 08 11:44:37 2021 +0000
@@ -0,0 +1,161 @@
+;;; 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