comparison emacs/hist.el @ 0:509549c55989

from elsewhere
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Tue, 25 May 2021 13:57:42 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:509549c55989
1 ;;; a tcsh-type history key facility for sub-shells
2 ;; Last edited: Wed Nov 14 09:52:12 1990
3
4 (provide 'hist)
5 (require 'prompt-for-word)
6
7 (defvar hk-last-mb nil "*begin of last hk match")
8
9 (defvar hk-last-mark nil "*beginning of last hk insertion")
10
11 (defvar hk-search-pat nil "*regexp for hk search")
12
13 (defvar hk-last-point 0 "*end of last hk insertion")
14
15 (defvar hkr-last-point 0 "*end of last hk pattern search insertion")
16
17 (defvar hkr-search-pat nil "*regexp for hk user pattern search")
18
19 (defvar hk-last-user-pat nil "*user part of last pattern search")
20
21 (make-local-variable 'hk-last-mb)
22 (make-local-variable 'hk-last-mark)
23 (make-local-variable 'hk-last-point)
24 (make-local-variable 'hk-search-pat)
25 (make-local-variable 'hkr-search-pat)
26 (make-local-variable 'hkr-last-point)
27 (make-local-variable 'hk-last-user-pat)
28
29 (defvar hk-pat-table '(("*shell*" . ".*: ")
30 ("*prolog*" . "| \\?- ")
31 ("*lisp*" . ">")
32 ("*inferior-lisp*" . ">"))
33 "default crux of prompt pattern, by buffer name")
34
35 (defun hist-key (&optional rpt)
36 "offer a previous input, a la tcsh ^P"
37 (interactive "p")
38 (if (not rpt) (setq rpt 1))
39 (let ((here (point))
40 (pat (or hk-search-pat
41 (setq hk-search-pat
42 (concat "^" (or (cdr (assoc (buffer-name
43 (current-buffer))
44 hk-pat-table))
45 "")
46 "\\(.+\\)$")))))
47 (hk-find-b rpt here pat)))
48
49 (defun hk-find-b (rpt here pat)
50 "search backwards for pat, no dups, rpt times"
51 (while (> rpt 0)
52 (goto-char (if (= (point) hk-last-point)
53 hk-last-mb
54 (if (eobp)
55 (progn (beginning-of-line)
56 (setq hk-last-mark nil)
57 (point))
58 (error "nowhere??"))))
59 (let ((keep-trying t))
60 (while keep-trying
61 (if (re-search-backward pat nil t)
62 (let ((entry (buffer-substring (match-beginning 1)
63 (match-end 1))))
64 (setq hk-last-mb (match-beginning 0))
65 (goto-char (or hk-last-mark here))
66 (if (looking-at (regexp-quote entry))
67 (goto-char hk-last-mb)
68 (setq keep-trying nil)
69 (if hk-last-mark (delete-region hk-last-mark hk-last-point))
70 (setq hk-last-mark (point))
71 (push-mark (point) t)
72 (insert entry)
73 (setq hk-last-point (point))))
74 (unwind-protect (error "no more??")
75 (goto-char (if hk-last-mark
76 hk-last-point
77 here))))))
78 (setq rpt (1- rpt))))
79
80 (defun hist-key-back (&optional rpt)
81 "offer a previous input, a la tcsh ^N"
82 (interactive "p")
83 (if (not rpt) (setq rpt 1))
84 (let ((here (point))
85 (pat (or hk-search-pat
86 (error "no pattern"))))
87 (while (> rpt 0)
88 (goto-char (if (= (point) hk-last-point)
89 hk-last-mb
90 (error "lost context")))
91 (let ((keep-trying t))
92 (while keep-trying
93 (end-of-line)
94 (if (re-search-forward pat nil t)
95 (let ((entry (buffer-substring (match-beginning 1)
96 (match-end 1))))
97 (setq hk-last-mb (match-beginning 0))
98 (goto-char (or hk-last-mark here))
99 (if (looking-at (regexp-quote entry))
100 ;; allow for back to square one
101 (if (progn (end-of-line)
102 (eobp))
103 (progn (setq keep-trying nil)
104 (if hk-last-mark
105 (delete-region hk-last-mark hk-last-point)
106 (error "shouldnt"))
107 (goto-char hk-last-mark))
108 (goto-char hk-last-mb))
109 (setq keep-trying nil)
110 (if hk-last-mark (delete-region hk-last-mark hk-last-point))
111 (setq hk-last-mark (point))
112 (push-mark (point) t)
113 (insert entry)
114 (setq hk-last-point (point))))
115 (unwind-protect (error "no more??")
116 (goto-char (if hk-last-mark
117 hk-last-point
118 here))))))
119 (setq rpt (1- rpt)))))
120
121 (defun hist-key-search (&optional rpt pat)
122 "offer a previous input, searching backwards for a pattern"
123 (interactive "p")
124 (if (not rpt) (setq rpt 1))
125 (let ((here (point))
126 (full-pat
127 (if (= (point) hkr-last-point)
128 hkr-search-pat
129 (setq hkr-search-pat
130 (if (eobp)
131 (concat "^"
132 (or (cdr (assoc (buffer-name
133 (current-buffer))
134 hk-pat-table))
135 "")
136 "\\(.*"
137 (setq hk-last-user-pat
138 (or pat
139 (regexp-quote
140 (prompt-for-word
141 "Pattern: "
142 (or hk-last-user-pat "")
143 nil nil))))
144 ".*\\)$")
145 (error "nowhere??"))))))
146 (hk-find-b rpt here full-pat)
147 (setq hkr-last-point hk-last-point)))
148
149 (require 'shell)
150
151 (define-key shell-mode-map "\ep" 'hist-key)
152 (define-key shell-mode-map "\en" 'hist-key-back)
153 (define-key shell-mode-map "\es" 'hist-key-search)
154 (define-key shell-mode-map "\e\C-i" 'shell-expand-file-name)
155
156 ;;; hack in case we've been given com-int
157 (if (not (boundp 'inferior-lisp-mode-map))
158 (require 'inf-lisp))
159 (define-key inferior-lisp-mode-map "\ep" 'hist-key)
160 (define-key inferior-lisp-mode-map "\en" 'hist-key-back)
161 ;; note that prolog copies shell-mode-map, so no need to fix that