-
Notifications
You must be signed in to change notification settings - Fork 1
/
pari-history.el
440 lines (404 loc) · 15.4 KB
/
pari-history.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
;; pari-history.el -- history functions.
;; Copyright (C) 1997-2014 The PARI group.
;; This file is part of the PARIEMACS package.
;; PARIEMACS is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation. It is distributed in the hope that it
;; will be useful, but WITHOUT ANY WARRANTY WHATSOEVER.
;; Check the License for details. You should have received a copy of
;; it, along with the package; see the file 'COPYING'. If not, write
;; to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;; To be used with pari.el version 3.00 or higher
;; pari-history.el version 3.08
;; See README for more details.
;; Most of this code is stolen from mupad-run.el by Francois Maltey.
(provide 'pari-history)
;; Of pari.el, it uses:
;; variables:
;; gp-prompt-pattern
(require 'pari-messages)
;; Of pari-messages.el, it uses gp-messager.
(eval-when-compile
(fset 'x-defined-colors nil)
;; for development:
;;(setq byte-compile-warnings (list 'free-args 'unresolved 'callargs 'redefine 'obsolete))
;; for users:
(setq byte-compile-warnings (list 'unresolved 'redefine 'obsolete))
)
(eval-and-compile
(unless (fboundp 'gp-messager)
(defun gp-messager (no) (print "Feature pari-messages is absent ..." "*Messages*")))
)
;(defvar gp-process nil "Defined in pari.el")
(defcustom gp-run-history-max 100
"Maximum number of stored commands in history ring."
:type 'integer :group 'gp-shell)
(defun gp-set-arrow-behaviour (symbol val)
"See `gp-arrow-behaviour'"
(setq gp-arrow-behaviour val)
(cond
((string= val "Usual")
(define-key gp-map [(control up)]
(function gp-previous-history))
(define-key gp-map [(control down)]
(function gp-next-history))
(define-key gp-map [(up)] (function previous-line))
(define-key gp-map [(down)] (function next-line)))
(t ; for bash-style
(define-key gp-map [(up)]
(function gp-previous-history))
(define-key gp-map [(down)]
(function gp-next-history))
(define-key gp-map [(control up)] (function previous-line))
(define-key gp-map [(control down)] (function next-line)))))
(defcustom gp-arrow-behaviour
"Usual"
"Selects the behaviour of the arrow up and down :
the usual behaviour corresponds to up and down
while C-up and C-down correspond to history.
When in Bash-Style, this behaviour in exchanbed."
:type '(choice (const "Usual") (const "Bash-Style"))
:initialize 'custom-initialize-default
;do not use gp-set-arrow-behaviour
;initially since the map is not yet defined !
:set 'gp-set-arrow-behaviour
:group 'gp-shell)
;; Internal global variables:
(defvar gp-hist-commands nil
"Variable that holds the history ring in `gp-shell-mode'.
It has the shape of a vector with 4 components. They are:
-- (aref gp-hist-commands 0) is the next element,
-- (aref gp-hist-commands 1) is the previous element,
-- (aref gp-hist-commands 2) is the present element,
-- (aref gp-hist-commands 3) is the length of the chain.
Each element of the first three components is a vector with three entries:
-- (aref struct 0) is the current element,
-- (aref struct 1) is the next element,
-- (aref struct 2) is the previous element.")
;;;------------------------------------------------------
;; structure des donnees doublement chainee avec un point d'acces
;; intermediaire, sous forme d'un tableau :
;; coordonnees generale
;; 0 = liste directe - 1 = liste inverse - 2 = particulier - 3 = longueur.
;; L'acces aux elements de la liste est aussi un tableau dont la valeur des
;; coordonnees est
;; 0 = valeur - 1 = terme suivant - 2 = terme precedent
;;
(defun head-tail-void ()
"Creates a double linked chain like `gp-hist-commands'"
(let ((res (make-vector 4 nil)))
(aset res 3 0)
res))
(defun add-head (a struct)
"Creates a cell in the double linked chain struct, see `gp-hist-commands'"
;; Beginning is
;; struct = (list-after list-before here howmany)
;; Return is (br list-before howmany+1)
;; where br = (a list-after-modified nil)
;; and list-after-modified = (br list-before here howmany)
(let ((br (make-vector 3 nil)) (tete (aref struct 0)))
;; define element. Value:
(aset br 0 a)
;; link to previous list:
(aset br 1 tete)
(if tete (aset tete 2 br) (aset struct 1 br))
;; set current value:
(aset struct 0 br)
;; length is 1 larger:
(aset struct 3 (1+ (aref struct 3)))
struct))
(defun add-tail (a struct)
(let ((br (make-vector 3 nil)) (queue (aref struct 1)))
(aset br 0 a)
(aset br 2 queue)
(if queue (aset queue 1 br) (aset struct 0 br))
(aset struct 1 br)
(aset struct 3 (1+ (aref struct 3)))
struct))
(defun remove-head (struct)
(unless (aref struct 0) (error "structure vide"))
(when (eq (aref struct 2) (aref struct 0)) (aset struct 2 'head))
(aset struct 0 (aref (aref struct 0) 1))
(if (aref struct 0) (aset (aref struct 0) 2 nil) (aset struct 1 nil))
(aset struct 3 (1- (aref struct 3)))
struct)
(defun remove-tail (struct)
(unless (aref struct 0) (error "structure vide"))
(when (eq (aref struct 2) (aref struct 1)) (aset struct 2 'tail))
(aset struct 0 (aref (aref struct 0) 1))
(if (aref struct 0) (aset (aref struct 0) 2 nil) (aset struct 1 nil))
(aset struct 3 (1- (aref struct 3)))
struct)
(defun list-tail (A)
(let ((tmp (aref A 0)) res)
(while tmp (setq res (cons (aref tmp 0) res)) (setq tmp (aref tmp 1)))
res))
(defun list-head (A)
(let ((tmp (aref A 1)) res)
(while tmp (setq res (cons (aref tmp 0) res)) (setq tmp (aref tmp 2)))
res))
(defun set-ptr-head (A)
"A is a double linked chain like `gp-hist-commands'.
Sets (aref A 2) to
-- 'head when (aref A 1) is nil (no previous element)
-- otherwise sets it to (aref A 0)."
(if (aref A 1) (aset A 2 (aref A 0)) (aset A 2 'head)))
(defun set-ptr-tail (A)
"A is a double linked chain like `gp-hist-commands'.
Sets (aref A 2) to
-- 'tail when (aref A 1) is nil (no previous element)
-- otherwise sets it to (aref A 1)."
(if (aref A 1) (aset A 2 (aref A 1)) (aset A 2 'tail)))
(defun ptr-to-tail (A)
(cond
((not (aref A 2)) (error "pointeur vide"))
((eq (aref A 2) 'tail))
((eq (aref A 2) 'head) (or (aset A 2 (aref A 0)) (aset A 2 'tail)))
((not (aref (aref A 2) 1)) (aset A 2 'tail))
(t (aset A 2 (aref (aref A 2) 1))))
A)
(defun ptr-to-head (A)
"A is a double-linked chain as defined in `gp-hist-commands'. Return "
(cond
((not (aref A 2)) (error "pointeur vide"))
((eq (aref A 2) 'head))
((eq (aref A 2) 'tail) (or (aset A 2 (aref A 1)) (aset A 2 'head)))
((not (aref (aref A 2) 2)) (aset A 2 'head))
(t (aset A 2 (aref (aref A 2) 2))))
A)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-get-previous-command (str)
(let (brt brs (br (aref gp-hist-commands 2)))
(ptr-to-tail gp-hist-commands)
(setq brt t)
(while
(and
brt
(not (symbolp (aref gp-hist-commands 2)))
(setq brs (aref (aref gp-hist-commands 2) 0))
; Si les débuts de chaines sont égaux alors brt vaut nil
(setq brt
(not
(string= str (substring brs 0 (min (length str) (length brs)))))))
(ptr-to-tail gp-hist-commands))
; (when brt (aset gp-hist-commands 2 br))
; renvoie nil si le début de la chaîne n'est pas trouvé, la chaine sinon
(and (not brt) brs)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-get-next-command (str)
(let (brt brs (br (aref gp-hist-commands 2)))
; (when (eq br 'tail) (ptr-to-head gp-hist-commands))
(ptr-to-head gp-hist-commands)
(setq brt t)
(while
(and
brt
(not (symbolp (aref gp-hist-commands 2)))
(setq brs (aref (aref gp-hist-commands 2) 0))
(setq brt
(not
(string= str (substring brs 0 (min (length str) (length brs)))))))
(ptr-to-head gp-hist-commands))
; (when brt (aset gp-hist-commands 2 br))
(and (not brt) brs)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-store-line (str)
(when (>= (length str) 3)
(cond
(;; Do not copy the entry if it is the same as the current one:
(and
(aref gp-hist-commands 0)
(string= (aref (aref gp-hist-commands 0) 0) str))
(ptr-to-head gp-hist-commands))
(;; Do not copy the entry if it is the same as the current one, case of
;; beginning of list::
(and
(eq (aref gp-hist-commands 2) 'tail)
(aref gp-hist-commands 1)
(string= (aref (aref gp-hist-commands 1) 0) str))
;; but go back one step in history:
(ptr-to-head gp-hist-commands))
(;; Do not copy the entry if it is the same as the current one, case of
;; ????::
(and
(not (symbolp (aref gp-hist-commands 2))) ; neither 'head nor 'tail
(string= (aref (aref gp-hist-commands 2) 0) str))
(ptr-to-head gp-hist-commands))
(t (add-head str gp-hist-commands)))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Unused ??
(defun gp-store-current-command (str)
(when (>= (length str) 3)
(add-head str gp-hist-commands)
(aset gp-hist-commands 2 'head)))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-find-beg-of-last-input nil
(save-excursion
(goto-char (point-max))
(re-search-backward gp-prompt-pattern nil t)
(setq gp-input-start (match-end 0))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-previous-history-search ()
"Goes down through history ring looking for commands that
started by what is between gp-input-start and (point)."
(interactive)
(gp-find-beg-of-last-input) ;;set gp-input-start
(when (>= (point) gp-input-start)
(let
( (br (buffer-substring gp-input-start (point-max)))
(brs (buffer-substring gp-input-start (point))) (brn (point))
br1 br2 br3)
(setq br2 (aref gp-hist-commands 2))
(setq br1 (gp-get-previous-command brs))
(setq br3 (aref gp-hist-commands 2))
(aset gp-hist-commands 2 br2)
(unless (string= brs br) (gp-store-line br))
(aset gp-hist-commands 2 br3)
(delete-region gp-input-start (point-max))
(goto-char gp-input-start)
(cond
((not br1)
(insert brs)
(error "End of history list"))
(t
(insert br1)
(goto-char brn))))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-previous-history ()
(interactive)
(gp-find-beg-of-last-input) ;;set gp-input-start
(when (>= (point) gp-input-start)
(let
( (br (buffer-substring gp-input-start (point-max))) br1 br2 br3
(brn (point)))
(setq br2 (aref gp-hist-commands 2))
(setq br1 (gp-get-previous-command ""))
(setq br3 (aref gp-hist-commands 2))
(aset gp-hist-commands 2 br2)
(unless (string= "" br) (gp-store-line br))
(aset gp-hist-commands 2 br3)
(delete-region gp-input-start (point-max))
(goto-char gp-input-start)
(cond
((not br1)
(error "End of history list"))
(t
(insert br1)
(goto-char (min brn (point-max))))))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-next-history-search ()
"Goes up through history ring looking for commands that
started by what is between gp-input-start and (point)."
(interactive)
(gp-find-beg-of-last-input) ;;set gp-input-start
(when (>= (point) gp-input-start)
(let
( (br (buffer-substring gp-input-start (point-max)))
(brs (buffer-substring gp-input-start (point))) (brn (point))
br1 br2 br3)
(setq br2 (aref gp-hist-commands 2))
(setq br1 (gp-get-next-command brs))
(setq br3 (aref gp-hist-commands 2))
(aset gp-hist-commands 2 br2)
(unless (string= brs br) (gp-store-line br))
(aset gp-hist-commands 2 br3)
(delete-region gp-input-start (point-max))
(goto-char gp-input-start)
(cond
((not br1)
(insert brs)
(error "End of history list"))
(t
(insert br1)
(goto-char brn))))))
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defun gp-next-history ()
(interactive)
(gp-find-beg-of-last-input) ;;set gp-input-start
(when (>= (point) gp-input-start)
(let
( (br (buffer-substring gp-input-start (point-max))) br1 br2 br3
(brn (point)))
(setq br2 (aref gp-hist-commands 2))
(setq br1 (gp-get-next-command ""))
(setq br3 (aref gp-hist-commands 2))
(aset gp-hist-commands 2 br2)
(unless (string= "" br) (gp-store-line br))
(aset gp-hist-commands 2 br3)
(delete-region gp-input-start (point-max))
(goto-char gp-input-start)
(cond
((not br1)
(error "End of history list"))
(t
(insert br1)
(goto-char (min brn (point-max))))))))
;;;------------------------------------------------------
;;;------------------------------------------------------
;;;------------------------------------------------------
;;; The alternative would be to handle things like in
;;; term-mode:
;;; (defun term-send-up () (interactive) (term-send-raw-string "\eOA"))
;;; (defun term-send-down () (interactive) (term-send-raw-string "\eOB"))
;;; (defun term-send-right () (interactive) (term-send-raw-string "\eOC"))
;;; (defun term-send-left () (interactive) (term-send-raw-string "\eOD"))
;;;------------------------------------------------------
(defun gp-toggle-arrow-behaviour nil
(interactive)
(cond
((string= gp-arrow-behaviour "Usual")
(gp-set-arrow-behaviour 'gp-arrow-behaviour "Bash-Style"))
((string= gp-arrow-behaviour "Bash-Style")
(gp-set-arrow-behaviour 'gp-arrow-behaviour "Usual"))
(t (error "gp-arrow-behaviour has a undefined value")))
(message (gp-messager 92)))
(add-hook 'gp-mode-hook
'(lambda nil
(define-key gp-map [(meta up)]
(function gp-previous-history-search))
(define-key gp-map [(meta down)]
(function gp-next-history-search))
(gp-set-arrow-behaviour nil gp-arrow-behaviour)
(make-local-variable 'gp-hist-commands)
; gestion de l'historique
;; Define gp-hist-commands as (nil nil nil 0):
(setq gp-hist-commands (head-tail-void))
;; Set gp-hist-commands to (nil nil 'tail 0):
(set-ptr-head gp-hist-commands)
))
(add-hook 'pari-menu-bar-update-hook
'(lambda nil
(when (and gp-menu-barp (eq major-mode 'gp-mode) GP-menu-map
(or (and (featurep 'pari-fontification)
(= gp-menu-map-level 3))
(and (not (featurep 'pari-fontification))
(featurep 'pari-completion)
(= gp-menu-map-level 2))))
(easy-menu-add-item GP-menu-map nil
(list (gp-messager 88)
(vector (gp-messager 89) 'gp-previous-history)
(vector (gp-messager 90) 'gp-next-history)
(vector (gp-messager 91) 'gp-toggle-arrow-behaviour)
)
(gp-messager 78))
(setq gp-menu-map-level 4)
(message "Menu bar item GP loaded till level 4."))))
;; pari-history.el ends here ---------------