Annotation of OpenXM_contrib/pari-2.2/emacs/pari.el, Revision 1.1.1.1
1.1 noro 1: ;; This is the interface for pari under emacs.
2: ;; The main commands in this file are :
3: ;; M-x gp Opens a buffer for interaction with gp and then starts gp.
4: ;; C-u M-x gp Like M-x gp, but prompts for command line arguments.
5: ;; M-x gpman Displays the gp-pari manual using any dvi preview program.
6:
7: ;; All functions of gp are preserved.
8:
9: ;; Version 2.38 (2-July-2000)
10: ;; The original pari.el was written by Annette Hoffman.
11: ;; Modified by David Carlisle (JANET: carlisle@uk.ac.man.cs).
12: ;; Modified by Karim Belabas (belabas@math.u-bordeaux.fr) for gp 2.xxx.
13: ;; Modified by Olivier Ramare (ramare@gat.univ-lille1.fr).
14:
15: ;; Maintainer (22-November-1998): Olivier Ramare (ramare@agat.univ-lille1.fr).
16:
17: ;; See pariemacs.txt for more details.
18:
19: ;; KNOWN DEFICIENCIES:
20: ;; -- The hilit part may have troubles with `}'. A `}' followed by
21: ;; a newline indicates the end of a function-definition starting with
22: ;; `{'. Spaces, or tab are *not* allowed. So if you use `}' as a string
23: ;; DON'T have it followed by a newline.
24:
25: ;; This file is split in six parts :
26: ;; PART I : MAIN CONSTANTS (contains a macro).
27: ;; Some of them may have to be modified by the user.
28: ;; The macro 'gp-defcustom is defined there.
29: ;; PART II : KEYMAPS AND OTHER VARIABLES
30: ;; including the two macros 'gp-hilit-init and
31: ;; 'gp-tell-hilit-about-patterns. Also the substitution
32: ;; 'gp-setup is being defined there.
33: ;; PART III : gp-mode AND gp-script-mode
34: ;; PART IV : GENERAL FUNCTIONS
35: ;; Contains: HANDLING THE WINDOWS ...
36: ;; THE GP PROCESS
37: ;; META-COMMANDS
38: ;; GP COMPLETION FUNCTIONS
39: ;; COMPLETION FILES
40: ;; TeX MANUAL
41: ;; GP HELP MODE
42: ;; TeX AND USUAL INFO
43: ;; PART V : HILIGHTING
44: ;; PART VI : MENU-BAR
45: ;; Contains: MENU BUILDERS (contains 3 constants)
46: ;; MENU-BAR ITEM USED IN GP-SCRIPT-MODE
47: ;; MENU-BAR ITEM USED IN GP-MODE
48: ;;
49: ;; Note that this order is not random! In order for the compilation
50: ;; to work properly with macros, they *should* be defined before
51: ;; they are called (if emacs-version is below 20.3).
52:
53: (provide 'pari)
54: (eval-when-compile
55: (setq byte-compile-warnings (list 'unresolved 'callargs 'redefine 'obsolete)))
56: (eval-and-compile (require 'backquote)) ; This file is used in macros.
57:
58: ;;--------------------------
59: ;; PART I : MAIN CONSTANTS
60: ;;--------------------------
61:
62: ;; CONFIGURE:
63: (defconst gp-version "2.2.1")
64: ;; Set the following five constants for your site:
65:
66: ;; CONFIGURE:
67: (defconst gp-gphelp-dir "/usr/local/bin/"
68: "The directory where gphelp is to be found")
69:
70: ;; CONFIGURE:
71: (defconst gp-file-name "/usr/local/bin/gp"
72: "The file name of the gp executable file")
73:
74: ;; To customize variables:
75: (eval-and-compile
76: (defvar old-emacs-versionp t)
77: (save-excursion
78: (set-buffer "*Messages*")
79: (let ((pt (point)))
80: (emacs-version t)
81: (goto-char pt)
82: (if (re-search-forward "\\(GNU Emacs\\|\\) \\([^ ]*\\) " nil t)
83: (setq old-emacs-versionp (not (string-lessp "20.3" (match-string 2))))
84: (setq old-emacs-versionp t))))
85: ;; Shut up compiler:
86: (if old-emacs-versionp
87: (progn (fset 'defgroup (lambda (a b c &rest d) "" nil))
88: (fset 'custom-declare-variable
89: (lambda (a b c &rest d) "" nil))
90: (fset 'frame-parameter (lambda (a b) "" nil))))
91: )
92: ;; This variable is required since some functions are not
93: ;; supported by earlier versions.
94:
95: (defmacro gp-defcustom (symbol value doc &rest args)
96: "If emacs-version is larger than 20, then customization of the
97: variables is allowed, else no."
98: (` (if old-emacs-versionp
99: (, (list 'defvar symbol value
100: ;; The "doc" string of a customizable variable starts
101: ;; with a "*". Remove it here.
102: (list 'substring doc 1)))
103: ;; definition of 'defcustom taken from custom.el:
104: (, (nconc (list 'custom-declare-variable
105: (list 'quote symbol)
106: (list 'quote value)
107: doc)
108: args)))))
109:
110: (eval-and-compile
111: (or old-emacs-versionp
112: (defgroup gp nil
113: "Major mode for editing GP source in Emacs"
114: :group 'languages)))
115:
116: ;; CONFIGURE:
117: (gp-defcustom gp-readline-enabledp t
118: "*t if readline is enabled. Emacs will try to set it properly
119: whenever a gp-session is started."
120: :type 'boolean
121: :group 'gp)
122:
123: (gp-defcustom pari-colors
124: ;; CONFIGURE ??
125: (eval (expand-file-name (concat gp-gphelp-dir "pari-colors.el" )))
126: "*Where the choice of colors is stored"
127: :type 'file
128: :group 'gp)
129:
130: ;; Should be set in a hook if pari.el is installed on a network,
131: ;; since these colors are user dependent. It is reset in
132: ;; 'gp-hilit-translate called by 'gp-hilit-init after reading the hooks.
133: ;; Both 'gp-mode and 'gp-script-mode provide a default if
134: ;; the chosen file is not writable. This should take care of the case
135: ;; of a casual user accessing to gp through a network.
136:
137: (gp-defcustom gp-additional-cpl-file ""
138: "*A name (string) of a completion file used in supplement for completion.
139: This file should have the format of 'gp-menu files."
140: :type 'file
141: :group 'gp)
142:
143: (gp-defcustom gp-tutorial-requiredp t
144: "*T if comments should be given for some functions."
145: :type 'boolean
146: :group 'gp)
147: ;; The functions concerned are : 'gp-cmd2-to-paint, 'gp-make-cpl-file
148:
149: ;; CONFIGURE:
150: (defconst gp-dvi-preview "xdvi -s 3"
151: ;; (defconst gp-dvi-preview "texsun"
152: "dvi previewer (and options)")
153:
154: (gp-defcustom gp-no-menu-bar nil
155: "*A non nil value means that we do not want any menu-bar"
156: :type 'boolean
157: :group 'gp)
158:
159: (gp-defcustom gp-no-color-item nil
160: "*T means remove the menu-bar item [GP/Colors]"
161: :type 'boolean
162: :group 'gp)
163:
164: (gp-defcustom gp-no-hilit nil
165: "*If this variable is non-nil don't highlight GP scripts and *PARI* buffer.
166: Note however that any change of value will become effective only during
167: next session."
168: ;; Simply because the really relevant variable is 'gp-can-hilit.
169: :type 'boolean
170: :group 'gp)
171:
172: (gp-defcustom gp-no-separate-window-for-mistakes t
173: "*T means errors under the gp calculator will not be
174: displayed on a separate window."
175: :type 'boolean
176: :group 'gp)
177:
178: (defconst gp-temp-directory "/tmp/"
179: "*Directory in which to create temporary files.")
180:
181: (defvar gp-temp-file
182: (expand-file-name (concat gp-temp-directory (make-temp-name "gp_#")))
183: "Temporary file name used for text being sent as input to GP.")
184:
185: (defvar gp-el-temp-file
186: (expand-file-name (concat gp-temp-directory (make-temp-name "gp_#.el")))
187: "Temporary file name used for text being sent as input to emacs.")
188:
189: (defconst gp-max-saved-wind-conf 20
190: "Maximal number of saved window configurations")
191:
192: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193:
194: ;; Individual users may want to re-set some of the variables in this section
195: ;; in a gp-mode-hook in their .emacs file (see pariemacs.txt for examples).
196:
197: (gp-defcustom gp-stack-size 10000000
198: "*Default stack size passed to gp."
199: :type 'integer
200: :group 'gp)
201:
202: (gp-defcustom gp-prime-limit 500000
203: "*Default prime limit passed to gp."
204: :type 'integer
205: :group 'gp)
206:
207: (gp-defcustom gp-prompt-for-args nil
208: "*A non-nil value makes M-x gp act like C-u M-x gp,
209: ie prompt for the command line arguments."
210: :type 'boolean
211: :group 'gp)
212:
213: (gp-defcustom gp-keep-PARI-buffer-when-quitting nil
214: "*T means what it says..."
215: :type 'boolean
216: :group 'gp)
217:
218: (gp-defcustom gp-locked-modep t
219: "*t means you cannot write above the last prompt.
220: If you try to modify an earlier input, emacs will automatically copy
221: it at the bottom of your file."
222: :type 'boolean
223: :group 'gp)
224:
225: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
226:
227: ;; CAUTION :
228: ;; Because of the new prompt capabilities in gp-2 (e.g self-modifying...),
229: ;; it is now the user responsibility to set gp-prompt-pattern correctly.
230: ;; This can't be done automagically in a satisfactory way
231:
232: (defvar gp-prompt-pattern
233: "^[?>][\n\t ]*"
234: "*Regexp used to match gp prompts.
235: can be set with gp-set-prompt (bound to M-\\ p)")
236:
237: ;;----------------------------------------
238: ;; PART II : KEYMAPS AND OTHER VARIABLES
239: ;;----------------------------------------
240:
241: (defsubst gp-print-if-compiling (messg)
242: (if (get-buffer "*Compile-Log*")
243: (save-excursion
244: (set-buffer "*Compile-Log*")
245: (insert messg "\n"))))
246:
247: (defsubst gp-setup nil
248: (defconst gp-places-list
249: (list
250: ''gp-error ''gp-history ''gp-prompt ''gp-output ''gp-input
251: ''gp-help ''gp-timer ''gp-comment ''gp-string ''gp-control-statement
252: ''gp-default-keywords ''gp-default-set ''gp-input-cmd
253: ''gp-global-var ''gp-function-proto ''gp-function-args)
254: ;; To add something to this list, like ''gp-warning,
255: ;; set also the proper default in 'gp-hilit-translate,
256: ;; and define the corresponding pattern in
257: ;; 'gp-tell-hilit-about-patterns if it is for gp-mode, or
258: ;; in 'gp-hilit-init if it is for gp-script-mode.
259: "List of symbolic-names of faces which are linked with patterns to
260: be hilighted via 'gp-hilit-init and 'gp-tell-hilit-about-patterns")
261: ;; This function is used in a constant definition in hilit19:
262: (fset 'x-display-color-p (lambda (&optional DISPLAY) t))
263: (or (featurep 'hilit19) (load "hilit19" t))
264: (or (featurep 'easymenu) (load "easymenu" t))
265: (or (featurep 'hilit19)
266: (progn
267: ;; Curiously enough, this part is essentially only crap for
268: ;; the compiler. If hilit19 is loaded when this is used then
269: ;; the proper definitions will be used !
270: (gp-print-if-compiling "No highlighting: hilit19.el not found.")
271: (defvar hilit-face-translation-table nil)
272: (defvar hilit-background-mode 'light)
273: (mapcar (lambda (agpplace)
274: (eval (list 'defvar (eval agpplace) nil)))
275: gp-places-list)
276: (fset 'hilit-translate nil)
277: (fset 'hilit-set-mode-patterns nil)
278: (fset 'hilit-string-find nil)
279: (fset 'hilit-rehighlight-region nil)
280: (fset 'hilit-unhighlight-region nil)
281: (fset 'hilit-rehighlight-buffer nil)
282: (fset 'hilit-recenter nil)
283: (setq gp-no-hilit t)))
284: (or (featurep 'easymenu)
285: (progn
286: ;; This part is no crap ! 'easymenu has to be present
287: ;; at compilation time.
288: (gp-print-if-compiling "No menu-bar: easymenu.el not found.")
289: (fset 'easy-menu-define nil)
290: (setq gp-no-menu-bar t))))
291:
292: (gp-setup)
293: (eval-when-compile (setq byte-optimize t) (gp-setup))
294:
295: (defvar gp-input-filter-hook nil
296: "Hook run in 'gp-input-filter")
297:
298: (defconst gp-c-array (make-vector 800 0)
299: "obarray used for completing gp command names")
300: ;; pari-2.0.11-beta contains 495 function names.
301: ;; We extend it by 305 for local ones.
302:
303: (defvar gp-can-hilit nil "")
304: (defvar gp-process nil "t if a GP process is running.")
305:
306: ;; Topology of a menu-buffer : three parts delimited
307: ;; by 'gp-menu-start-simple/'gp-menu-end-simple
308: ;; 'gp-menu-start-special/'gp-menu-end-special
309: ;; 'gp-menu-start-keywords/'gp-menu-end-keywords
310: ;; The first part is made of items displayed on gp-menu-nbcol columns
311: ;; of width gp-menu-width; selecting an item in this region will
312: ;; ask 'gp-get-man-entry. The second part is made of longer items
313: ;; displayed on a single columns and selecting them will also
314: ;; call 'gp-get-man-entry. The third part is made of keywords
315: ;; displayed on a single column which when selected will call
316: ;; 'gp-get-apropos.
317: (defvar gp-menu-start-simple 0
318: "Value of point at the beginning of the first menu-region")
319: (defvar gp-menu-end-simple 0
320: "Value of point at the end of the first menu-region")
321: (defvar gp-menu-width 1)
322: (defvar gp-menu-nbcol 1)
323: (defvar gp-menu-start-special 0
324: "Value of point at the beginning of the second menu-region")
325: (defvar gp-menu-end-special 0
326: "Value of point at the end of the second menu-region")
327: (defvar gp-menu-start-keywords 0
328: "Value of point at the beginning of the third menu-region")
329: (defvar gp-menu-end-keywords 0
330: "Value of point at the end of the third menu-region")
331:
332: (mapcar 'make-variable-buffer-local
333: '(gp-menu-start-simple gp-menu-end-simple
334: gp-menu-start-special gp-menu-end-special gp-menu-start-keywords gp-menu-end-keywords))
335:
336: (defvar gp-input-start nil
337: "Beginning of the expression to be send to GP. See gp-copy-input.")
338: (defvar gp-input-end nil
339: "End of the expression to be send to GP. See gp-copy-input.")
340: (defvar gp-complete-expression nil
341: "t if expression to be send to GP is complete. See gp-copy-input.")
342: (defvar gp-input-start-bracketp nil
343: "t if expression to be send to GP starts with a {.")
344: (defvar gp-reads-this-buffer nil
345: "name of the buffer gp is interpreting.")
346: (defvar gp-latest-error nil
347: "Regexp matching latest execution error. It contains a grouping
348: whose closing parenthesis corresponds to the point where gp
349: has detected a mistake.")
350: (defvar gp-registers-list nil
351: "List of registers from 0 to (1- gp-max-saved-wind-conf)
352: where window-configurations are stored.
353: See gp-store-wind-conf and gp-restore-wind-conf.")
354: (defvar gp-should-wait-for-outputp t
355: "t if gp should wait for output and hilit it
356: in gp-send-input. Automatically reset to t after each
357: input. See also gp-input-filter.")
358: (defvar pari-colors-modifiedp nil
359: "t if the color of a gp-place has been modified")
360: (defvar pari-colors-initp nil
361: "t is colors have been initialised")
362: (defvar gp-menu-loadedp nil
363: "t if the file gp-menu is already used for completion")
364: (defvar gp-main-menu-list nil
365: "Set by 'gp-cpl-init.")
366:
367: (defconst gp-main-menu-keywords-list
368: '("elliptic curve" "number field" "bnf"))
369:
370: (defvar gp-browser-2-map nil "Keymap used in 'gp-browser-2-mode.")
371:
372: (if (not (eq gp-browser-2-map nil))
373: nil
374: (setq gp-browser-2-map (make-sparse-keymap))
375: (define-key gp-browser-2-map "\C-m" (function gp-browser-2-select))
376: (define-key gp-browser-2-map [mouse-2] (function gp-browser-2-mouse-select))
377: (define-key gp-browser-2-map [right] (function gp-menu-right))
378: (define-key gp-browser-2-map [left] (function gp-menu-left)))
379:
380: (defvar gp-browser-1-map nil "Keymap used in 'gp-browser-1-mode.")
381:
382: (if (not (eq gp-browser-1-map nil))
383: nil
384: (setq gp-browser-1-map (make-sparse-keymap))
385: (define-key gp-browser-1-map "\C-m" (function gp-browser-1-select))
386: (define-key gp-browser-1-map [mouse-2] (function gp-browser-1-mouse-select)))
387:
388: (defvar gp-browser-main-alist nil)
389: (defvar gp-browser-width 0
390: "The alist 'gp-browser-main-alist consists of conses (NUM . STRING).
391: 'gp-browser-var is the length of the largest STRING.")
392:
393: (defvar gp-browser-follow-alist nil)
394: (defvar gp-main-frame nil "The main frame if non nil.")
395: (defvar gp-browser-frame nil "GP-browser frame if non nil.")
396: (defvar gp-browser-process nil "A simple gp process opened to build the browser.")
397: (defvar gp-browser-style 3
398: "*Style for GP-browser. Three styles are possible, 1, 2 and 3.
399: Best to try them on.")
400:
401: (defvar gp-cpl-lists-list
402: '(gp-c-array)
403: "List of the lists/arrays to be used for completion on top of the
404: completion already delivered by readline if present and by the general
405: 'gp-c-array which has to be the first element of this list.")
406:
407: (defconst gp-separator (list "----------") "")
408:
409: (defconst gp-function-proto-pstart
410: "\\(^ *\\|{\\)\\([a-zA-Z][_a-zA-Z0-9]*\\)([^)]*) *=[^=]"
411: "Regexp matching the beginning of a function-definition")
412:
413: (defconst gp-letters-list
414: '(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 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 48 49 50 51 52 53 54 55 56 57 95 61 43 45 42 47 124 94 58 33 35 40 41 91 93 123 125 126 37 36 44 59 46 38 63 39 96 60 62 32 34 92)
415: ; (string-to-list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_=+-*/|^:!#()[]{}~%$,;.&?'`<> \"\\")
416: "See 'gp-define-locked-keys.")
417:
418: (defvar gp-colors-list
419: (list 'default 'red 'red3 'magenta3 'brown 'green3 'grey50 'grey40
420: 'deepskyblue1 'hex-80a0ff 'blue3 'yellow 'hex-ffff60)
421: "A list of symbolic-names of faces used + some default ones.")
422: (defvar gp-color-menu-list nil
423: "List containing the color menu.")
424:
425: (defvar gp-syntax-table nil
426: "Syntax table in use in gp-mode and gp-script-mode buffers.")
427:
428: (if gp-syntax-table
429: ()
430: (setq gp-syntax-table (make-syntax-table))
431: (modify-syntax-entry ?( "()" gp-syntax-table)
432: (modify-syntax-entry ?) ")(" gp-syntax-table)
433: (modify-syntax-entry ?[ "(]" gp-syntax-table)
434: (modify-syntax-entry ?] ")[" gp-syntax-table)
435: (modify-syntax-entry ?{ "(}" gp-syntax-table)
436: (modify-syntax-entry ?} "){" gp-syntax-table)
437: (modify-syntax-entry ?# "." gp-syntax-table)
438: (modify-syntax-entry ?~ "_" gp-syntax-table) ; symbol constituent
439: (modify-syntax-entry ?! "_" gp-syntax-table) ; symbol constituent
440: (modify-syntax-entry ?+ "." gp-syntax-table)
441: (modify-syntax-entry ?- "." gp-syntax-table)
442: ;(modify-syntax-entry ?/ ". 1456" gp-syntax-table) ; XEmacs?
443: (modify-syntax-entry ?/ ". 14" gp-syntax-table)
444: (modify-syntax-entry ?* ". 23" gp-syntax-table)
445: (modify-syntax-entry ?\\ ". 12b" gp-syntax-table)
446: (modify-syntax-entry ?. "w" gp-syntax-table) ; used for
447: (modify-syntax-entry ?' "w" gp-syntax-table)
448:
449: (if (string-match "XEmacs" emacs-version)
450: (progn
451: (modify-syntax-entry ?\n ">b" gp-syntax-table)
452: ;; Give CR the same syntax as newline, for selective-display
453: (modify-syntax-entry ?\^m ">b" gp-syntax-table)
454: )
455: (modify-syntax-entry ?\n "> b" gp-syntax-table)
456: ;; Give CR the same syntax as newline, for selective-display
457: (modify-syntax-entry ?\^m "> b" gp-syntax-table)
458: )
459: (modify-syntax-entry ?= "." gp-syntax-table)
460: (modify-syntax-entry ?% "_" gp-syntax-table) ; symbol constituent
461: (modify-syntax-entry ?< "." gp-syntax-table)
462: (modify-syntax-entry ?> "." gp-syntax-table)
463: (modify-syntax-entry ?$ "w" gp-syntax-table)
464: (modify-syntax-entry ?| "." gp-syntax-table)
465: (modify-syntax-entry ?_ "w" gp-syntax-table))
466:
467: (defun gp-define-locked-keys nil
468: (mapcar
469: (lambda (achar)
470: (define-key gp-map (vector achar)
471: (if gp-locked-modep
472: 'gp-locked-self-insert-command
473: 'self-insert-command)))
474: gp-letters-list)
475: (if gp-locked-modep
476: (progn
477: (define-key gp-map [mouse-2] 'gp-locked-mouse-2)
478: (define-key gp-map "\C-?" 'gp-locked-backward-delete-char-untabify)
479: (define-key gp-map "\C-y" 'gp-locked-yank))
480: (define-key gp-map [mouse-2] 'gmouse-yank-at-click)
481: (define-key gp-map "\C-?" 'backward-delete-char-untabify)
482: (define-key gp-map "\C-y" 'yank)))
483:
484: (defvar gp-map nil
485: "Local keymap used in buffer *PARI*.")
486:
487: (if (not (eq gp-map nil))
488: nil
489: (setq gp-map (make-sparse-keymap))
490: (gp-define-locked-keys)
491: (define-key gp-map "\t" (function gp-complete))
492: (define-key gp-map "\C-m" (function gp-send-local-input))
493: (define-key gp-map "\M-c" (function gp-copy-input))
494: (define-key gp-map "\M-\C-m" (function gp-C-j))
495: (define-key gp-map "\C-j" (function gp-C-j))
496: (define-key gp-map "\M-\t" (function gp-complete))
497: (define-key gp-map "\C-c" (function gp-interrupt))
498: (define-key gp-map "\M-\\\\" (function gp-break-long-line))
499: (define-key gp-map "\M-\\a" (function gp-meta-a))
500: (define-key gp-map "\M-\\b" (function gp-meta-b))
501: (define-key gp-map "\M-\\c" (function gp-menu))
502: (define-key gp-map "\M-\\d" (function gp-meta-d))
503: (define-key gp-map "\M-\\m" (function gp-meta-m))
504: (define-key gp-map "\M-\\p" (function gp-set-prompt))
505: (define-key gp-map "\M-\\q" (function gp-meta-q))
506: (define-key gp-map "\M-\\r" (function gp-meta-r))
507: (define-key gp-map "\M-\\s" (function gp-meta-s))
508: (define-key gp-map "\M-\\t" (function gp-meta-t))
509: (define-key gp-map "\M-\\v" (function gp-meta-v))
510: (define-key gp-map "\M-\\w" (function gp-meta-w))
511: (define-key gp-map "\M-\\x" (function gp-meta-x))
512: (define-key gp-map "\M-?" (function gp-get-man-entry))
513: (define-key gp-map "\M-H" (function gp-get-apropos))
514: (define-key gp-map "\C-p" (function previous-line))
515: (define-key gp-map "\C-n" (function next-line))
516: (define-key gp-map "\M-p" (function gp-previous-cmd))
517: (define-key gp-map "\M-n" (function gp-next-cmd))
518: (define-key gp-map "\M-s" (function gp-skip-to-error))
519: (define-key gp-map [C-kp-subtract] (function gp-remove-last-output))
520: (define-key gp-map [M-kp-subtract] (function gp-remove-last-action))
521: )
522:
523: (defvar gp-script-map nil
524: "Local keymap used in gp-script-mode.")
525:
526: (if (not (eq gp-script-map nil))
527: nil
528: (setq gp-script-map (make-sparse-keymap))
529: (define-key gp-script-map "\t" (function gp-complete))
530: (define-key gp-script-map "\M-\t" (function gp-complete))
531: (define-key gp-script-map "\M-\\\\" (function gp-break-long-line))
532: (define-key gp-script-map "\M-\\d" (function gp-meta-d))
533: (define-key gp-script-map "\M-\\c" (function gp-menu))
534: (define-key gp-script-map "\M-?" (function gp-get-man-entry))
535: (define-key gp-script-map "\M-H" (function gp-get-apropos))
536: (define-key gp-script-map "\M-\\t" (function gp-meta-t))
537: (define-key gp-script-map "\M-\\v" (function gp-meta-v))
538: (define-key gp-script-map "\M-\\z" (function gp-run-in-region))
539: (define-key gp-script-map "\M-s" (function gp-skip-to-error))
540: )
541:
542: (defvar gp-menu-map nil
543: "Local keymap used in gp menu buffer.")
544:
545: (if (not (eq gp-menu-map nil))
546: nil
547: (setq gp-menu-map (make-sparse-keymap))
548: (define-key gp-menu-map "\C-n" (function gp-menu-next))
549: (define-key gp-menu-map "\C-p" (function gp-menu-previous))
550: (define-key gp-menu-map "\C-m" (function gp-menu-select))
551: (define-key gp-menu-map [mouse-2] (function gp-menu-mouse-select))
552: (define-key gp-menu-map "q" (function gp-menu-quit))
553: (define-key gp-menu-map "s" (function gp-menu-survey))
554: (define-key gp-menu-map "\C-v" (function gp-menu-C-v))
555: (define-key gp-menu-map "\M-v" (function gp-menu-M-v))
556: (define-key gp-menu-map [right] (function gp-menu-right))
557: (define-key gp-menu-map [left] (function gp-menu-left))
558: )
559:
560: ;; Global keys. They *should* be global.
561:
562: (define-key esc-map "o" (function gp-restore-wind-conf))
563:
564: (define-key completion-list-mode-map [mouse-2] (function gp-mouse-2))
565:
566: ;; Maps used for the menu-bar.
567:
568: (defvar GP-menu-map nil
569: "Keymap used for the menu-bar item GP in gp-mode")
570:
571: (defvar GP-script-menu-map nil
572: "Keymap used for the menu-bar item GP in gp-script-mode")
573:
574: ;; Functions that behaves like constants.
575:
576: (defun gp-tell-hilit-about-patterns nil
577: "Patterns to be hilighted under gp-mode."
578: ;; Essentially a constant.
579: (hilit-set-mode-patterns
580: 'gp-mode
581: (cons
582: (cons gp-prompt-pattern '(nil gp-prompt))
583: (cons
584: (cons
585: (concat "\\(" gp-prompt-pattern "\\)" "\\(.*$\\)")
586: '(2 gp-input))
587: '( ("^ *%[0-9]* =" nil gp-history)
588: ("time = \\([0-9][hmn,0-9 ]* ms\.\\)" 1 gp-timer)
589: ("^[a-zA-Z][a-zA-Z0-9_]*([^ )]*): " "^$" gp-help)
590: ("\\*\\*\\*.*" nil gp-error)
591: ("\\<\\(buffersize\\|colors\\|compatible\\|debug\\|debugmem\\|echo\\|format\\|help\\|histsize\\|logfile\\|output\\|parisize\\|path\\|primelimit\\|prompt\\|psfile\\|realprecision\\|seriesprecision\\|simplify\\|strictmatch\\|timer\\)\\>" nil gp-default-keywords)
592: ;; In the next one, we avoid `log(10)' and `"pari.log"':
593: ("[\\<\\.]\\(log\\)[^\\w\\.(\"]" 1 gp-default-keywords)
594: ("^ *\\\\[a-z].*$" nil gp-default-set)
595: ("\\<\\(default\\)(" 1 gp-default-set)
596:
597: ("^ *%[0-9]* = \\(.*$\\)" 1 gp-output))))))
598:
599: (defun gp-hilit-init nil
600: "Enable highlighting in the PARI buffer"
601: (and
602: (setq gp-can-hilit
603: (and (not gp-no-hilit)
604: (eq window-system 'x) (x-display-color-p)))
605: (not pari-colors-initp)
606: (progn
607: (setq pari-colors-initp t)
608: ;; while running GP
609: (gp-tell-hilit-about-patterns)
610:
611: ;; to edit GP scripts.
612: (hilit-set-mode-patterns
613: 'gp-script-mode
614: '( (gp-find-comment nil gp-comment)
615:
616: ("\\<\\(return\\|next\\|if\\|until\\|while\\|\\|fordiv\\|forprime\\|forstep\\|forvec\\|for\\) *(" 1 gp-control-statement)
617:
618: ("\\<\\(break\\)[^a-zA-Z0-9_]" 1 gp-control-statement)
619:
620: ("\\<\\(default\\)(" 1 gp-default-set)
621: ("\\<read\\>[^a-zA-Z0-9_]" 0 gp-input-cmd)
622: ("\\<\\(local\\)\\([ \t\n]*(\\)" 1 gp-input-cmd)
623:
624:
625: (hilit-string-find ?\\ gp-string)
626:
627: (gp-find-global-var nil gp-global-var)
628:
629: ("\\(^\\|{[\n\t ]*\\) *\\([a-zA-Z]\\w*\\)([^)]*) *=[^=]" 2 gp-function-proto)
630:
631: ("\\(^\\|{[\n\t ]*\\) *[a-zA-Z]\\w*(\\([^)]*\\)) *=[^=]" 2 gp-function-args))))
632:
633: ;; Convert the symbols 'gp-function-args and so on into
634: ;; faces (well, not exactly : into other symbolic-names of faces
635: ;; but which are associated to a face):
636: (gp-hilit-translate)
637:
638: ;; Work out the list of symbolic-names of faces used:
639: (gp-init-gp-colors-list)
640: ))
641:
642: (gp-defcustom gp-language 'francais
643: "*Any of 'francais 'english 'deutsch."
644: :type '(choice (const francais) (const english)); (const deutsch))
645: :group 'gp)
646:
647: (defconst gp-messages-list
648: '((francais .
649: ("Nous utilisons le choix par defaut pour la completion" ;; no 1
650: "Elimination de %s" ;; no 2
651: " Sauvegarde des couleurs ? " ;; no 3
652: "M-o ou ESC-o pour oter la fenetre d'aide" ;; no 4
653: "APPUYER SUR UNE TOUCHE POUR CONTINUER..." ;; no 5
654: "termine." ;; no 6
655: "En attente de la reponse de gp ..." ;; no 7
656: "Impossible de lancer gp." ;; no 8
657: "Expression incomplete." ;; no 9
658: "Ce nouveau prompt peut conduire a une erreur. Mieux vaut le changer via M-\\p" ;; no 10
659: "Version numero %s." ;; no 11
660: "Mode Tutorat active" ;; no 12
661: "Mode Tutorat desactive" ;; no 13
662: "Echange les fonctions des touches C-p/M-p and C-n/M-n."
663: "gp essaie de completer ..." ;; no 15
664: "C-u M-o pour sortir de l'edition." ;; no 16
665: "Lancement de " ;; no 17
666: "SPC=suivant DEL=precedent RET=selectionner s=survey-menu q=quitter"
667: "Il n'y a rien a selectionner ici" ;; no 19
668: "Fonction inconnue : %s" ;; no 20
669: "Fonction" ;; no 21
670: "Variable utilisateur : %s" ;; no 22
671: "Aucune occurence de \"%s\" n'a ete trouvee." ;; no 23
672: "Chargement de pari-colors.el a partir de " ;; no 24
673: "### Variables globales : (une par ligne)" ;; no 25
674: "### Titres de chapitre :" ;; no 26
675: "### Mots-cles interessants :" ;; no 27
676: "D'humeur aventureuse ? Un nom de \"face\" s'ecrit:\n FaceCaractere/FaceDecors-[bold,italic]-[underline]\n ou simplement: FaceCaractere.\n\nFace[Caractere|Decors] appartient a la liste (non-exhaustive) suivante :\nblack blue brown cyan DarkGoldenrod dimgrey firebrick ForestGreen Goldenrod green grey40 grey50 hex-80a0ff hex-ffff60 lightblue magenta mocassin OliveDrab orange pink Plum purple red RoyalBlue tan yellow white.\n De plus, vous pouvez souvent ajouter un suffixe entier entre 1 et 4, comme dans green3. Vous pouvez essaye le tres voyant firebrick/yellow-bold. L'italique ne se voit pas sur l'ecran mais est utilise quand vous demandez une impression via le sous-item `Postcript Print Buffer' de l'item `Tools'. Il faut remarquer que nil n'est pas la couleur par defaut... puisque cette couleur est tout simplement `default' !" ;; no 28
677: "Emacs utilise un fichier general contenant tous les noms des fonctions de PARI. En surplus, gp utilises un fichier appele nom-de-fichier.cpl des que nom-de-fichier est edite. Pour creer ce fichier, vous pouvez utilise l'item [GP Completion-File Edit-File...] de la barre de menu qui creera un fichier au format adequat contenant les noms des fonctions et des variables globales de votre programme. L'edition de ce fichier se fait via l'item [GP Completion-File Edit File...] de la barre de menu et vous pouvez aussi decider d'utiliser un autre fichier a l'aide de [GP Completion-File Use Also File...]." ;; no 29
678: "Rend les noms de fonctions et ceux des variables globales du programme %s (tel qu'il existe en ce moment) utilisables pour la completion. Ils seront stockes dans `%s.cpl' des que ce fichier sera edite. Le fichier `%s.cpl' est au format d'un fichier de completion (i.e. format du fichier gp-menu) et est automatiquement utilise pour la completion lorsque %s est edite." ;; no 30
679: "Fonctions/Sections dans la description desquelles \"%s\" apparait :" ;; no 31
680: "Sujet"
681: "Nom du fichier de completion : " ;; no 33
682: "Erreur introuvable." ;; no 34
683: "Probable typo." ;; no 35
684: (concat "Aucune erreur a localiser ou buffer (" gp-reads-this-buffer ") absent") ;; no 36
685: "Le guide est en construction..." ;; no 37
686: "Mouse-2 ou Return pour selectionner un item." ;; no 38
687: "Le fichier pariemacs.txt n'est pas dans votre load-path. Vous devriez decouvrir ou il se situe, disons dans le directory /usr/local/lib/pari/emacs/ et ajouter la ligne\n (setq load-path (concat load-path \"/usr/local/lib/pari/emacs/\"))\ndans votre fichier .emacs (creez-le si besoin est)." ;; no 39
688: "Nouvelle couleur :" ;; no 40
689: "Appele avec : %s\n\n" ;; no 41
690: "Autre..." ;; no 42
691: "Couleurs" ;; no 43
692: "Mise a jour" ;; no 44
693: "Sauvegarde" ;; no 45
694: "Commutateur" ;; no 46
695: "Tout recolorier" ;; no 47
696: "MetaTouches" ;; no 48 "Metakeys"
697: "Lire du Fichier..." ;; no 49 "Read from File..."
698: "Ecrire sur le Fichier..." ;; no 50 "Write to File..."
699: "Imprimer en..." ;; no 51 "Print in..."
700: "Nouveau Prompt" ;; no 52 "New Prompt"
701: "Simple" ;; no 53 "Simple"
702: "Avec l'heure" ;; no 54 "With Time"
703: "Avec la date" ;; no 55
704: "Avec un separateur" ;; no 56
705: "Lancer GP" ;; no 57
706: "Comme d'habitude" ;; no 58
707: "Changer les parametres..." ;; no 59
708: "GP evalue le fichier..." ;; no 60
709: "GP evalue la region" ;; no 61
710: "Quitter GP" ;; no 62
711: "Aide sur ce mode" ;; no 63
712: "Fichier de completion" ;; no 64
713: "Utiliser aussi le fichier..." ;; no 65
714: "Editter le fichier..." ;; no 66
715: "Creer/Mettre a jour" ;; no 67
716: "" ;; no 68
717: "Nom du programme:" ;; no 69
718: "+/- d'aide" ;; no 70
719: "Disposition precedente" ;; no 71
720: "Completer" ;; no 72
721: "Aller a l'erreur" ;; no 73
722: "Entree/Sortie..." ;; no 74
723: "Recopier la derniere entree" ;; no 75
724: "Oter le dernier resultat" ;; no 76
725: "Oter la derniere action" ;; no 77
726: "Basculer les touches" ;; no 78
727: ))
728: (english .
729: ("Using default choice for completion" ;; no 1
730: "Removing %s"
731: " Save Colors ? "
732: "M-o or ESC-o will remove the help window"
733: "PRESS ANY KEY TO CONTINUE..." ;; no 5
734: "done."
735: "Waiting for gp output ..."
736: "Could not start gp."
737: "Incomplete expression : Not sent to gp." ;; no 9
738: "New prompt may lead to an error. Better to set it interactively via M-\\p"
739: "Version number %s."
740: "Tutorial mode activated" ;; no 12
741: "Tutorial mode desactivated" ;; no 13
742: "Exchange the bindings of the keys C-p/M-p and C-n/M-n."
743: "Waiting for gp completion ..." ;; no 15
744: "C-u M-o to exit editing." ;; no 16
745: "Starting " ;; no 17
746: "SPC=next DEL=previous RET=select s=survey-menu q=quit"
747: "Nothing to be selected here" ;; no 19
748: "Unknown function: %s" ;; no 20
749: "Function" ;; no 21
750: "User Variable: %s" ;; no 22
751: "No occurence of \"%s\" found." ;; no 23
752: "Loading pari-colors.el from " ;; no 24
753: "### Global Variables : (one per line)" ;; no 25
754: "### Chapter Headings:" ;; no 26
755: "### Interesting Keywords:" ;; no 27
756: "Feeling adventurous ? A face name has the shape:\n FaceForForeground/FaceForBackground-[bold,italic]-[underline]\n or simply: FaceForForeground.\n\nFaceFor[Foreground|Background] can be chosen in the following (non-exhaustive) list:\nblack blue brown cyan DarkGoldenrod dimgrey firebrick ForestGreen Goldenrod green grey40 grey50 hex-80a0ff hex-ffff60 lightblue magenta mocassin OliveDrab orange pink Plum purple red RoyalBlue tan yellow white.\n In addition, you can usually add an integer suffix between 1 and 4, like in green3. For instance, you can try the flashy firebrick/yellow-bold. Italic fonts don't show on the screen but are used whenever you get a print-out via the item `Postcript Print Buffer' of the menu-item `Tools'. Finally note here that nil is not the default face... since this default face is simply called `default' !" ;; no 28
757: "A general completion file containing the name of all the PARI functions is always used. In addition to this file, gp uses a file named your-file-name.cpl when you edit your-file-name. To create this file, you can use the menu-bar item [GP Completion-File Edit-File...] which will create the proper completion-file and introduce the names of the functions and of the global variables of your program. You edit the file by using the item \"Edit File...\" and you can decide to use another completion-file as well through the item \"Use Also File...\"." ;; no 29
758: " Makes the names of functions and global variables of %s available for completion. They will be stored in `%s.cpl' as soon as this file is required for editing. The file `%s.cpl' has the format of a completion file (i.e. a gp-menu file) and is automatically used as a completion file when %s is edited." ;; no 30
759: "Functions or Sections in whose description \"%s\" appears:" ;; no 31
760: "Subject" ;; no 32
761: "Name of the completion file: " ;; no 33
762: "Could not locate the error." ;; no 34
763: "Probable mistake." ;; no 35
764: (concat "No error to be found or missing buffer (" gp-reads-this-buffer ")") ;; no 36
765: "The browser is being build..." ;; no 37
766: "Mouse-2 or Return to select an item." ;; no 38
767: "The file pariemacs.txt is not in your load-path. You should discover where it is, say in the directory /usr/local/lib/pari/emacs/ and add the line\n (setq load-path (concat load-path \"/usr/local/lib/pari/emacs/\"))\nto your .emacs file (create it if it doesn't already exist)." ;; no 39
768: "Use face:" ;; no 40
769: "Called with: %s\n\n" ;; no 41
770: "Other..." ;; no 42
771: "Colors" ;; no 43 http://www.local.attac.org/petition/
772: "Update" ;; no 44
773: "Save" ;; no 45
774: "Hilit Switch" ;; no 46
775: "Rehilit All" ;; no 47
776: "Metakeys" ;; no 48
777: "Read from File..." ;; no 49
778: "Write to File..." ;; no 50
779: "Print in..." ;; no 51
780: "New Prompt" ;; no 52
781: "Simple" ;; no 53
782: "With Time" ;; no 54
783: "With Date" ;; no 55
784: "With Separator" ;; no 56
785: "Start GP session" ;; no 57
786: "As Usual" ;; no 58
787: "Change Parameters..." ;; no 59
788: "Run GP on file..." ;; no 60
789: "Run GP in region" ;; no 61
790: "Quit GP session" ;; no 62
791: "Help on this mode" ;; no 63
792: "Completion File" ;; no 64
793: "Use Also File..." ;; no 65
794: "Edit File..." ;; no 66
795: "Make/Update" ;; no 67
796: "" ;; no 68
797: "Name of the GP programm: " ;; no 69
798: "Tutorial Switch" ;; no 70
799: "Previous Setting" ;; no 71
800: "Complete" ;; no 72
801: "Skip to error" ;; no 73
802: "In/Out..." ;; no 74
803: "Copy Last Input" ;; no 75
804: "Remove Last Output" ;; no 76
805: "Remove Last Action" ;; no 77
806: "Exchange keys" ;; no 78
807: ))
808: (deutsch .
809: ("Using default choice for completion" ;; no 1
810: "Removing %s"
811: " Save Colors ? "
812: "M-o or ESC-o will remove the help window"
813: "PRESS ANY KEY TO CONTINUE..." ;; no 5
814: "done."
815: "Waiting for gp output ..."
816: "Could not start gp."
817: "Incomplete expression : Not sent to gp." ;; no 9
818: "New prompt may lead to an error. Better to set it interactively via M-\\p"
819: "Version number %s." ;; no 11
820: "Tutorial mode activated" ;; no 12
821: "Tutorial mode desactivated" ;; no 13
822: "Exchange the bindings of the keys C-p/M-p and C-n/M-n."
823: "Waiting for gp completion ..." ;; no 15
824: "C-u M-o to exit editing." ;; no 16
825: "Starting " ;; no 17
826: "SPC=next DEL=previous RET=select s=survey-menu q=quit"
827: "Nothing to be selected here" ;; no 19
828: "Unknown function: %s" ;; no 20
829: "Function" ;; no 21
830: "User Variable: %s" ;; no 22
831: "No occurence of \"%s\" found." ;; no 23
832: "Loading pari-colors.el from " ;; no 24
833: "### Global Variables : (one per line)" ;; no 25
834: "### Chapter Headings:" ;; no 26
835: "### Interesting Keywords:" ;; no 27
836: "Feeling adventurous ? A face name has the shape:\n FaceForForeground/FaceForBackground-[bold,italic]-[underline]\n or simply: FaceForForeground.\n\nFaceFor[Foreground|Background] can be chosen in the following (non-exhaustive) list:\nblack blue brown cyan DarkGoldenrod dimgrey firebrick ForestGreen Goldenrod green grey40 grey50 hex-80a0ff hex-ffff60 lightblue magenta mocassin OliveDrab orange pink Plum purple red RoyalBlue tan yellow white.\n In addition, you can usually add an integer suffix between 1 and 4, like in green3. For instance, you can try the flashy firebrick/yellow-bold. Italic fonts don't show on the screen but are used whenever you get a print-out via the item `Postcript Print Buffer' of the menu-item `Tools'. Finally note here that nil is not the default face... since this default face is simply called `default' !"
837: "A general completion file containing the name of all the PARI functions is always used. In addition to this file, gp uses a file named your-file-name.cpl when you edit your-file-name. To create this file, you can use the menu-bar item [GP Completion-File Edit-File...] which will create the proper completion-file and introduce the names of the functions and of the global variables of your program. You edit the file by using the item \"Edit File...\" and you can decide to use another completion-file as well through the item \"Use Also File...\"."
838: " Makes the names of functions and global variables of %s available for completion. They will be stored in `%s.cpl' as soon as this file is required for editing. The file `%s.cpl' has the format of a completion file (i.e. a gp-menu file) and is automatically used as a completion file when %s is edited."
839: "Functions or Sections in whose description \"%s\" appears:" ;; no 31
840: "Subject"
841: "Name of the completion file: "
842: "Could not locate the error." ;; no 34
843: "Probable mistake." ;; no 35
844: (concat "No error to be found or missing buffer (" gp-reads-this-buffer ")") ;; no 36
845: "The browser is being build..." ;; no 37
846: "Mouse-2 or Return to select an item." ;; no 38
847: "The file pariemacs.txt is not in your load-path. You should discover where it is, say in the directory /usr/local/lib/pari/emacs/ and add the line\n (setq load-path (concat load-path \"/usr/local/lib/pari/emacs/\"))\nto your .emacs file (create it if it doesn't already exist)." ;; no 39
848: "Use face:" ;; no 40
849: "Called with: %s\n\n" ;; no 41
850: "Other..." ;; no 42
851: "Colors" ;; no 43
852: "Update" ;; no 44
853: "Save" ;; no 45
854: "Hilit Switch" ;; no 46
855: "Rehilit All" ;; no 47
856: "Metakeys" ;; no 48
857: "Read from File..." ;; no 49
858: "Write to File..." ;; no 50
859: "Print in..." ;; no 51
860: "New Prompt" ;; no 52
861: "Simple" ;; no 53
862: "With Time" ;; no 54
863: "With Date" ;; no 55
864: "With Separator" ;; no 56
865: "Start GP session" ;; no 57
866: "As Usual" ;; no 58
867: "Change Parameters..." ;; no 59
868: "Run GP on file..." ;; no 60
869: "Run GP in region" ;; no 61
870: "Quit GP session" ;; no 62
871: "Help on this mode" ;; no 63
872: "Completion File" ;; no 64
873: "Use Also File..." ;; no 65
874: "Edit File..." ;; no 66
875: "Make/Update" ;; no 67
876: "" ;; no 68
877: "Name of the GP programm: " ;; no 69
878: "Tutorial Switch" ;; no 70
879: "Previous Setting" ;; no 71
880: "Complete" ;; no 72
881: "Skip to error" ;; no 73
882: "In/Out..." ;; no 74
883: "Copy Last Input" ;; no 75
884: "Remove Last Output" ;; no 76
885: "Remove Last Action" ;; no 77
886: "Exchange keys" ;; no 78
887: ))))
888:
889: ;;---------------------------------------
890: ;; PART III : gp-mode AND gp-script-mode
891: ;;---------------------------------------
892:
893: (defun gp-messager (msg-number)
894: (eval (nth msg-number (assq gp-language gp-messages-list))))
895:
896: (defsubst file-really-exists-p (file)
897: (and (not (string= file "")) (file-exists-p file)))
898:
899: (defsubst gp-kill-buffer-safely (abuffer)
900: (let ((b (get-buffer abuffer)))
901: (if b (kill-buffer b))))
902:
903: (defsubst gp-get-beginning-of-line nil
904: (save-excursion (beginning-of-line) (point)))
905:
906: (defsubst gp-get-end-of-line nil
907: (save-excursion (end-of-line) (point)))
908:
909: (defun gp-choose-complete nil
910: "Try to see whether readline is enabled or not
911: and select proper completion function. To be used
912: when the buffer *PARI* is selected."
913: (save-excursion
914: (goto-char (point-min))
915: (if (re-search-forward "readline .*\\(dis\\|en\\)abled" nil t)
916: (progn
917: (forward-char -6)
918: (setq gp-readline-enabledp (looking-at "n")))
919: ;; Else use default:
920: (message (gp-messager 1)))))
921:
922: (defsubst gp-learn-sexp nil
923: "To teach emacs some elements of gp-syntax."
924: ;; Treat comments as white spaces in sexp:
925: (make-local-variable 'parse-sexp-ignore-comments)
926: (setq parse-sexp-ignore-comments t)
927: ;; Care about capital or not (always local):
928: (setq case-fold-search nil)
929: ;; Comments in sexp (We handle only one kind of comments):
930: (make-local-variable 'comment-start)
931: (setq comment-start "\\\\") ;; A *string*, NOT a regexp.
932: (make-local-variable 'comment-end)
933: (setq comment-end "")
934: (make-local-variable 'comment-start-skip)
935: (setq comment-start-skip "\\\\\\\\.*$\\|/\\*\\([^\\*]\\|\\*[^/]\\)*\\*/"))
936:
937: (defun pari-mode ()
938: "Common part of 'gp-mode and 'gp-script-mode"
939: ;; In case pari-colors has not been set in the user's hook
940: ;; and the installation is on a network:
941: (or (file-writable-p pari-colors)
942: (setq pari-colors "~/pari-colors.el"))
943: (gp-hilit-init) ;; Hilit some chosen patterns.
944:
945: (if gp-menu-loadedp nil
946: (gp-cpl-init)
947: (setq gp-menu-loadedp t))
948: ;; Make the default completion array.
949:
950: (if (file-really-exists-p (concat (buffer-name) ".cpl"))
951: ;; The local completion for this file.
952: (gp-cpl-file (concat (buffer-name) ".cpl")))
953:
954: (if (file-really-exists-p gp-additional-cpl-file)
955: ;; Add this file to the usual completion array.
956: (gp-cpl-file gp-additional-cpl-file))
957: (gp-learn-sexp)
958: (set-syntax-table gp-syntax-table))
959:
960: ;; The line ";;;###autoload" is useless.
961: ;; It will be useful when pari.el will be part
962: ;; of the usual distribution of emacs.
963: ;;;###autoload
964: (defun gp-script-mode nil
965: "Major mode for editing GP input files.
966:
967: The following bindings are available:
968: \\{gp-script-map}"
969:
970: (interactive)
971: (setq major-mode 'gp-script-mode mode-name "GP script")
972: (run-hooks 'pari-mode-hook)
973: (run-hooks 'gp-script-mode-hook) ; Set up user preferences.
974: (pari-mode)
975: (use-local-map gp-script-map)
976: ;; Make gp-script-map the local map in this mode.
977: (gp-init-script-menu-bar) ; Start menu-bar.
978: )
979:
980: ;; The line ";;;###autoload" is useless.
981: ;; It will be useful when pari.el will be part
982: ;; of the usual distribution of emacs.
983: ;;;###autoload
984: (defun gp-mode ()
985: "Major mode for running a gp-process.
986:
987: The following bindings are available:
988: \\{gp-map}"
989:
990: (interactive)
991: (setq major-mode 'gp-mode mode-name "GP")
992: (run-hooks 'pari-mode-hook)
993: (run-hooks 'gp-mode-hook) ; Set up user preferences.
994: (pari-mode)
995: (use-local-map gp-map) ; Make gp-map the local map of buffer *PARI*.
996: (gp-choose-complete) ; Try to decide whether readline is enabled.
997: (gp-init-menu-bar) ; Start menu-bar.
998: )
999:
1000: (defsubst gp-clear-temp-files nil
1001: "Remove temporary files that may have been created"
1002: (if (file-exists-p gp-temp-file)
1003: (progn (delete-file gp-temp-file)
1004: (message (gp-messager 2) gp-temp-file)))
1005: (if (file-exists-p gp-el-temp-file)
1006: (progn (delete-file gp-el-temp-file)
1007: (message (gp-messager 2) gp-el-temp-file))))
1008:
1009: (defun gp-save-setting-kill-emacs nil
1010: "Ask whether to save the choice of colors if need be
1011: and remove temporary files."
1012: (and pari-colors-modifiedp (y-or-n-p (gp-messager 3))
1013: (gp-save-colors))
1014: (gp-clear-temp-files))
1015:
1016: (make-local-hook 'kill-emacs-hook)
1017: (setq kill-emacs-hook (function gp-save-setting-kill-emacs))
1018:
1019: (defun gp-displace-input nil
1020: (if (and (save-excursion (re-search-forward gp-prompt-pattern nil t))
1021: (save-excursion (re-search-backward gp-prompt-pattern nil t)))
1022: (let ((where (point)))
1023: (re-search-backward gp-prompt-pattern nil t)
1024: (goto-char (match-end 0))
1025: (setq where (- where (point)))
1026: (gp-copy-input)
1027: (re-search-backward gp-prompt-pattern nil t)
1028: (goto-char (+ where (match-end 0))))))
1029:
1030: (defun gp-locked-self-insert-command nil
1031: (interactive)
1032: (gp-displace-input)
1033: (insert-char last-command-char 1))
1034:
1035: (defun gp-locked-mouse-2 (anevent)
1036: (interactive "e")
1037: (mouse-set-point anevent)
1038: (gp-displace-input)
1039: (yank))
1040:
1041: (defun gp-locked-yank nil
1042: (interactive)
1043: (gp-displace-input)
1044: (yank))
1045:
1046: (defun gp-locked-backward-delete-char-untabify nil
1047: (interactive)
1048: (gp-displace-input)
1049: (backward-delete-char-untabify 1))
1050:
1051: ;;-----------------------------
1052: ;; PART IV : GENERAL FUNCTIONS
1053: ;;-----------------------------
1054:
1055: ;;--------------------------
1056: ;; HANDLING THE WINDOWS ...
1057: ;;--------------------------
1058: ;; At the beginning, the user has asked for one window, but s/he may well
1059: ;; have introduced another window in-between (or even several ones).
1060: ;; We should then use only one other fixed window for everything else.
1061: ;; But since the list of the buffers displayed in a window does not exist,
1062: ;; and since the user may well change of window by ITself, we can't do much.
1063:
1064:
1065: (defsubst gp-depile-wind-conf nil
1066: (setq gp-registers-list (cdr gp-registers-list)))
1067:
1068: (defsubst gp-backward-wind-conf nil
1069: "Restore previously stored window configuration."
1070: (if (not (equal gp-registers-list nil))
1071: (progn
1072: (jump-to-register (car gp-registers-list))
1073: (setq gp-registers-list (cdr gp-registers-list)))))
1074:
1075: (defsubst gp-store-wind-conf nil
1076: "Add a the current window configuration to the pile. If the pile
1077: has more than 'gp-max-saved-wind-conf items
1078: (0,1,...,(1- gp-max-saved-wind-conf)) then the first item is lost."
1079: (if (= (length gp-registers-list) gp-max-saved-wind-conf)
1080: (setq gp-registers-list (nreverse (cdr (nreverse gp-registers-list)))))
1081: (let ((next (if (equal gp-registers-list nil) 0
1082: (if (= (car gp-registers-list) (1- gp-max-saved-wind-conf)) 0
1083: (1+ (car gp-registers-list))))))
1084: (window-configuration-to-register next)
1085: (setq gp-registers-list (cons next gp-registers-list))))
1086:
1087: (defun gp-restore-wind-conf (&optional arg)
1088: "Restore the previous window-configuration, killing the *gp-help* buffer
1089: if it was and is no more displayed. When called with prefix ^U, end the
1090: edition of the completion-file (if any were edited)."
1091: (interactive "P")
1092: (if (and arg (= (car arg) 4)) ;; Meaning that the call has been C-u M-o
1093: (gp-quit-cpl-edit)
1094: (let ((had-help-windowp (and (get-buffer "*gp-help*")
1095: (get-buffer-window "*gp-help*")))
1096: (had-message-windowp (and (get-buffer "*gp-messages*")
1097: (get-buffer-window "*gp-messages*"))))
1098: (gp-backward-wind-conf)
1099: ;; Kill the buffer *gp-help* if it is not displayed anymore:
1100: (if had-help-windowp
1101: (if (not (get-buffer-window "*gp-help*"))
1102: (kill-buffer "*gp-help*")))
1103: (if had-message-windowp
1104: (if (not (get-buffer-window "*gp-messages*"))
1105: (kill-buffer "*gp-messages*"))))
1106: ;; When called from menu-bar, write nothing in the minibuffer:
1107: (message "")))
1108:
1109: (defsubst gp-info-wind-conf nil (message (gp-messager 4)))
1110:
1111: (defun buffer-visiblep (abuffer-name)
1112: (if (get-buffer-window abuffer-name) t nil))
1113:
1114: (defun name-extension (filename)
1115: "Return the extension suffix of filename, if any"
1116: (if (> (length filename) (length (file-name-sans-extension filename)))
1117: (substring filename (1+ (length (file-name-sans-extension filename))))
1118: ""))
1119:
1120: (defun gp-proper-name (filename)
1121: "We replace the dots in filename by -."
1122: (setq filename (file-name-nondirectory filename))
1123: (let ((ll (length filename)) (pos 0))
1124: (while (< pos ll)
1125: (if (= (aref filename pos) ?.)
1126: (aset filename pos ?-))
1127: (setq pos (1+ pos)))
1128: filename))
1129:
1130: (defsubst gp-pgrmp (abuffer)
1131: "Return t if buffer abuffer is in gp-script-mode."
1132: (set-buffer abuffer) (eq major-mode 'gp-script-mode))
1133:
1134: (defsubst gp-possible-file-name nil
1135: "Try to guess the name of a likely gp-program."
1136: ;; First tries the existing windows, then the existing buffers.
1137: (let ((pgrm nil))
1138: (walk-windows
1139: (lambda (wind)
1140: (if (gp-pgrmp (window-buffer wind))
1141: (setq pgrm
1142: (cons (buffer-name (window-buffer wind)) pgrm)))))
1143: (if pgrm (car pgrm) ; Return value if a window is displaying
1144: ; a candidate gp-program.
1145: (mapcar
1146: (lambda (abuffer)
1147: (if (gp-pgrmp abuffer)
1148: (setq pgrm (cons (buffer-name abuffer) pgrm))))
1149: (buffer-list))
1150: (if pgrm (car pgrm) ; Return value if a buffer is
1151: ; candidate gp-program.
1152: nil ; Return value if fail.
1153: ))))
1154:
1155: (defun gp-window-manager (my-buffer-name option)
1156: "Takes care of the windows in gp-mode and gp-script-mode.
1157: Displays the buffer MY-BUFFER-NAME in a proper window.
1158: The variable OPTION is
1159: -- gp-beginning when we handle the beginning of a procedure. If a buffer
1160: already exists with this name, only store the wind-conf.
1161: -- gp-beginning-temp when we handle the beginning of a procedure. If a
1162: buffer already exists with this name, store it.
1163: -- gp-remove-help-now to remove help-window,
1164: -- gp-remove-help-old-config to wait and remove help-window without
1165: touching to the other windows.
1166: -- gp-remove-help-now-old-config to remove help-window without
1167: touching to the other windows.
1168: -- gp-show-help which is similar to gp-beginning for the help buffer
1169: except that we do not erase the content of this buffer.
1170: -- nil when it is the end of a call.
1171: The variable MY-BUFFER-NAME is one of
1172: \"*PARI*\" \"*gp-help*\" \"*gp-menu*\". "
1173:
1174: (cond ((and (string= my-buffer-name "*PARI*")
1175: (eq option 'gp-beginning)
1176: (get-buffer-window "*PARI*"))
1177: ;; We go to *PARI* and a window already exists with this buffer.
1178: (gp-store-wind-conf)
1179: (select-window (get-buffer-window "*PARI*")))
1180:
1181: ((and (string= my-buffer-name "*PARI*")
1182: (eq option 'gp-beginning)
1183: (not (get-buffer-window "*PARI*")))
1184: ;; We go to *PARI* and a window doesn't exist with this buffer.
1185: (if (= (count-windows) 1)
1186: ;; If there is only one window which contains anything but scratch ;a gp-program,
1187: ;; split the window in 2, else use this window:
1188: (progn (if (not (string= (buffer-name) "*scratch*")) ;;(gp-pgrmp (window-buffer))
1189: (select-window (split-window-vertically)))
1190: (switch-to-buffer "*PARI*"))
1191: ;; At least two windows exist. Do not create another one
1192: ;; and first try to use the help window, else the
1193: ;; starting window.
1194: (gp-store-wind-conf)
1195: (cond ((get-buffer-window "*gp-help*")
1196: (select-window (get-buffer-window "*gp-help*"))
1197: (switch-to-buffer "*PARI*"))
1198: (t (switch-to-buffer-other-window "*PARI*")))))
1199:
1200: ((and (string= my-buffer-name "*PARI*")
1201: (not option)
1202: (get-buffer "*PARI*"))
1203: ;; We want to exit from *PARI*.
1204: (if (> (count-windows) 1)
1205: (delete-windows-on "*PARI*")
1206: ;; Else only one window.
1207: (if (string= (buffer-name (window-buffer)) "*PARI*")
1208: ;; This only window displays "*PARI*"
1209: (let ((next-buffer (gp-possible-file-name)))
1210: (if next-buffer (switch-to-buffer next-buffer)
1211: ;; Else, don't know what to do !
1212: (gp-restore-wind-conf)
1213: ))))
1214: (or gp-keep-PARI-buffer-when-quitting
1215: (kill-buffer "*PARI*")))
1216:
1217: ((and (get-buffer my-buffer-name)
1218: (member my-buffer-name '("*gp-help*" "*gp-menu*"))
1219: (eq option 'gp-remove-help-now)
1220: (get-buffer-window my-buffer-name))
1221: ;; A buffer displaying "*gp-help*" or "*gp-menu*" exists.
1222: ;; We want to remove the message.
1223: (if (or (string= my-buffer-name "*gp-help*")
1224: (not (get-buffer "*gp-help*")))
1225: ;; Exit from help or the gp-menu is alone:
1226: (gp-restore-wind-conf)
1227: (if (string= my-buffer-name "*gp-menu*")
1228: ;; The previous condition should always be verified!
1229: ;; We should remove the window displaying gp-menu:
1230: (progn
1231: (if (and (= (count-windows) 2)
1232: (get-buffer "*gp-help*"))
1233: (progn
1234: (gp-depile-wind-conf)
1235: (switch-to-buffer "*gp-help*")
1236: (other-window 1))
1237: (gp-restore-wind-conf)))))
1238: ;; We have to kill the buffer (in any case) and select
1239: ;; a proper buffer for this window in case this killing
1240: ;; made something weird appear:
1241: (gp-kill-buffer-safely my-buffer-name)
1242: ;; since it may have been destroyed by 'gp-restore-wind-conf.
1243: (let ((buffer-to-select ""))
1244: (save-excursion
1245: (let ((abufferlist (buffer-list)))
1246: (while (and (string= buffer-to-select "")
1247: abufferlist)
1248: (set-buffer (car abufferlist))
1249: (if (memq major-mode '(gp-script-mode gp-mode))
1250: (setq buffer-to-select (buffer-name)))
1251: (setq abufferlist (cdr abufferlist)))))
1252: ;; Last weird case to handle: the buffer we have selected
1253: ;; is already being shown on another window.
1254: ;; Then kill our window.
1255: (if nil ;(buffer-visiblep buffer-to-select)
1256: (delete-window)
1257: (or (string= buffer-to-select "") ;; Let it be !
1258: (switch-to-buffer buffer-to-select)))))
1259:
1260: ((and (get-buffer my-buffer-name)
1261: (member my-buffer-name '("*gp-help*" "*gp-menu*"))
1262: (memq option '(gp-remove-help-old-config
1263: gp-remove-help-now-old-config)))
1264: ;; A buffer displaying "*gp-help*" or gp-menu exists.
1265: ;; We want to remove the message without touching
1266: ;; to the window-configuration.
1267: (cond ((eq option 'gp-remove-help-old-config)
1268: (message (gp-messager 5))
1269: (read-event)))
1270: (kill-buffer my-buffer-name))
1271:
1272: ((and (string= my-buffer-name "*gp-help*")
1273: (memq option '(gp-beginning gp-show-help))
1274: (get-buffer-window "*gp-help*"))
1275: ;; We go to *gp-help* and a window already exists with this buffer.
1276: (select-window (get-buffer-window "*gp-help*"))
1277: (or (eq option 'gp-show-help) (erase-buffer)))
1278:
1279: ((and (string= my-buffer-name "*gp-help*")
1280: (eq option 'gp-beginning-temp)
1281: (get-buffer-window "*gp-help*"))
1282: ;; We go temporarily to *gp-help* and a window already exists with
1283: ;; this buffer.
1284: (gp-store-wind-conf)
1285: (select-window (get-buffer-window "*gp-help*"))
1286: (erase-buffer))
1287:
1288: ((and (get-buffer my-buffer-name)
1289: (member my-buffer-name '("*gp-help*" "*gp-menu*"))
1290: (eq option 'gp-remove-help-now))
1291: ;; Since it got here, my-buffer-name is not displayed.
1292: (gp-kill-buffer-safely my-buffer-name))
1293:
1294: ((and (string= my-buffer-name "*gp-help*")
1295: (memq option '(gp-beginning gp-beginning-temp gp-show-help))
1296: (not (get-buffer-window "*gp-help*")))
1297: ;; We go to *gp-help* and a window doesn't exist with this buffer.
1298: (gp-store-wind-conf)
1299: (if (= (count-windows) 1)
1300: (progn (select-window (split-window-vertically))
1301: (switch-to-buffer "*gp-help*"))
1302: (cond ((and (get-buffer-window "*PARI*")
1303: (not (eq (get-buffer-window "*PARI*") (selected-window))))
1304: (select-window (get-buffer-window "*PARI*"))
1305: (switch-to-buffer "*gp-help*"))
1306: (t (switch-to-buffer-other-window "*gp-help*"))))
1307: (or (eq option 'gp-show-help) (erase-buffer)))
1308:
1309: ((and (string= my-buffer-name "*gp-menu*")
1310: (eq option 'gp-beginning))
1311: ;; We go to gp-menu.
1312: (if (get-buffer "*gp-menu*")
1313: ;; A gp-menu already exists. Kill it first:
1314: (save-excursion
1315: (set-buffer "*gp-menu*")
1316: (gp-menu-quit)))
1317: (gp-store-wind-conf)
1318: (if (get-buffer-window "*gp-help*")
1319: (progn
1320: (select-window (get-buffer-window "*gp-help*"))
1321: (switch-to-buffer
1322: (get-buffer-create "*gp-menu*"))
1323: (kill-buffer "*gp-help*"))
1324: (if (= (count-windows) 1)
1325: (split-window-vertically))
1326: (switch-to-buffer-other-window
1327: (get-buffer-create "*gp-menu*"))))
1328: )) ; end of 'gp-window-manager
1329:
1330: ;;----------------
1331: ;; THE GP PROCESS
1332: ;;----------------
1333:
1334: (defsubst gp-make-gp-prompt-pattern (a-pattern)
1335: "Add regexp a-pattern at beginning of line and followed by any
1336: amount of space/tab/newline to gp-prompt-pattern."
1337: ;; gp-prompt-pattern matches:
1338: ;; (New prompt plus any following white space) OR (Old pattern).
1339: (setq gp-prompt-pattern
1340: (concat "^" a-pattern "[\n\t ]*\\|" gp-prompt-pattern)))
1341:
1342: (defsubst gp-beginning-of-last-line nil
1343: (goto-char (point-max))
1344: (re-search-backward gp-prompt-pattern)
1345: (goto-char (match-end 0)))
1346:
1347: (defsubst gp-wait-for-output (point-init &optional nomessage process initialp)
1348: "Hang around until the prompt appears.
1349: PROCESS defaults to gp-process."
1350: (let ((notdone t))
1351: (or process (setq process gp-process))
1352: (while notdone
1353: ;; Wait till something comes out:
1354: (while (and (not (accept-process-output process 0 300))
1355: (not (= point-init (point)))
1356: ;; Following line is required for the \q command:
1357: (eq 'run (process-status process))))
1358: (let ((p (point)))
1359: (if (or
1360: ;; Following lines are required for the \q command:
1361: (not (and (processp process)
1362: (eq 'run (process-status process))))
1363: (save-excursion
1364: (if (re-search-backward gp-prompt-pattern nil t)
1365: (= (match-end 0) (point-max))
1366: nil)))
1367: ;; If gp is not running, or the prompt has appeared, stop.
1368: (progn (or nomessage (message (gp-messager 6)))
1369: (setq notdone nil))
1370: ;; Else flush the buffer and wait a bit longer.
1371: (progn (or nomessage (message (gp-messager 7)))))
1372: (goto-char p))))
1373: (sit-for 0))
1374:
1375: (defun gp-get-shell (process-name process-buffer-name cmd)
1376: "Explicit. Distinguishes bash/sh and [t]csh. Aimed at command gp+parameters."
1377: ;; We put the number of lines to 1000 so that no break will
1378: ;; occur when giving long comment like with "?6". We do not
1379: ;; want any "Return to continue", the editing job should
1380: ;; be done by emacs and not by gp.
1381: (if (member (file-name-nondirectory shell-file-name) '("bash" "sh"))
1382: (start-process process-name process-buffer-name
1383: shell-file-name "-c"
1384: (concat "(TERM=emacs; LINES=1000; COLUMNS="
1385: (number-to-string (window-width))
1386: "; export TERM COLUMNS LINES; " cmd ")"))
1387: (start-process process-name process-buffer-name
1388: shell-file-name "-c" ; .../[t]csh is the shell!
1389: (concat "stty -echo nl; env TERM=emacs LINES=1000 COLUMNS="
1390: (number-to-string (window-width)) " "
1391: cmd))))
1392:
1393: (defun gp-call-gphelp (win-size word output-buffer opt)
1394: "Explicit. Distinguishes bash/sh and [t]csh."
1395: (if (member (file-name-nondirectory shell-file-name) '("bash" "sh"))
1396: (shell-command
1397: (concat "(export COLUMNS=" (number-to-string win-size) ";"
1398: gp-gphelp-dir "gphelp " opt " \"" word "\";)") output-buffer)
1399: (shell-command
1400: (concat "setenv COLUMNS " (number-to-string win-size) ";"
1401: gp-gphelp-dir "gphelp " opt " \"" word "\"") output-buffer)))
1402:
1403: (defmacro gp-background (flag)
1404: "Same as 'gp except that it doesn't switch to the buffer `*PARI*'.
1405: The answer is t if success, and nil otherwise."
1406: (` (save-excursion
1407: (if (and (processp gp-process)
1408: (eq 'run (process-status gp-process)))
1409: t ; If gp is already running, do nothing.
1410:
1411: ;; Else start up gp in the buffer.
1412:
1413: ;; Create the buffer `*PARI*' if required.
1414: (set-buffer (get-buffer-create "*PARI*"))
1415: (erase-buffer)
1416: ;; Form the command line string.
1417: (run-hooks 'pari-mode-hook 'gp-mode-hook)
1418: (let*((process-connection-type t) ; use PTY.
1419: (flag (or (, flag) gp-prompt-for-args))
1420: (gp-cmd
1421: (concat
1422: (gp-read-input "Gp executable ?" gp-file-name "" flag)
1423: (gp-read-input "Stack size ?" (number-to-string gp-stack-size)
1424: " -s " flag)
1425: (gp-read-input "Prime limit ?" (number-to-string gp-prime-limit)
1426: " -p " flag)
1427: " -emacs" ; -emacs requested by gp2.
1428: )))
1429:
1430: ;; Insert the command line string into the *PARI* buffer (for reference)
1431: (insert (format (gp-messager 41) gp-cmd)) ;(concat "Called with: " gp-cmd "\n\n"))
1432: ;; Start gp.
1433: (setq gp-process (gp-get-shell "pari" "*PARI*" gp-cmd))
1434: ;; Clean up when the gp process has finished.
1435: (set-process-sentinel gp-process (function gp-sentinel)))
1436: ;; We should run the hook as the prompt may have
1437: ;; been changed in the .gprc:
1438: (run-hooks 'pari-mode-hook)
1439: (gp-wait-for-output (point-min))
1440: (setq gp-input-start (point) gp-input-end (point))
1441: ;; Introduce 'gp-mode
1442: ;; (Should be here as the prompt needs a gp-session running,
1443: ;; as well as the choice readline on/off):
1444: (if (eq major-mode 'gp-mode) nil (gp-mode))
1445: (setq mode-line-process '(": %s"))
1446: (if (memq (process-status gp-process) '(signal exit))
1447: (setq gp-process nil) t)))))
1448:
1449: (defun gp (flag)
1450: "
1451: Open a buffer and a window for the execution of gp.
1452:
1453: The following bindings are available:
1454: \\{gp-map}
1455:
1456: The variables
1457: gp-file-name gp-stack-size gp-prime-limit
1458: determine the command line that starts gp.
1459: To override the default settings, give gp a prefix argument.
1460: C-u M-x gp ."
1461:
1462: (interactive "P")
1463: (if (gp-background flag)
1464: (progn
1465: (gp-window-manager "*PARI*" 'gp-beginning)
1466: ;; Hilight first prompt:
1467: (goto-char (point-max))
1468: (gp-update-hilit))
1469: (message (gp-messager 8))))
1470:
1471: (defun gp-run-in-region (beg end)
1472: "Run GP on the current region. A temporary file (gp-temp-file) is
1473: written in gp-temp-directory, but GP is run in the current directory."
1474: ;; Set gp-input-start, gp-input-end and gp-reads-this-buffer.
1475: (interactive "r")
1476: (setq gp-input-start beg gp-input-end end)
1477: (setq gp-reads-this-buffer (buffer-name))
1478: (gp-input-filter)
1479: (write-region beg end gp-temp-file nil nil)
1480: (gp nil) ;; In case a GP-process was not already running, starts one.
1481: ;; In any case, switches to buffer "*PARI*".
1482: (gp-beginning-of-last-line)
1483: (insert (concat "\\r " gp-temp-file))
1484: (set-marker (process-mark gp-process) (point))
1485: (gp-send-input))
1486:
1487: (defun gp-read-input (prompt default sep flag)
1488: "If flag is non-nil, reads string (if string is \"\" uses default).
1489: Else, if flag is nil, set string to default.
1490: If resulting string is not \"\" prepends sep.
1491: As a special case, if string is \" \", return \"\"."
1492:
1493: (let ((string
1494: (if flag
1495: ;; If flag is non-nil prompt for input from mini-buffer.
1496: (read-input
1497: (concat prompt " (Default "default") "))
1498: ;; Else use the default string.
1499: default)))
1500:
1501: (if (equal string "")
1502: (if (equal default "")
1503: "" ;; If string and default both "":
1504: (concat sep default)) ;; If string "" and default is non empty:
1505: (if (equal string " ")
1506: "" ;; If string is a space:
1507: (concat sep string))))) ;; If string is non empty:
1508:
1509: (defun gp-sentinel (proc msg)
1510: "Sentinel for the gp-process in buffer *PARI*."
1511:
1512: (gp-kill-buffer-safely "*gp-menu*")
1513: (gp-window-manager "*gp-help*" 'gp-remove-help-now)
1514: ;; We do not kill the buffer "*Completions*" as it may have
1515: ;; been triggered by something else.
1516: (gp-window-manager "*PARI*" nil)
1517: (gp-clear-temp-files)
1518: (setq gp-process nil))
1519:
1520: (defun gp-output-filter ()
1521: (let ((wind (selected-window))
1522: (errp (save-excursion
1523: (goto-char (1+ gp-input-end))
1524: (looking-at "^ \\*\\*\\* \\|^Unknown function"))))
1525: (if errp
1526: (progn
1527: (let ((copy (buffer-substring (1+ gp-input-end)
1528: (progn
1529: (goto-char (point-max)) ;; We should already be there!
1530: ;; Remove last prompt line ...
1531: (beginning-of-line)
1532: ;; and final empty lines:
1533: (skip-chars-backward " \t\n")
1534: (point)))))
1535: (delete-region gp-input-end (point-max))
1536: (gp-store-wind-conf)
1537: (other-window 1)
1538: (split-window-vertically)
1539: ;(other-window 1)
1540: (switch-to-buffer (get-buffer-create "*gp-messages*"))
1541: (erase-buffer)
1542: (insert copy)
1543: (shrink-window-if-larger-than-buffer)
1544: (goto-char (point-min))
1545: (gp-info-wind-conf)
1546: (select-window wind))))))
1547:
1548: (defsubst gp-frame-parameter (frame parameter)
1549: (if old-emacs-versionp
1550: (cond ((eq parameter 'cursor-color) "black")
1551: ((eq parameter 'background-color) "blue")
1552: ((eq parameter 'font) (nth 1 (assoc "Default" (assoc "Misc" x-fixed-font-alist))))
1553: (t nil))
1554: (frame-parameter frame parameter)))
1555:
1556: (defun gp-special-output-filter nil
1557: (let ((errp (save-excursion
1558: (goto-char (1+ gp-input-end))
1559: (or (looking-at "^ \\*\\*\\* unexpected character: \\.\\.\\.")
1560: (looking-at "^ \\*\\*\\* expected character: [^\n]*\n \\*\\*\\* instead of: ")
1561: (looking-at "^ \\*\\*\\* expected character: [^\n]*\n \\*\\*\\* instead of:\n \\*\\*\\* \\.\\.\\.")
1562: (looking-at "^ \\*\\*\\* unknown function or error in formal parameters:\n \\*\\*\\* \\.\\.\\.")
1563: (looking-at "^ \\*\\*\\* unexpected character: "))
1564: )))
1565: (if errp ;; T if an error has been detected.
1566: (progn
1567: (goto-char (match-end 0))
1568: (let* (;; the line containing the mistake:
1569: (astring (buffer-substring (point)
1570: (progn (end-of-line) (point))))
1571: ;; how many characters of astring have been sent to
1572: ;; gp-latest-error:
1573: (place 1)
1574: ;; "location" of the mistake:
1575: (which-char (+ (length astring) (- (search-forward "^")
1576: (progn (end-of-line) (point))))))
1577: ;; We create gp-latest-error:
1578: (setq gp-latest-error (concat "\\(" (regexp-quote (substring astring 0 1))))
1579: (while (< place (length astring))
1580: (setq gp-latest-error
1581: (concat gp-latest-error "[ \t\n]*\\(\\(/\\*[^\\*]*\\*/\\|\\\\\\.*$\\)[ \t\n]*\\)*"
1582: (regexp-quote (substring astring place (setq place (1+ place))))))
1583: (if (= place which-char)
1584: (setq gp-latest-error (concat gp-latest-error "\\)"))))
1585: (select-window (get-buffer-window gp-reads-this-buffer))
1586: (goto-char (point-min))
1587: (gp-skip-to-error))))))
1588:
1589: (defun gp-skip-to-error nil
1590: (interactive)
1591:
1592: (if (and gp-reads-this-buffer gp-latest-error
1593: (buffer-live-p (get-buffer gp-reads-this-buffer)))
1594: (progn
1595: (if (string= (buffer-name) gp-reads-this-buffer) nil
1596: (switch-to-buffer gp-reads-this-buffer)
1597: (goto-char (point-min)))
1598: (if (re-search-forward gp-latest-error nil t)
1599: (progn (goto-char (1- (match-end 1)))
1600: ;; Warn the user this place is maybe not the good one !:
1601: (message (gp-messager 35))
1602: ;; Make the cursor blink:
1603: (let ((old-color (gp-frame-parameter nil 'cursor-color))
1604: ;; Does not work... Why ? :
1605: (other-color (gp-frame-parameter nil 'background-color))
1606: (how-many 6) (how-long-dark 50) (how-long-light 70) aux)
1607: ;; The lighter color should stay longer. In case of a dark background
1608: ;; exchange the times:
1609: (if (eq hilit-background-mode 'dark)
1610: (progn (setq aux how-long-light)
1611: (setq how-long-light how-long-dark)
1612: (setq how-long-dark aux)))
1613: (setq other-color "blue")
1614: (while (> how-many 0)
1615: (set-cursor-color other-color)
1616: (sit-for 0 how-long-light)
1617: (set-cursor-color old-color)
1618: (sit-for 0 how-long-dark)
1619: (setq how-many (1- how-many)))
1620: (set-cursor-color other-color)
1621: (sit-for 0 how-long-light)
1622: (set-cursor-color old-color)))
1623: ;; Could not locate the error:
1624: (message (gp-messager 34))))
1625: (message (gp-messager 36))))
1626:
1627: (defun gp-usual-start nil
1628: "Start a GP session."
1629: (interactive)
1630: (gp nil) ;; In case a GP-process was not already running, starts one.
1631: ;; In any case, switch to buffer "*PARI*".
1632: )
1633:
1634: (defun gp-start-with-parameters nil
1635: "Start a GP session."
1636: (interactive)
1637: (gp t) ; In case a GP-process was not already running, starts one.
1638: ; In any case, switch to buffer "*PARI*".
1639: )
1640:
1641: (defun run-gp nil
1642: "Sends a file to be run under GP."
1643: ;; This command is simply a compositum of 'gp-usual-start
1644: ;; and 'gp-meta-r. However the default file is different.
1645: (interactive)
1646: (let* ((gp-pgrm (gp-read-input (gp-messager 69)
1647: (gp-possible-file-name) "" t)))
1648: (if (get-buffer gp-pgrm)
1649: (save-excursion
1650: (set-buffer gp-pgrm)
1651: (setq gp-reads-this-buffer gp-pgrm)
1652: (if (buffer-modified-p) (save-buffer))
1653: (setq gp-input-start (point-min)
1654: gp-input-end (point-max))
1655: (gp-input-filter)
1656: ;; In case 'gp-input-filter modified the buffer:
1657: (setq gp-pgrm (buffer-file-name))
1658: (if (buffer-modified-p) (save-buffer 0))))
1659: (gp nil) ;; In case a GP-process was not already running, starts one.
1660: ;; In any case, switches to buffer "*PARI*".
1661: (gp-beginning-of-last-line)
1662: (insert (concat "\\r " gp-pgrm))
1663: (set-marker (process-mark gp-process) (point))
1664: (gp-send-input)))
1665:
1666: (defun gp-C-j nil
1667: (interactive)
1668: (insert-char ?\n 1)
1669: (put-text-property (1- (point)) (point) 'gp-virtual-newline t))
1670:
1671: (defsubst gp-is-virtual (where)
1672: (get-text-property where 'gp-virtual-newline))
1673:
1674: (defsubst gp-end-of-inputp nil
1675: ;; Beware we do not impose the initial point to be at end of line !!
1676: (save-excursion
1677: (forward-char -1)
1678: (and (not (and (looking-at "\n")
1679: (gp-is-virtual (point))))
1680: (not (and (looking-at "\n")
1681: (save-excursion
1682: (forward-char -1)
1683: (looking-at "\\\\"))))
1684: (not (looking-at "\\\\")))))
1685:
1686: (defun gp-find-end-of-input (end)
1687: "Gives the position of next end-of-input and nil if none."
1688: (save-excursion
1689: (while (and (re-search-forward "\n" end t)
1690: (not (gp-end-of-inputp))))
1691: (if (and (char-equal (char-after (1- (point))) ?\n)
1692: (gp-end-of-inputp))
1693: (point)
1694: ;; No more newlines in sight:
1695: (goto-char (point-max))
1696: (if (gp-end-of-inputp) (point) nil))))
1697:
1698: (defun gp-copy-input (&optional nocontrol)
1699: "Copy expression around point to the end of the buffer.
1700: (Unless this is already the last expression.)
1701: If NOCONTROL is non nil, then 'gp-complete-expression is
1702: automatically set to t and emacs will not check whether the
1703: expression is complete or not."
1704:
1705: (interactive)
1706: ;; Go back to the end of prompt, and record that point.
1707: (re-search-backward gp-prompt-pattern)
1708: (goto-char (setq gp-input-start (match-end 0))) ;; end of prompt
1709: (setq gp-input-start-bracketp (looking-at "[ \t]*{"))
1710:
1711: (let ((lastp t)) ;; t if this input is ths last one
1712: ;; (i.e. is not followed by a prompt).
1713: (if gp-input-start-bracketp
1714: (progn
1715: (save-excursion
1716: (if (re-search-forward "}" nil t)
1717: (setq gp-input-end (point))
1718: (setq gp-input-end nil)))
1719: (setq lastp (not (re-search-forward gp-prompt-pattern nil t)))
1720: (if (or (and (not lastp) gp-input-end
1721: (< (match-beginning 0) gp-input-end))
1722: (not gp-input-end))
1723: ;; Bad or unfinished construct:
1724: (progn
1725: (if lastp
1726: ;; Repair the \n:
1727: (progn
1728: (goto-char gp-input-start)
1729: (while (search-forward "\n" nil t)
1730: (put-text-property (1- (point)) (point)
1731: 'gp-virtual-newline t)))
1732: (setq gp-input-end (match-beginning 0)))
1733: (setq gp-input-start-bracketp nil)))))
1734:
1735: (if gp-input-start-bracketp ;; properly enclosed expression.
1736: (setq gp-complete-expression t)
1737:
1738: (setq gp-input-end (gp-find-end-of-input (point-max)))
1739: (if gp-input-end
1740: (setq gp-complete-expression t)
1741: (goto-char (point-max))
1742: (setq gp-input-end (point-max))
1743: (setq gp-complete-expression (gp-end-of-inputp)))
1744:
1745: (setq lastp (equal gp-input-end (point-max)))
1746: (if (not lastp)
1747: ;; It is not the last expression:
1748: (setq gp-input-end (1- gp-input-end)))
1749: ;; Remove trailing (virtual) \n :
1750: (if (char-equal (char-after (1- gp-input-end)) ?\n)
1751: (progn
1752: (goto-char gp-input-end)
1753: (re-search-backward "[^\n]\\(\n\\)" gp-input-start t)
1754: (setq gp-input-end (match-beginning 1))
1755: (goto-char gp-input-end)
1756: (put-text-property (point) (1+ (point)) 'gp-virtual-newline nil)
1757: (setq gp-complete-expression (gp-end-of-inputp))))
1758:
1759: ;; We refine 'gp-complete-expression:
1760: (let ((ans (parse-partial-sexp gp-input-start gp-input-end)) a-pt)
1761: (setq gp-complete-expression
1762: (or nocontrol
1763: (and gp-complete-expression
1764: (equal (nth 0 ans) 0) ; Depth in parens is 0.
1765: (not (nth 3 ans)) ; Not inside a string.
1766: (or (not (nth 4 ans)) ; Not inside a comment...
1767: (nth 7 ans)) ; except if it starts with \\.
1768: )))))
1769:
1770: (goto-char (point-max))
1771: (if (not lastp)
1772: ;; It is not the last expression:
1773: (progn
1774: (insert (buffer-substring gp-input-start gp-input-end))
1775: (if gp-complete-expression
1776: nil
1777: (ding)
1778: (message (gp-messager 9)))))))
1779:
1780: (defun gp-input-filter nil
1781: "Look at buffer between gp-input-start and gp-input-end.
1782: -- If it finds a string `default(prompt,foo)', and
1783: foo is a gp-string, try to set gp-prompt-pattern
1784: correctly. If foo is not a string, warn the user that
1785: something wrong may happen.
1786: -- If a line `\\@' is found, set variable 'gp-should-wait-for-ouputp
1787: to nil.
1788: -- If a comment `/* */' starts by a @, the content is understood
1789: as a Lisp command and appended to the file gp-el-temp-file. This
1790: file is empty at the beginning. This file is loaded before execution
1791: of the gp program."
1792: ;; Follow 'gp-copy-input so the input has been copied at the end
1793: ;; of the buffer. 'gp-input-start and 'gp-input-end are set.
1794: (interactive)
1795: (save-excursion
1796:
1797: ;; Take care of `/*@ foo */':
1798: (goto-char gp-input-start)
1799: (let ((first-time t))
1800: (while (re-search-forward "/\\*@\\(\\([^\\*]\\|\\*[^/]\\)*\\)\\*/" gp-input-end t)
1801: (if first-time
1802: (progn (setq first-time nil)
1803: (if (file-exists-p gp-el-temp-file)
1804: ;; Remove any older version:
1805: (delete-file gp-el-temp-file))))
1806: ;; Append the Lisp part to the file "gp-prgm":
1807: (write-region (match-beginning 1) (match-end 1) gp-el-temp-file t)
1808: (write-region "\n" nil gp-el-temp-file t)
1809: (goto-char (match-end 0)))
1810: (if first-time nil
1811: ;; Load the Lisp part:
1812: (load-file gp-el-temp-file))))
1813:
1814: ;; Run filter hooks if any. It should be here since the hook
1815: ;; may have been defined precisely in this file.
1816: ;; Should not be surrounded by a save-excursion !
1817: (run-hooks 'gp-input-filter-hook)
1818:
1819: (save-excursion
1820: ;; Warn the user that `default(prompt,APROMPT)' may not work properly.
1821: (goto-char gp-input-start)
1822: (while (re-search-forward "default(prompt," gp-input-end t)
1823: ;; Try to set the prompt if it is a simple string.
1824: (goto-char (match-end 0))
1825: (let ((start (1+ (match-end 0))))
1826: (if (and (looking-at "[ ]*\"")
1827: (re-search-forward "\")" gp-input-end t))
1828: (gp-make-gp-prompt-pattern
1829: (gp-make-prompt-pattern
1830: (buffer-substring start (- (match-end 0) 2))))
1831: ;; Else troubles...
1832: (message (gp-messager 10))
1833: (sit-for 2))))
1834:
1835: ;; Take care of `\\@':
1836: (goto-char gp-input-start)
1837: (if (re-search-forward "^\\\\\\\\@$" gp-input-end t)
1838: (setq gp-should-wait-for-outputp nil))
1839:
1840: ;; Take care of virtual-newlines:
1841: (goto-char gp-input-start)
1842: (while (re-search-forward "[^\\\\]\\(\n\\)" gp-input-end t)
1843: (if (gp-is-virtual (1- (point)))
1844: (progn
1845: (replace-match "\\\n" t t nil 1)
1846: (forward-char -1)
1847: (setq gp-input-end (1+ gp-input-end)))))
1848: ))
1849:
1850: (defun gp-treat-special-inputp nil
1851: (save-excursion
1852: (beginning-of-line)
1853: (cond ((looking-at "---- (type return to continue) ----")
1854: (setq gp-complete-expression t)
1855: (end-of-line)
1856: (setq gp-input-start (point) gp-input-end (point))
1857: t)
1858: ((looking-at (concat "\\(" gp-prompt-pattern "\\)\\?\\\\"))
1859: (setq gp-complete-expression t)
1860: (end-of-line)
1861: (setq gp-input-start (- (point) 2) gp-input-end (point))
1862: t)
1863: (t nil))))
1864:
1865: (defun gp-send-input (&optional localp)
1866: "Sends input to gp. Does not send incomplete expressions
1867: ie those starting with {, without a matching }, or those
1868: ending with \\ .
1869: Uses a temporary file (and \\r ) for large expressions.
1870: If LOCALP is non nil, then it is assumed the input comes
1871: from the *PARI* buffer, in which case if this input was a
1872: `\r '-command, sends the output to 'gp-output-filter.
1873: If LOCALP is nil, then if a file is being read which is
1874: currently being displayed, sends the output to 'gp-special-output-filter.
1875:
1876: Sub-functions are 'gp-treat-special-inputp and 'gp-copy-input
1877: with whom it shares the variables:
1878: 'gp-input-start 'gp-input-end 'gp-complete-expression
1879: 'gp-input-start-backetp 'gp-reads-this-buffer."
1880:
1881: (if (gp-treat-special-inputp)
1882: nil ;; already treated.
1883: (gp-copy-input)) ;; does all the work!
1884: (if gp-complete-expression
1885: ;; If it is a complete expression do this:
1886: (progn
1887: (insert "\n")
1888: (gp-input-filter)
1889: (if (> (- gp-input-end gp-input-start) 1023)
1890: ;; If large expression, use a temporary file.
1891: (progn
1892: (write-region gp-input-start gp-input-end gp-temp-file)
1893: (process-send-string gp-process (concat "\\r "gp-temp-file"\n")))
1894: ;; Else use process-send-region.
1895: (if gp-input-start-bracketp
1896: (process-send-region gp-process gp-input-start gp-input-end)
1897: (process-send-string gp-process "{")
1898: (process-send-region gp-process gp-input-start gp-input-end)
1899: (process-send-string gp-process "}"))
1900: (process-send-string gp-process "\n"))
1901: (set-marker (process-mark gp-process) (point))
1902: (if gp-should-wait-for-outputp
1903: (progn (gp-wait-for-output gp-input-end) (gp-update-hilit))
1904: (setq gp-should-wait-for-outputp t))
1905: (if localp
1906: ;; Sometimes the output should not be sent to the output filter:
1907: (progn
1908: (save-excursion
1909: (goto-char gp-input-start)
1910: (setq localp
1911: (not (re-search-forward "\\\\r +" gp-input-end t))))
1912: (if (and localp (not gp-no-separate-window-for-mistakes))
1913: (gp-output-filter)))
1914: (if (and (stringp gp-reads-this-buffer)
1915: (buffer-visiblep gp-reads-this-buffer))
1916: ;; If an error is detected, and a buffer is visible
1917: ;; containing gp-reads-this-buffer, then we should move the
1918: ;; point to the place where the error is detected.
1919: (gp-special-output-filter))))
1920:
1921: ;; Else (not a complete expression) do this:
1922: (gp-C-j)
1923: (message (gp-messager 9))))
1924:
1925: (defun gp-send-local-input nil
1926: "An input is declared to be `local' if it comes from the *PARI* buffer."
1927: (interactive) (gp-send-input t))
1928:
1929: (defun gp-interrupt ()
1930: "Interrupts gp.
1931: This is identical to interrupt-shell-subjob in shell-mode."
1932: (interactive) (interrupt-process nil t))
1933:
1934: ;;---------------
1935: ;; META-COMMANDS
1936: ;;---------------
1937:
1938: (defmacro gp-meta-cmd-general (cmd window-option)
1939: "With 'gp-beginning for window-option, it is 'gp-meta-cmd.
1940: With nil, it is 'gp-quiet-meta-cmd."
1941: (` (progn
1942: (set-buffer "*PARI*") ;; In case we use it from another buffer,
1943: ;; but a gp process is running.
1944: (goto-char (point-max))
1945: ;; Make gp send text to the buffer end, so we can move it to the help buffer.
1946: (set-marker (process-mark gp-process) (point))
1947: (let ((temp (point)))
1948: ;; Send the meta command to gp.
1949: (process-send-string gp-process (concat (, cmd) "\n"))
1950: ;; Wait for the gp-prompt to be sent.
1951: (gp-wait-for-output temp)
1952:
1953: ;; Display the output in the help buffer:
1954: (let ((copy (buffer-substring temp (point-max))))
1955: (delete-region temp (point-max))
1956: (if (eq (, window-option) 'gp-beginning)
1957: ;;Switch to buffer "*gp-help*":
1958: (gp-window-manager "*gp-help*" (, window-option))
1959: (set-buffer (get-buffer-create "*gp-help*"))
1960: (erase-buffer))
1961:
1962: (insert copy)
1963: (beginning-of-line) ;; We remove the last prompt line.
1964: (delete-region (point) (point-max))
1965: (goto-char (point-min)))))))
1966:
1967: (defun gp-meta-cmd (cmd)
1968: "Send cmd to gp, and display output in help buffer"
1969: (save-excursion
1970: (let ((wind (selected-window)))
1971: (gp-meta-cmd-general cmd 'gp-beginning)
1972: (select-window wind))
1973: (gp-info-wind-conf)))
1974:
1975: (defun gp-quiet-meta-cmd (cmd)
1976: "Send cmd to gp, and copy output in help buffer without displaying it"
1977: (save-excursion (gp-meta-cmd-general cmd nil)))
1978:
1979: (defun gp-set-prompt (p)
1980: "Set new gp prompt (and tell both gp and emacs that you have done so)."
1981:
1982: (interactive "sNew prompt: ")
1983: (let ((my-buffer (buffer-name)) temp)
1984: (set-buffer "*PARI*")
1985: (goto-char (setq temp (point-max)))
1986: ;; New pattern matches p OR old-pattern
1987: (gp-make-gp-prompt-pattern (gp-make-prompt-pattern p))
1988: (gp-tell-hilit-about-patterns)
1989: ;; Tell gp about the change too!
1990: (insert (concat "default(prompt,\"" p "\");\n"))
1991: (process-send-string gp-process (concat "default(prompt,\"" p "\");\n"))
1992: (set-marker (process-mark gp-process) (point))
1993: (gp-wait-for-output temp)
1994: (gp-update-hilit)
1995: ;; In case it is called from the menu-bar, do not write anything:
1996: (message "")
1997: (set-buffer my-buffer)))
1998:
1999: (defun gp-make-prompt-pattern (p)
2000: "Make the regexp that matches the prompt p."
2001: ;; We use the buffer *Messages* to analyse the prompt.
2002: (save-excursion
2003: (set-buffer "*Messages*")
2004: (goto-char (point-max))
2005: (insert "\n" p) ; The "\n" is most probably useless.
2006: (beginning-of-line)
2007: (let ((where (point)) a-char)
2008: (setq p "")
2009: (while (not (eolp))
2010: (if (re-search-forward "%[a-zA-Z%]" nil t)
2011: (setq p
2012: (concat p
2013: (regexp-quote (buffer-substring where
2014: (match-beginning 0)))
2015: (progn (setq a-char (buffer-substring (1- (point)) (point)))
2016: (setq where (point))
2017: ;;Options from strftime:
2018: (cond ((string= a-char "%") "%")
2019: ((member a-char
2020: '("C" "d" "e" "H" "I" "k" "l" "m" "M" "S"
2021: "U" "V" "W" "y"))
2022: "[0-9][0-9]")
2023: ((member a-char '("D" "T"))
2024: "[0-9][0-9]/[0-9][0-9]/[0-9][0-9]")
2025: ((string= a-char "R")
2026: "[0-9][0-9]:[0-9][0-9]")
2027: ((member a-char '("a" "A" "b" "B"))
2028: "[A-Z][a-z]*")
2029: ((string= a-char "n")
2030: "\n")
2031: ;; If everything else fails:
2032: (t (concat "%" a-char))))))
2033: ;; No % anymore:
2034: (goto-char (point-max))
2035: (setq p
2036: (concat p
2037: (regexp-quote (buffer-substring where (point-max))))))))
2038: ;; Now p contains the regexp matching the prompt.
2039: ;; We erase what we have written on this buffer:
2040: (beginning-of-line) (backward-char 1)
2041: (delete-region (point) (point-max))
2042: ;;Return p:
2043: p))
2044:
2045: (defun gp-set-simple-prompt nil
2046: "Set the prompt to \"? \"."
2047: (interactive)
2048: (gp-set-prompt "? "))
2049:
2050: (defun gp-set-time-prompt nil
2051: "Set a prompt that gives the time."
2052: (interactive)
2053: (gp-set-prompt "(%H:%M)> "))
2054:
2055: (defun gp-set-date-prompt nil
2056: "Set a prompt that gives the date."
2057: (interactive)
2058: (gp-set-prompt "%d %b %y >> "))
2059:
2060: (defun gp-set-separator-prompt nil
2061: "Set a prompt with a separator "
2062: (interactive)
2063: (gp-set-prompt "-------------------------%n(%H:%M)> "))
2064:
2065: (defun gp-meta-d ()
2066: "Send \\d to gp, then display output in the help buffer.
2067: Print the gp defaults."
2068: (interactive)
2069: (gp-meta-cmd "\\d"))
2070:
2071: (defun gp-meta-t ()
2072: "Send \\t to gp, then display output in the help buffer.
2073: Print the longword format of PARI types."
2074: (interactive)
2075: (gp-meta-cmd "\\t"))
2076:
2077: (defun gp-meta-r (file)
2078: "Send a \\r <file name> command to gp.
2079: Read in gp commands from a file."
2080: (interactive "fRead from file: ")
2081: (goto-char (point-max))
2082: (insert (concat "\\r " (expand-file-name file)))
2083: (gp-send-input))
2084:
2085: (defun gp-meta-w (file num)
2086: "Send a \\w<num> <file name> command to gp.
2087: Writesgp object %<num> to <file name>."
2088: (interactive "FWrite to file: \nsObject number %%")
2089: (goto-char (point-max))
2090: (insert (concat "\\w"num" " (expand-file-name file)))
2091: (gp-send-input))
2092:
2093: (defun gp-meta-x nil
2094: "Send \\x to gp, then display output in the help buffer.
2095: Print tree of addresses and contents of last object."
2096: (interactive)
2097: (gp-meta-cmd "\\x"))
2098:
2099: (defun gp-meta-v nil
2100: "If gp is running, send \\v to gp, then display output
2101: in the help buffer. Print the version number of this
2102: implementation of pari-gp."
2103: (interactive)
2104: (if (processp gp-process) (gp-meta-cmd "\\v")
2105: (message (gp-messager 11) gp-version)))
2106:
2107: (defun gp-meta-s (num)
2108: "Send \\s or \\s(num) to gp, then display output in the help buffer.
2109: Print the state of the pari stack."
2110: (interactive "sNumber of longwords (default 0) ")
2111: (if (equal num "")
2112: (gp-meta-cmd "\\s")
2113: (gp-meta-cmd (concat "\\s(" num ")" ))))
2114:
2115: (defun gp-meta-a (num)
2116: "Send \\a or \\a<num> to gp, then display output in the help buffer.
2117: Print object %<num> in raw format."
2118: (interactive "sPrint object (default last) %%")
2119: (gp-meta-cmd (concat "\\a" num)))
2120:
2121: (defun gp-meta-b (num)
2122: "Send \\b or \\b<num> to gp, then display output in the help buffer.
2123: Print object %<num> in pretty format."
2124: (interactive "sPrint object (default last) %%")
2125: (gp-meta-cmd (concat "\\b" num)))
2126:
2127: (defun gp-meta-m (num)
2128: "Send \\m or \\m<num> to gp, then display output in the help buffer.
2129: Prins object %<num> in prettymatrix format."
2130: (interactive "sPrint object (default last) %%")
2131: (gp-meta-cmd (concat "\\m" num)))
2132:
2133: (defun gp-meta-q ()
2134: "Send \\q to gp.
2135: Prompt for confirmation before quiting."
2136: (interactive)
2137: (if (y-or-n-p "Quit gp ? ")
2138: (progn
2139: (set-buffer "*PARI*")
2140: (goto-char (point-max))
2141: (process-send-string gp-process "\\q\n")
2142: (setq gp-process nil) ;; Should be automatic with the previous one.
2143: ;; Works better like this.
2144: ))
2145: (message ""))
2146:
2147: (defun gp-break-long-line nil
2148: "gp will not accept lines longer than 1024.
2149: gp-break-long-line breaks current line
2150: inserting \\ every (frame-width)-5 chars."
2151: (interactive)
2152: (let ((length (min (- (frame-width) 5) 250)))
2153: (move-to-column length)
2154: (while (not (looking-at "$"))
2155: (insert "\\\n")
2156: (move-to-column length))))
2157:
2158: (defun gp-hilit-switch nil
2159: (interactive)
2160: ;; When this function is called, gp-can-hilit and gp-hilit are the same.
2161: (setq gp-can-hilit (not gp-can-hilit))
2162: (gp-update-hilit-buffers))
2163:
2164: (defun gp-tutorial-switch nil
2165: (interactive)
2166: (if (setq gp-tutorial-requiredp (not gp-tutorial-requiredp))
2167: (message (gp-messager 12))
2168: (message (gp-messager 13))))
2169:
2170: (defun gp-copy-last-input nil
2171: (interactive)
2172: (save-excursion
2173: (goto-char (point-max))
2174: (if (re-search-backward gp-prompt-pattern nil t 2)
2175: (progn (goto-char (match-end 0))
2176: (gp-copy-input)))))
2177:
2178: (defun gp-previous-cmd nil
2179: "Recall previous gp command."
2180: (interactive)
2181: (gp-relative-cmd -1))
2182:
2183: (defun gp-next-cmd nil
2184: "Step to gp next command line."
2185: (interactive)
2186: (gp-relative-cmd 1))
2187:
2188: (defun gp-relative-cmd (dir)
2189: "Step to previous or next command line according to the first argument
2190: being 1 or -1."
2191: (while (and (zerop (forward-line dir))
2192: (not (looking-at gp-prompt-pattern))
2193: (looking-at "^"))); forward-line at the end of a buffer
2194: (end-of-line))
2195:
2196: (defun gp-toggle-previous-next-behavior nil
2197: "Change C-p/M-p C-n/M-n from previous-line and next-line to
2198: gp-previous-cmd and gp-next-cmd and reciprocally"
2199: (interactive)
2200: (if (equal (key-binding "\C-p") 'previous-line)
2201: (progn
2202: (define-key gp-map "\M-p" 'previous-line)
2203: (define-key gp-map "\M-n" 'next-line)
2204: (define-key gp-map "\C-p" 'gp-previous-cmd)
2205: (define-key gp-map "\C-n" 'gp-next-cmd))
2206: (define-key gp-map "\C-p" 'previous-line)
2207: (define-key gp-map "\C-n" 'next-line)
2208: (define-key gp-map "\M-p" 'gp-previous-cmd)
2209: (define-key gp-map "\M-n" 'gp-next-cmd)))
2210:
2211: (defun gp-toggle nil
2212: "Change some keys. See gp-toggle-previous-next-behavior"
2213: (interactive)
2214: (gp-toggle-previous-next-behavior)
2215: (message (gp-messager 14)))
2216:
2217: (defun gp-remove-last-output nil
2218: (interactive)
2219: (save-excursion
2220: (goto-char (point-max))
2221: (if (re-search-backward gp-prompt-pattern nil t)
2222: (delete-region gp-input-end (point-max)))))
2223:
2224: (defun gp-remove-last-action nil
2225: (interactive)
2226: (save-excursion
2227: (goto-char (point-max))
2228: (if (re-search-backward gp-prompt-pattern nil t)
2229: (let ((where (1- (point))))
2230: (if (re-search-backward gp-prompt-pattern nil t)
2231: (delete-region (1- (point)) where))))))
2232:
2233: ;;-------------------------
2234: ;; GP COMPLETION FUNCTIONS
2235: ;;-------------------------
2236:
2237: (defun gp-mouse-2 (event)
2238: "A kind of hook for 'mouse-choose-completion."
2239: (interactive "e")
2240: (funcall 'mouse-choose-completion event)
2241: ;; 'mouse-choose-completion comes from the standard file "mouse.el".
2242: (gp-restore-wind-conf) (forward-word 1))
2243:
2244: (defun gp-clear-list (lst)
2245: "Remove the lists `(\"\")' from LST."
2246: (let ((newlist nil))
2247: (mapcar (lambda (liststring)
2248: (or (string= (car liststring) "")
2249: (setq newlist (cons liststring newlist))))
2250: lst)
2251: newlist))
2252:
2253: (defun gp-clear-list2 (lst)
2254: "Remove the empty words from LST."
2255: (let ((newlist nil))
2256: (mapcar (lambda (astring)
2257: (or (string= astring "")
2258: (setq newlist (cons astring newlist))))
2259: lst)
2260: newlist))
2261:
2262: (defun gp-make-cpl-list (abuffer)
2263: "Take a buffer in the format of pari.menu, and create the list
2264: whose name is the concatenation of \"gp-cpl-\" and the buffer-name
2265: and which contains all the non-commented lines of the buffer.
2266: The file must have at least one comment line, starting with #, All
2267: lines before the first comment line are IGNORED. Finally add this list
2268: name to 'gp-cpl-lists-list."
2269: (save-excursion
2270: (let ((lst nil) lst-aux astring)
2271: (set-buffer abuffer)
2272: (save-restriction
2273: (widen)
2274: (goto-char (point-min))
2275: (re-search-forward "#")
2276: (while (not (eobp))
2277: (forward-line 1)
2278: (or (looking-at "#")
2279: (add-to-list 'lst
2280: (list
2281: (buffer-substring (point)
2282: (gp-get-end-of-line))))))
2283: (setq astring
2284: (concat "gp-cpl-"
2285: (gp-proper-name (buffer-name))))
2286: (make-symbol astring)
2287: (set (intern astring) (gp-clear-list lst))
2288: (setq lst-aux (list (intern astring)))
2289: (setcdr lst-aux (cdr gp-cpl-lists-list))
2290: (setcdr gp-cpl-lists-list lst-aux)
2291: (kill-buffer abuffer)
2292: ))))
2293:
2294: (defun gp-cpl-file (afile)
2295: "Same as 'gp-make-cpl-list except that we start with a file."
2296: (interactive "fFile of command names: ")
2297: (gp-make-cpl-list (find-file-noselect afile)))
2298:
2299: (defsubst gp-add-symbol (name)
2300: "Add a name to the obarray, if it is not already there."
2301: (make-symbol name)
2302: (intern name gp-c-array))
2303:
2304: (defun gp-cpl-init nil
2305: "Add all the commands listed by gphelp -k \"\" to the obarray
2306: used for completion."
2307: (save-excursion
2308: (set-buffer (get-buffer-create "*gp-menu*"))
2309: (erase-buffer)
2310: (gp-call-gphelp 100 " " t "-k -raw")
2311: (gp-replace "\033\\[.?m" "")
2312: (let ((adoublelist (gp-buffer-to-double-list)))
2313: (mapcar 'gp-add-symbol (car adoublelist))
2314: (setq gp-main-menu-list (nth 1 adoublelist)))
2315: (kill-buffer "*gp-menu*")))
2316:
2317: (defun gp-find-word-to-complete nil
2318: (save-excursion
2319: (let ((pt (point)))
2320: (if (char-equal (preceding-char) ?() (forward-char -1))
2321: (if (not (bolp))
2322: (progn
2323: (forward-char -1)
2324: (if (looking-at "\\w")
2325: (progn (forward-char 1) (forward-word -1))
2326: (forward-char 1))))
2327: ;; In case it is a command-word:
2328: (if (= (preceding-char) ?\\) (forward-char -1))
2329: (if (= (point) pt) " "
2330: (buffer-substring (point) pt)))))
2331:
2332: (defun gp-string-to-list (astring)
2333: "ASTRING is a succession of gp-words separated by spaces or newlines.
2334: The answer is the list of these words."
2335: (let ((lst nil) (beg 0) (end 1))
2336: (while (<= end (length astring))
2337: (cond ((member (aref astring (1- end)) '(?\ ?\n))
2338: (if (not (= beg (1- end)))
2339: (setq lst (nconc lst
2340: (list (substring astring beg (1- end))))))
2341: (setq beg end end (1+ end)))
2342: (t (setq end (1+ end)))))
2343: ;; taking care of the last one:
2344: (if (not (= beg (1- end)))
2345: (setq lst (nconc lst (list (substring astring beg (1- end))))))
2346: lst))
2347:
2348: (defun gp-sort-and-minimise (list1 list2)
2349: "Take two lists of strings and build the list of all their
2350: elements with no repetition and sorted out."
2351: (let ((lst (sort (nconc list1
2352: (mapcar
2353: (lambda (elt) (if (member elt list1) "" elt))
2354: list2))
2355: 'string-lessp)))
2356: (if (string= (car lst) "") (cdr lst) lst)))
2357:
2358:
2359: (defun gp-make-standard-word (word)
2360: "If WORD has a final \"()\", remove it."
2361: ;; When asking for completion and there is a unique completion, readline
2362: ;; adds sometimes `()' at the end of the completion.
2363: (if (and (> (length word) 1)
2364: (string= (substring word (- (length word) 2)) "()"))
2365: (substring word 0 (- (length word) 2))
2366: word))
2367:
2368: (defsubst standard-string= (word1 word2)
2369: (string= (gp-make-standard-word word1)
2370: (gp-make-standard-word word2)))
2371:
2372: (defsubst gp-standard-lst (word comp)
2373: (cond ((and (string= (car comp) "") (null (nth 1 comp)))
2374: (list ""))
2375: ((null (nth 1 comp))
2376: (list (concat word (car comp))))
2377: (t (nth 1 comp))))
2378:
2379: (defun gp-merge-cpls (word comp1 comp2)
2380: (let* ((lst1 (gp-standard-lst word comp1))
2381: (lst2 (gp-standard-lst word comp2))
2382: (a-local-cpl-list (mapcar 'list (gp-sort-and-minimise lst1 lst2))))
2383: (gp-ask-cpl-via-list word 'a-local-cpl-list)))
2384:
2385: (defun gp-ask-cpl-via-list (word lst)
2386: "Careful! LST is a symbol whose value is a list of completion type,
2387: ie a list of lists whose cars are strings used for completion."
2388: ;; LST can be an array also.
2389: (setq lst (symbol-value lst))
2390: (let ((comp (try-completion word lst))
2391: to-insert fun-list)
2392: (cond ((equal comp nil) ; No completion.
2393: (list "" nil))
2394: ((equal comp t) ; Already complete.
2395: (list "" nil))
2396: ((> (length comp) (length word)) ; Some completion with a kernel.
2397: (setq to-insert (substring comp (length word)))
2398: (setq fun-list
2399: (all-completions comp lst))
2400: (if (< (length fun-list) 2)
2401: (list to-insert nil) ; Unique completion.
2402: (list to-insert fun-list)))
2403: (t (setq fun-list
2404: (all-completions comp lst))
2405: (if (< (length fun-list) 2)
2406: (list "" nil) ; Unique completion.
2407: (list "" fun-list))))))
2408:
2409: (defun gp-ask-cpl-via-readline (context)
2410: (let ((to-insert nil) (fun-list ""))
2411:
2412: (if (gp-background nil)
2413: (save-excursion
2414: (set-buffer "*PARI*")
2415: (goto-char (point-max))
2416: (set-marker (process-mark gp-process) (point))
2417: (let ((temp (point)) (last nil))
2418:
2419: ;; ask for all completions (readline command)
2420: (process-send-string gp-process (concat context "\t" ))
2421: (let ((notdone t))
2422: (while notdone
2423: (accept-process-output gp-process)
2424: (let ((p (point)))
2425: (if (or
2426: (not (and (processp gp-process)
2427: (eq 'run (process-status gp-process))))
2428: (search-backward "@E_N_D" (1+ temp) t))
2429: ;; If gp is not running, or @E_N_D has appeared, stop.
2430: (progn
2431: (message (gp-messager 6))
2432: (setq notdone nil last (point)))
2433: ;; Else wait a bit longer.
2434: (message (gp-messager 15)) (goto-char p)))))
2435:
2436: ;; Get end of completed-part:
2437: (search-backward "@" nil t)
2438: (setq to-insert (buffer-substring temp (point)))
2439: (forward-char 1) ;; In order to skip the "@".
2440: ;; Possible further completions:
2441: (if (< (point) last)
2442: (setq fun-list (buffer-substring (point) (1- last))))
2443: (delete-region temp (point-max))
2444: ;; clear line in the gp-process:
2445: (process-send-string gp-process "\C-A\C-K"))))
2446:
2447: (list to-insert (gp-string-to-list fun-list))))
2448:
2449: (defun gp-general-complete (completion-function word)
2450: "Answer a list whose car is an extension of WORD, and whose cdr
2451: is a list of list of possible matching words."
2452: (let ((ans (funcall completion-function word)))
2453: ;; 'gp-find-word-to-complete puts the point at
2454: ;; the end of the word to complete.
2455:
2456: ;; Insert the beginning of the completion
2457: ;; BEFORE any window change :
2458: (if (not (string= (car ans) ""))
2459: (progn
2460: (insert (car ans))
2461: ;; In case of a direct completion via readline:
2462: (if (char-equal (preceding-char) ?)) (forward-char -1))))
2463:
2464: (if (equal (nth 1 ans) nil)
2465: ;; at most one match:
2466: (if (and (get-buffer "*Completions*")
2467: (get-buffer-window "*Completions*"))
2468: ;; Occurs whenever an earlier completion has
2469: ;; been asked for.
2470: (progn
2471: (gp-restore-wind-conf)
2472: (forward-word 1)
2473: ;; In case of a completion via readline:
2474: (if (and (char-after (point))
2475: (char-equal (char-after (point)) ?())
2476: (forward-char 1))
2477: (if (char-equal (preceding-char) ?)) (forward-char -1))))
2478: ;; more than two matches:
2479: (if (string= (car ans) "")
2480: ;; We do not display anything if a partial completion was possible:
2481: (progn
2482: (if (not (and (get-buffer "*Completions*")
2483: (get-buffer-window "*Completions*")))
2484: ;; No use storing wind-conf if some completion is in
2485: ;; progress.
2486: (gp-store-wind-conf))
2487: (with-output-to-temp-buffer "*Completions*"
2488: (display-completion-list (nth 1 ans))))))))
2489:
2490: (defun gp-ask-cpl-via-readline-and-emacs (word)
2491: (interactive)
2492: (let ((lst
2493: (if (or (and gp-readline-enabledp (string= word ""))
2494: (and gp-readline-enabledp gp-process
2495: (equal (process-buffer gp-process) (current-buffer))))
2496: ;; Do not use general completion (let readline work !):
2497: '("" nil)
2498: ;; Ask for general completion:
2499: (gp-ask-cpl-via-list
2500: word (car gp-cpl-lists-list)))))
2501: (mapcar
2502: (lambda (a-cpl-list)
2503: (setq lst
2504: (gp-merge-cpls
2505: word
2506: (gp-ask-cpl-via-list word a-cpl-list)
2507: lst)))
2508: (cdr gp-cpl-lists-list))
2509:
2510: (cond ((and gp-readline-enabledp gp-process
2511: (equal (process-buffer gp-process) (current-buffer)))
2512: (save-excursion
2513: (if (re-search-backward gp-prompt-pattern nil t)
2514: (setq gp-input-start (match-end 0)) ;; end of prompt
2515: (setq gp-input-start (point-min))))
2516: (gp-merge-cpls
2517: word lst
2518: (gp-ask-cpl-via-readline
2519: (buffer-substring gp-input-start (point)))))
2520: (gp-readline-enabledp
2521: (gp-merge-cpls
2522: word lst
2523: (gp-ask-cpl-via-readline
2524: (buffer-substring (gp-get-beginning-of-line) (point)))))
2525: (t lst))))
2526:
2527: (defun gp-complete nil
2528: (interactive)
2529: (gp-general-complete 'gp-ask-cpl-via-readline-and-emacs
2530: (gp-find-word-to-complete)))
2531:
2532: ;;------------------
2533: ;; COMPLETION FILES
2534: ;;------------------
2535:
2536: (defsubst gp-cpl-stamp (my-cpl-file)
2537: "Put a completion-file-stamp on a buffer."
2538: ;; Do not convert that in any other langage ! See gp-actualise-stamp.
2539: (insert (format "\nCompletion File Name: %s\n\n" my-cpl-file))
2540: (insert
2541: "----------------------------------------------------------------\n"
2542: " Created: " (current-time-string) "\n"
2543: " By: " (user-full-name) "\n\n"
2544: " Last Modification: " (current-time-string) "\n"
2545: "----------------------------------------------------------------\n"
2546: "\n### Function Names : (one per line)\n"))
2547:
2548: (defsubst gp-actualise-stamp nil
2549: "Actualise the completion-file-stamp of a buffer."
2550: (goto-char (point-min))
2551: (if (re-search-forward "Last Modification: " nil t)
2552: ;; We have found this string and update what's behind:
2553: (let ((kill-whole-line nil)) ;; local value of global parameter.
2554: (backward-char 1) ;;so that we are sure something is on this line.
2555: (kill-line)
2556: (insert " " (current-time-string)))))
2557:
2558: ;; Edition of completion file. We follow a loose way of working
2559: ;; in case the user edits other buffers in between.
2560:
2561: (defun gp-edit-cpl-file (my-cpl-file)
2562: "Edit my-cpl-file."
2563: (interactive
2564: (list (gp-read-input (gp-messager 33)
2565: (concat (gp-possible-file-name) ".cpl") "" t)))
2566:
2567: (gp-store-wind-conf)
2568: (or (file-exists-p (expand-file-name my-cpl-file))
2569: ;; If the file does not exist, create it (the list may exists though):
2570: (gp-prepare-cpl-file t))
2571: (switch-to-buffer-other-window
2572: (find-file-noselect my-cpl-file))
2573: (goto-char (point-min))
2574: (if (eobp) (gp-cpl-stamp my-cpl-file)
2575: (re-search-forward "#.*$" nil t)
2576: (goto-char (match-end 0))
2577: (if (eobp) (insert "\n") (forward-char 1)))
2578: (message (gp-messager 16)))
2579:
2580: (defsubst gp-cpl-bufferp (abuffer)
2581: (string= (name-extension abuffer) "cpl"))
2582:
2583: (defun gp-quit-cpl-edit nil
2584: (interactive)
2585: (if (gp-cpl-bufferp (buffer-name))
2586: (progn
2587: ;; After entering 'gp-edit-cpl-file,
2588: ;; the user may have edited another completion file...
2589: ;; We don't bother since nothing bad will happen. The
2590: ;; behaviour of emacs may simply daze the user.
2591: (gp-actualise-stamp)
2592: (save-buffer 0) ;; No backup file.
2593: (gp-backward-wind-conf)
2594: )))
2595:
2596: (defsubst gp-make-cpl-help (file)
2597: (if gp-tutorial-requiredp
2598: (let ((wind (selected-window)))
2599: (gp-window-manager "*gp-help*" 'gp-beginning-temp)
2600: (insert (format (gp-messager 30) file file file file))
2601: (fill-region (point-min) (point-max) 'left)
2602: (select-window wind))))
2603:
2604: (defsubst gp-show-help (astring)
2605: (gp-window-manager "*gp-help*" 'gp-beginning-temp)
2606: (insert astring)
2607: (setq fill-column (1- (window-width (get-buffer-window "*gp-help*"))))
2608: (fill-individual-paragraphs (point-min) (point-max) 'left)
2609: ;; Remove help window :
2610: (gp-window-manager "*gp-help*" 'gp-remove-help-old-config)
2611: (gp-restore-wind-conf))
2612:
2613: (defun gp-cpl-file-info nil
2614: (interactive)
2615: (gp-show-help (gp-messager 29)))
2616:
2617: (defmacro gp-cpl-file-has (astring)
2618: "t if the edited completion file has the string ASTRING
2619: at a beginning of line followed by \n or a space or a #.
2620: Also t when ASTRING is the empty string."
2621: (`
2622: (if (string= (, astring) "") t
2623: (save-excursion
2624: (goto-char (point-min))
2625: (re-search-forward "#") ; There exists such a line.
2626: (end-of-line)
2627: (if (eobp)
2628: nil ;; Return value is nil.
2629: (forward-line 1)
2630: (re-search-forward
2631: (concat "^" (regexp-quote (, astring)) "[\n| |#]") nil t))))))
2632:
2633: (defun gp-prepare-cpl-file (option)
2634: " Write in the file `buffername.cpl' which has the format of a completion
2635: file (i.e. a gp-menu file) the names of the functions and of the global
2636: variables of the visited file. OPTION is t means save the buffer on file,
2637: nil means don't do that if the file wasn't existing already."
2638: (let* ((file (buffer-name)) (my-cpl-file (concat file ".cpl")))
2639: (or option (gp-make-cpl-help file))
2640: ;; Prepare buffer:
2641: (save-excursion
2642: (if (or option
2643: (file-exists-p (expand-file-name my-cpl-file)))
2644: (set-buffer (find-file-noselect my-cpl-file))
2645: (set-buffer (get-buffer-create my-cpl-file)))
2646: (if (file-exists-p (expand-file-name my-cpl-file))
2647: (progn
2648: ;; Assume it has the format of a completion-file:
2649: (re-search-forward "#" nil t)
2650: (end-of-line)
2651: (if (eobp) (insert "\n")
2652: (forward-line 1) (beginning-of-line)
2653: (kill-region (point) (point-max))))
2654: (if option (gp-cpl-stamp my-cpl-file)
2655: (insert "\n### Function Names : (one per line)\n")))
2656: ;; Add function names:
2657: (set-buffer file)
2658: (goto-char (point-min))
2659: (let ((thelist nil))
2660: (while (re-search-forward gp-function-proto-pstart nil t)
2661: (add-to-list 'thelist (match-string 2)))
2662: (setq thelist (sort thelist (function string-lessp))) ; We order things.
2663: (set-buffer my-cpl-file)
2664: (mapcar (lambda (fn) (insert fn "\n")) (gp-clear-list2 thelist)))
2665:
2666: ;; Prepare buffer for names of global variables:
2667: (insert (gp-messager 25) "\n")
2668:
2669: ;; Add global-variable-names:
2670: (set-buffer file)
2671: (goto-char (point-min))
2672: (let (theplace (thelist nil))
2673: (while (setq theplace (gp-find-global-var nil))
2674: (add-to-list 'thelist
2675: (buffer-substring (car theplace) (cdr theplace))))
2676: (setq thelist (sort thelist (function string-lessp))) ; We order things.
2677: (set-buffer my-cpl-file)
2678: (mapcar (lambda (fn) (insert fn "\n")) (gp-clear-list2 thelist)))
2679:
2680: (if (or option (file-exists-p my-cpl-file))
2681: (progn
2682: ;; Prepare buffer for closing, no backup-file:
2683: (gp-actualise-stamp)
2684: (save-buffer 0)))
2685: ;; Add it to the possible completions:
2686: (gp-make-cpl-list (buffer-name)))
2687:
2688: ;; Remove help window
2689: (if (and (not option) gp-tutorial-requiredp)
2690: (progn
2691: (gp-window-manager "*gp-help*" 'gp-remove-help-old-config)
2692: (gp-restore-wind-conf))
2693: )))
2694:
2695: (defun gp-make-cpl-file nil
2696: (interactive)
2697: (gp-prepare-cpl-file nil))
2698:
2699: ;;------------
2700: ;; TeX MANUAL
2701: ;;------------
2702:
2703: ;; The line ";;;###autoload" is useless.
2704: ;; It will be useful when pari.el will be part
2705: ;; of the usual distribution of emacs.
2706: ;;;###autoload
2707: (defun gpman()
2708: "Start up xdvi with the gp manual."
2709:
2710: (interactive)
2711: ;; Run gp-mode-hook in case it specifies a different version of the manual.
2712: (run-hooks 'pari-mode-hook 'gp-mode-hook)
2713: (gp-get-TeX-man-entry ""))
2714:
2715: (defun gp-tutorial()
2716: "Start up xdvi with the gp tutorial."
2717:
2718: (interactive)
2719: ;; Run gp-mode-hook in case it specifies a different version of the tutorial.
2720: (run-hooks 'pari-mode-hook 'gp-mode-hook)
2721: (gp-get-TeX-man-entry "tutorial"))
2722:
2723: ;;-------------------
2724: ;; Help on gp-*-mode
2725: ;;-------------------
2726:
2727: (defun gp-show-pariemacs nil
2728: "Show pariemacs.txt on another window."
2729: (interactive)
2730: ;; Run gp-mode-hook in case it specifies a different version of pariemacs.txt.
2731: (run-hooks 'pari-mode-hook 'gp-mode-hook)
2732: (let ((wind (selected-window))
2733: (where-it-is "")
2734: (to-be-tested (list "/usr/local/lib/pari/emacs/"
2735: "/usr/local/share/lib/pari/emacs/"
2736: "/usr/share/lib/pari/emacs/"
2737: "/usr/local/lib/pari/"
2738: "/usr/local/share/lib/pari/"
2739: "/usr/share/lib/pari/"
2740: (concat "/usr/local/lib/pari-" gp-version "/emacs/")
2741: (concat "/usr/local/share/lib/pari-" gp-version "/emacs/")
2742: (concat "/usr/share/lib/pari-" gp-version "/emacs/")
2743: (concat "/usr/local/lib/pari-" gp-version "/")
2744: (concat "/usr/local/share/lib/pari-" gp-version "/")
2745: (concat "/usr/share/lib/pari-" gp-version "/"))))
2746:
2747: ;; Locate pariemacs.txt:
2748: (mapcar (lambda (afile) (if (file-exists-p afile) (setq where-it-is afile)))
2749: (mapcar (lambda (apath) (expand-file-name (concat apath "/pariemacs.txt")))
2750: (append to-be-tested load-path)))
2751:
2752: (if (not (string-equal where-it-is ""))
2753: (progn
2754: ;; We switch to the buffer *gp-help* and erase its content:
2755: (set-buffer (get-buffer-create "*gp-help*"))
2756: (erase-buffer)
2757: (message where-it-is) ;; tell *Messages* which version of pariemacs is used.
2758: (insert-file where-it-is)
2759: ;; Show the help buffer and tell user how to remove help window:
2760: (gp-window-manager "*gp-help*" 'gp-show-help)
2761: (setq buffer-read-only t)
2762: (search-forward "Common commands" nil t)
2763: (beginning-of-line) (set-window-start (selected-window) (point))
2764: (gp-info-wind-conf)
2765: (select-window wind))
2766: ;; Tell the user the file was not found:
2767: (gp-show-help (gp-messager 39))))
2768: ) ; End of 'gp-show-pariemacs
2769:
2770: ;;--------------
2771: ;; GP HELP MODE
2772: ;;--------------
2773:
2774: (defun gp-has-spacep (astring)
2775: "T if ASTRING contains a space and NIL otherwise"
2776: (let ((ans nil) (where 0) (ll (length astring)))
2777: (while (and (not ans) (< where ll))
2778: (setq ans (or ans (string= (substring astring where (1+ where)) " "))
2779: where (1+ where)))
2780: ans))
2781:
2782: ; Une programmation plus efficace avec emacs 20.3:
2783: ;(defsubst gp-has-spacep (word)
2784: ; "T if WORD contains a space and NIL otherwise"
2785: ; (not (eq (memq ?\ (string-to-list word)) nil)))
2786:
2787: (defun gp-display-raw-menu (lst start end)
2788: (beginning-of-line)
2789: (set start (point))
2790: (save-excursion
2791: (mapcar
2792: (lambda (astring)
2793: (insert astring "\n")
2794: (put-text-property (- (1- (point)) (length astring)) (1- (point))
2795: 'mouse-face 'highlight))
2796: lst)
2797: (set end (point))
2798: (insert "\n")))
2799:
2800: (defsubst gp-display-special-menu (lst)
2801: (gp-display-raw-menu lst 'gp-menu-start-special 'gp-menu-end-special))
2802:
2803: (defsubst gp-display-keywords-menu (lst)
2804: (gp-display-raw-menu lst 'gp-menu-start-keywords 'gp-menu-end-keywords))
2805:
2806: (defun gp-split-menu (lst)
2807: (let ((lst-simple nil) (lst-special nil))
2808: (mapcar
2809: (lambda (astring)
2810: (add-to-list (if (gp-has-spacep astring)
2811: 'lst-special
2812: 'lst-simple) astring))
2813: lst)
2814: (list lst-simple lst-special)))
2815:
2816: (defun gp-display-simple-menu (lst)
2817: "Display the list of strings LST on several columns and sets
2818: the values of 'gp-menu-start-simple, 'gp-menu-end-simple."
2819: (let*((length-list (sort (mapcar 'length lst) '>))
2820: (how-many (length lst))
2821: (gp-menu-width (car length-list)) ; maximal width
2822: gp-menu-main-width ; usual width + spaces
2823: (gp-menu-percent-exceptions 30) ; maximal percentage of exceptionnal words
2824: (gp-menu-spaces 2) ; spaces between two columns
2825: (where (max 0 (1- (floor (* how-many gp-menu-percent-exceptions) 100)))))
2826: ;; Exceptionnal items will be spread over two columns.
2827:
2828: ;; There may be too many elements of exceptional width:
2829: (if (and (< (1+ where) how-many)
2830: (= (nth (1+ where) length-list) (nth where length-list)))
2831: (while (and (<= where 0)
2832: (= (nth (1+ where) length-list) (nth where length-list)))
2833: (setq where (1- where))))
2834: (if (> 0 where) (setq where 0))
2835: ;; The exceptional width may be too large:
2836: (while (and (<= where 0)
2837: (< (+ gp-menu-spaces (* 2 (nth where length-list))) gp-menu-width))
2838: (setq where (1- where)))
2839: (if (> 0 where) (setq where 0))
2840: (setq gp-menu-main-width (nth where length-list))
2841:
2842: ;; Add some spaces between columns:
2843: (setq gp-menu-main-width (+ gp-menu-spaces gp-menu-main-width))
2844: ;; Compute 'gp-menu-nbcol:
2845:
2846: (if (< how-many (/ (window-height) 2))
2847: (setq gp-menu-nbcol 1)
2848: (setq gp-menu-nbcol (max 1 (floor (- (window-width) gp-menu-spaces) gp-menu-main-width))))
2849: (if (= gp-menu-nbcol 1)
2850: (setq gp-menu-main-width (+ gp-menu-spaces gp-menu-width)))
2851:
2852: ;; Display the list:
2853: (beginning-of-line)
2854: (setq gp-menu-start-simple (point))
2855: (save-excursion
2856: (let ((wherex 1))
2857: (mapcar
2858: (lambda (astring)
2859: (if (<= (length astring) (- gp-menu-main-width gp-menu-spaces))
2860: (progn
2861: (insert astring)
2862: (put-text-property (- (point) (length astring)) (point)
2863: 'mouse-face 'highlight)
2864: (if (< wherex gp-menu-nbcol)
2865: (progn (setq wherex (1+ wherex))
2866: (insert-char ?\ (- gp-menu-main-width (length astring))))
2867: (setq wherex 1)
2868: (insert "\n")))
2869: (if (< wherex gp-menu-nbcol)
2870: (progn
2871: (insert astring)
2872: (put-text-property (- (point) (length astring)) (point)
2873: 'mouse-face 'highlight)
2874: (if (< wherex (1- gp-menu-nbcol))
2875: (progn (setq wherex (+ 2 wherex))
2876: (insert-char ?\ (- (* 2 gp-menu-main-width) (length astring))))
2877: (setq wherex 1)
2878: (insert "\n")))
2879: (insert "\n" astring)
2880: (setq wherex 1)
2881: (put-text-property (- (point) (length astring)) (point)
2882: 'mouse-face 'highlight)
2883: (if (< wherex (1- gp-menu-nbcol))
2884: (progn (setq wherex (+ 2 wherex))
2885: (insert-char ?\ (- (* 2 gp-menu-main-width) (length astring))))
2886: (setq wherex 1)
2887: (insert "\n")))))
2888: lst)
2889: (or (= wherex 1) (insert "\n")))
2890: (message (gp-messager 38))
2891: (setq gp-menu-end-simple (point)))))
2892:
2893: (defun gp-menu nil
2894: "Major-mode for the gp menu buffer.
2895: The available commands are
2896: \\{gp-menu-map}"
2897: (interactive)
2898: (or gp-main-menu-list (gp-cpl-init))
2899: (gp-window-manager "*gp-menu*" 'gp-beginning)
2900: (setq major-mode 'gp-menu mode-name "GP MENU")
2901: (use-local-map gp-menu-map)
2902: (gp-menu-survey))
2903:
2904: (defsubst gp-menu-info nil
2905: (message (gp-messager 18)))
2906:
2907: (defun gp-menu-next ()
2908: "Move down one line of the gp help menu. (Go to top if at the end.)"
2909: (interactive)
2910: (gp-menu-info)
2911: (forward-line 1)
2912: (if (eobp)
2913: (progn (ding)
2914: (goto-char (point-min))
2915: (re-search-forward "###\n" nil t))))
2916:
2917: (defun gp-menu-previous ()
2918: "Move up one line of the gp help menu. (Go to bottom if at the top.)"
2919: (interactive)
2920: (gp-menu-info)
2921: (forward-line -1)
2922: (if (or (bobp) (looking-at "###\n"))
2923: (progn (ding) (goto-char (point-max)) (beginning-of-line))))
2924:
2925: (defun gp-menu-C-v nil (interactive) (scroll-up) (gp-menu-info))
2926:
2927: (defun gp-menu-M-v nil (interactive) (scroll-down) (gp-menu-info))
2928:
2929: (defun gp-menu-right nil
2930: (interactive)
2931: (if (and (> (point) (1- gp-menu-start-simple))
2932: (< (point) gp-menu-end-simple))
2933: ;; multiple columns display:
2934: (progn
2935: (if (re-search-forward "[\n\t ][a-zA-Z]" nil t)
2936: (forward-char -1)))
2937: ;; single column display:
2938: (forward-char 1)))
2939:
2940: (defun gp-menu-left nil
2941: (interactive)
2942: (if (and (> (point) (1- gp-menu-start-simple))
2943: (< (point) gp-menu-end-simple))
2944: ;; multiple columns display:
2945: (progn
2946: (if (re-search-backward "\\([\n\t ]\\|^\\)\\([a-zA-Z]+\\)[\n\t ]" nil t)
2947: (goto-char (match-beginning 2))))
2948: ;; single column display:
2949: (forward-char -1)))
2950:
2951: (defun gp-menu-quit nil
2952: "Switch the *PARI* buffer if it exists, or (other-buffer) if it does not."
2953: (interactive)
2954: (gp-window-manager "*gp-menu*" 'gp-remove-help-now)
2955: (if (get-buffer-window "*gp-help*")
2956: (progn (gp-info-wind-conf)
2957: (if (string= (buffer-name) "*gp-help*")
2958: (select-window (other-window 1))))))
2959:
2960: (defsubst gp-menu-get-beg nil
2961: (save-excursion
2962: (re-search-backward "\\`\\|[ \n]" nil t)
2963: (match-end 0)))
2964:
2965: (defsubst gp-menu-get-end nil
2966: (save-excursion
2967: (re-search-forward "\\'\\|[ \n]" nil t)
2968: (match-beginning 0)))
2969:
2970: (defun gp-menu-select nil
2971: "Select a subject from the main menu, or a manual entry from a subject menu."
2972: (interactive)
2973: (cond ((and (> (point) (1- gp-menu-start-simple))
2974: (< (point) gp-menu-end-simple))
2975: (gp-get-man-entry
2976: (buffer-substring (gp-menu-get-beg) (gp-menu-get-end))))
2977: ((and (> (point) (1- gp-menu-start-special))
2978: (< (point) gp-menu-end-special))
2979: (gp-get-man-entry
2980: (buffer-substring (gp-get-beginning-of-line)
2981: (gp-get-end-of-line))))
2982: ((and (> (point) (1- gp-menu-start-keywords))
2983: (< (point) gp-menu-end-keywords))
2984: (gp-get-apropos
2985: (buffer-substring (gp-get-beginning-of-line)
2986: (gp-get-end-of-line))))
2987: (t (message (gp-messager 19)))))
2988:
2989: (defun gp-menu-mouse-select (event)
2990: (interactive "e")
2991: (mouse-set-point event)
2992: (gp-menu-select))
2993:
2994: (defun gp-menu-survey nil
2995: "Display the main menu."
2996: ;; Used while being in a window displaying "*gp-menu*".
2997: (interactive)
2998: (setq buffer-read-only nil)
2999: (erase-buffer)
3000: (save-excursion
3001: (insert "\n" (gp-messager 26) "\n")
3002: (gp-display-special-menu gp-main-menu-list)
3003: (goto-char (point-max))
3004: (insert (gp-messager 27) "\n")
3005: (gp-display-keywords-menu gp-main-menu-keywords-list))
3006: (setq buffer-read-only t)
3007: (setq gp-menu-start-simple 0 gp-menu-end-simple 0)
3008: (gp-menu-info))
3009:
3010: ;;; We start the browser.
3011:
3012: (defun gp-browser-cmd (cmd to-buffer &optional nomessage slow-down)
3013: ;; A GP process is supposedly running.
3014: (set-buffer "*Simple PARI*")
3015: (goto-char (point-max))
3016: ;; Make gp send text to the buffer end, so we can move it to-buffer.
3017: (set-marker (process-mark gp-browser-process) (point))
3018: (let ((temp (point)))
3019: ;; Send the meta command to gp.
3020: (process-send-string gp-browser-process (concat cmd "\n"))
3021: ;; Wait for the gp-prompt to be sent.
3022: (gp-wait-for-output temp nomessage gp-browser-process)
3023: (if slow-down (sit-for 0 slow-down))
3024:
3025: (let ((copy (buffer-substring temp (point-max))))
3026: (delete-region temp (point-max))
3027: (set-buffer (get-buffer-create to-buffer))
3028: (erase-buffer)
3029: (insert copy)
3030: (beginning-of-line) ; We remove last prompt line.
3031: (delete-region (point) (point-max))
3032: (goto-char (point-min)))))
3033:
3034: (defun gp-browser-1-mode nil ""
3035: (interactive)
3036: (setq major-mode 'gp-browser-1)
3037: (use-local-map gp-browser-1-map))
3038:
3039: (defun gp-browser-2-mode nil ""
3040: (interactive)
3041: (setq major-mode 'gp-browser-2)
3042: (setq gp-menu-start-simple (point-min))
3043: (use-local-map gp-browser-2-map))
3044:
3045: (defun gp-browser-1-select nil
3046: (interactive)
3047: (remove-text-properties (point-min) (point-max) '(face))
3048: (put-text-property (gp-get-beginning-of-line) (gp-get-end-of-line)
3049: 'face 'underline)
3050: (let ((prop (get-text-property (point) 'follow)))
3051: (if (numberp prop) (gp-browser-follow prop))))
3052:
3053: (defun gp-browser-1-mouse-select (event)
3054: (interactive "e")
3055: (mouse-set-point event)
3056: (gp-browser-1-select))
3057:
3058: (defun gp-browser-2-select nil
3059: (interactive)
3060: (if (or (eobp) (looking-at "[ \n\t]+")) (skip-chars-backward " \n\t"))
3061: (gp-call-gphelp (window-width (get-buffer-window "*gp-function description*"))
3062: (thing-at-point 'word) "*gp-function description*" "-detex")
3063: ;; Replace ESC[.?m by nothing: (\033 or \e)
3064: (set-buffer "*gp-function description*")
3065: (gp-replace "\033\\[.?m" ""))
3066:
3067: (defun gp-browser-2-mouse-select (event)
3068: (interactive "e")
3069: (mouse-set-point event)
3070: (gp-browser-2-select))
3071:
3072: (defun gp-browser-follow (num)
3073: (set-buffer "*gp-functions list*")
3074: (select-window (get-buffer-window "*gp-functions list*"))
3075: (erase-buffer)
3076: (gp-display-simple-menu (cdr (assq num gp-browser-follow-alist)))
3077: (setq gp-menu-end-simple (point-max)))
3078:
3079: (defun gp-browser-main nil
3080: (setq major-mode 'gp-browser-1-mode)
3081: (mapcar (lambda (acons)
3082: (let ((temp (point)))
3083: (insert (cdr acons))
3084: (put-text-property temp (point) 'follow (car acons))
3085: (put-text-property temp (point) 'mouse-face 'highlight)
3086: (insert "\n"))) gp-browser-main-alist)
3087: (goto-char (point-min)))
3088:
3089: (defun gp-browser nil
3090: (interactive)
3091: (or gp-browser-main-alist
3092: (gp-make-browser))
3093: (setq gp-main-frame (selected-frame))
3094: (cond ((= gp-browser-style 1)
3095: (setq gp-browser-frame
3096: (make-frame (list '(name . "gp-browser")
3097: (cons 'width (frame-width gp-main-frame)))))
3098: (select-frame gp-browser-frame)
3099: (switch-to-buffer "*gp-browser*")
3100: (gp-browser-1-mode)
3101: (erase-buffer)
3102: (split-window nil (1+ (length gp-browser-main-alist)))
3103: (other-window 1)
3104: (switch-to-buffer "*gp-functions list*")
3105: (gp-browser-2-mode)
3106: (split-window nil 12)
3107: (other-window 1)
3108: (switch-to-buffer "*gp-function description*"))
3109: ((= gp-browser-style 2)
3110: (setq gp-browser-frame
3111: (make-frame (list '(name . "gp-browser")
3112: (cons 'width (+ 10 (frame-width gp-main-frame))))))
3113: (select-frame gp-browser-frame)
3114: (switch-to-buffer "*gp-browser*")
3115: (gp-browser-1-mode)
3116: (erase-buffer)
3117: (split-window nil (+ 5 (length gp-browser-main-alist)))
3118: (other-window 1)
3119: (switch-to-buffer "*gp-function description*")
3120: (select-window (get-buffer-window "*gp-browser*"))
3121: (split-window nil (+ 4 gp-browser-width) t)
3122: (other-window 1)
3123: (switch-to-buffer "*gp-functions list*")
3124: (gp-browser-2-mode))
3125: ((= gp-browser-style 3)
3126: (setq gp-browser-frame
3127: (make-frame (list '(name . "gp-browser")
3128: (cons 'width (frame-width gp-main-frame)))))
3129: (select-frame gp-browser-frame)
3130: (switch-to-buffer "*gp-browser*")
3131: (gp-browser-1-mode)
3132: (erase-buffer)
3133: (split-window nil (+ 4 gp-browser-width) t)
3134: (other-window 1)
3135: (switch-to-buffer "*gp-functions list*")
3136: (gp-browser-2-mode)
3137: (other-window -1)
3138: (split-window nil (1+ (length gp-browser-main-alist)))
3139: (other-window 1)
3140: (switch-to-buffer "*gp-function description*")))
3141: (set-buffer "*gp-browser*")
3142: (select-window (get-buffer-window "*gp-browser*"))
3143: (gp-browser-main)
3144: (set-default-font (gp-frame-parameter gp-main-frame 'font))
3145: (select-frame gp-main-frame))
3146:
3147: (defsubst gp-split-to-strings (to)
3148: (let ((res nil))
3149: (while (re-search-forward "\\([^ \n\t]+\\)\\( \\|\n\\|\t\\)" to t)
3150: (setq res (nconc res (list (match-string 1)))))
3151: res))
3152:
3153: (defun gp-make-browser nil
3154: ;; Make 'gp-browser-main-alist:
3155: (message (gp-messager 37))
3156: (get-buffer-create "*Simple PARI*")
3157: (set-buffer "*Simple PARI*")
3158: (setq gp-browser-process
3159: (gp-get-shell "simple-pari" "*Simple PARI*" (concat gp-file-name " -s 1000 -p 10 -emacs")))
3160:
3161: ;; We should run the hook as the prompt may have
3162: ;; been changed in the .gprc:
3163: (run-hooks 'pari-mode-hook)
3164: (gp-wait-for-output 1 t gp-browser-process)
3165: (gp-browser-cmd "?" "*gp-browser*" t)
3166: (goto-char (point-min))
3167: (forward-line 2) ; Skip item 0.
3168: (while (re-search-forward " +\\([1-90]+\\): \\([^\n]*\\)\n" nil t)
3169: (setq gp-browser-main-alist
3170: (nconc gp-browser-main-alist
3171: (list (cons (string-to-number (match-string 1)) (match-string 2))))
3172: gp-browser-width (max gp-browser-width (length (match-string 2)))))
3173: ;; Remove last item :
3174: (setq gp-browser-main-alist (nreverse (nthcdr 1 (nreverse gp-browser-main-alist))))
3175: ;; Make 'gp-browser-follow-alist:
3176: (setq gp-browser-follow-alist
3177: (mapcar
3178: (lambda (num)
3179: (erase-buffer)
3180: (gp-browser-cmd (concat "?" (number-to-string num)) "*gp-browser*" t 300)
3181: (cons num (gp-split-to-strings (point-max))))
3182: (mapcar 'car gp-browser-main-alist)))
3183: (gp-browser-cmd "\q" "*gp-browser*" t)
3184: (kill-buffer "*Simple PARI*")
3185: (message (gp-messager 6)))
3186:
3187: ;;--------------------
3188: ;; TeX AND USUAL INFO
3189: ;;--------------------
3190:
3191: (defun gp-replace (a b)
3192: "Replace the regexp a by the string b everywhere in the current buffer"
3193: ;; b may be an expression whose value is a string, like
3194: ;; (buffer-substring (match-beginning 0) (match-end 0))
3195: (save-excursion
3196: (goto-char (point-min))
3197: (while (re-search-forward a nil t)
3198: (replace-match (eval b) t t))))
3199:
3200: (defmacro gp-ask-name-wisely (this-type)
3201: "Ask in the minibuffer for a \"this-type\" name and provide a default"
3202: (`
3203: (list
3204: (let* ( ;; get the word before point into word:
3205: (word (gp-find-word-to-complete))
3206: ;; get the argument from the minibuffer into arg
3207: (arg
3208: (progn
3209: (define-key minibuffer-local-completion-map " " 'self-insert-command)
3210: ;; It is usually 'minibuffer-complete-word, but C-i does that.
3211: (completing-read
3212: (concat (, this-type)
3213: (if (intern-soft word gp-c-array)
3214: ;; If the word before point is a gp function, offer it as default.
3215: (concat " [Default " word "]" )) ": ")
3216: ;; use gp-c-array as the completion array
3217: gp-c-array))))
3218: (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
3219: (if (equal arg "")
3220: ;; If the argument supplied is "", and word is a gp symbol, use it as default.
3221: ;; (Do not use "" as fn in anycase, so otherwise use " ", which will not
3222: ;; produce a help window.)
3223: (if (intern-soft word gp-c-array) word " ")
3224: ;; Else use the arg.
3225: arg)))))
3226:
3227: (defun gp-get-TeX-man-entry (fn)
3228: "Similar to `??fn' under GP"
3229: (interactive (gp-ask-name-wisely (gp-messager 21)))
3230:
3231: (gp-call-gphelp (window-width) fn nil "")
3232: (if (buffer-live-p (get-buffer "*Shell Command Output*"))
3233: (save-excursion
3234: (set-buffer "*Shell Command Output*")
3235: (cond ((looking-at "\n") (kill-buffer nil))
3236: ((save-excursion
3237: (goto-char (- (point-max) 13))
3238: (looking-at " not found !"))
3239: (kill-buffer nil)
3240: (message (gp-messager 20) fn))))
3241: (message "")))
3242:
3243: (defun gp-get-man-entry (fn)
3244: "Get the description of fn from chapter 3 of the manual
3245: via gphelp, and display the result in a new window.
3246: If there is no entry for fn in the manual, send ?fn to gp.
3247: If a definition is found, add fn to the array of possible completions"
3248:
3249: (interactive (gp-ask-name-wisely "Function"))
3250: (let ((wind (selected-window)))
3251: ;; We switch to the buffer *gp-help* and erase its content:
3252: (set-buffer (get-buffer-create "*gp-help*"))
3253: (erase-buffer)
3254: (gp-call-gphelp (window-width (get-buffer-window "*gp-help*")) fn t "-detex")
3255: ;; Replace ESC[.?m by nothing: (\033 or \e)
3256: (gp-replace "\033\\[.?m" "")
3257:
3258: (goto-char (point-min))
3259: (if (save-excursion
3260: (goto-char (- (point-max) 13))
3261: (looking-at " not found !"))
3262: ;; If gp was not running then start it.
3263: (if (gp-background nil)
3264: (progn
3265: (gp-meta-cmd-general (concat "?" fn) nil)
3266: ;; which sets the buffer "*gp-help*".
3267: (if (looking-at " *\\*\\*\\* *unknown identifier")
3268: (progn
3269: (gp-window-manager "*gp-help*" 'gp-remove-help-now)
3270: (message (gp-messager 20) fn))
3271: (if (looking-at " *\\*\\*\\* *user defined variable")
3272: (progn
3273: (gp-window-manager "*gp-help*" 'gp-remove-help-now)
3274: (message (gp-messager 22) fn))
3275: ;; Else tell user how to remove the help window:
3276: (gp-window-manager "*gp-help*" 'gp-show-help)
3277: (gp-info-wind-conf)
3278: ;; and let the completion system know about the function name:
3279: (gp-add-symbol fn)))))
3280: ;; Else show the help buffer and tell user how to remove help window:
3281: (gp-window-manager "*gp-help*" 'gp-show-help)
3282: (gp-info-wind-conf))
3283: (select-window wind))) ; End of 'gp-get-man-entry
3284:
3285: (defun gp-buffer-to-double-list nil
3286: (let ((lst nil))
3287: (save-excursion
3288: (while (not (eobp))
3289: (add-to-list 'lst
3290: (buffer-substring (gp-get-beginning-of-line)
3291: (gp-get-end-of-line)))
3292: (forward-line 1)))
3293: (delete-region (point) (point-max))
3294: (gp-split-menu lst)))
3295:
3296: (defun gp-get-apropos (exp)
3297: "Show in gp-menu-mode the functions or sections
3298: in whose description the expression EXP appears.
3299: Similar to \"??? exp\" in gp."
3300: (interactive (gp-ask-name-wisely (gp-messager 32)))
3301:
3302: (gp-window-manager "*gp-menu*" 'gp-beginning)
3303: (insert (format (concat "\n" (gp-messager 31) "\n") exp))
3304: (insert "\n###\n") ; To give this buffer the format of a gp-menu file.
3305: (gp-call-gphelp 50 exp t "-k -raw")
3306: ;; Replace ESC[.?m by nothing: (\033 or \e)
3307: (gp-replace "\033\\[.?m" "")
3308:
3309: (search-backward "\n###\n")
3310: (forward-char 5)
3311: (if (eobp)
3312: (progn
3313: (kill-buffer "*gp-menu*")
3314: (gp-backward-wind-conf)
3315: (message (gp-messager 23) exp))
3316: (set-buffer "*gp-menu*")
3317: (let ((adoublelist (gp-buffer-to-double-list)))
3318: (gp-display-simple-menu (car adoublelist))
3319: (goto-char (point-max))
3320: (and (car adoublelist) (insert "\n"))
3321: (gp-display-special-menu (nth 1 adoublelist)))
3322: (setq gp-menu-start-keywords 0 gp-menu-end-keywords 0)
3323: (setq major-mode 'gp-menu mode-name "GP MENU")
3324: (use-local-map gp-menu-map)
3325: (setq buffer-read-only t)
3326: (goto-char (point-min))
3327: (search-forward "\n###\n")
3328: (gp-menu-info)))
3329:
3330: ;;------------------------
3331: ;; PART V : HIGHLIGHTING
3332: ;;------------------------
3333:
3334: ;; We call all the symbols of the list gp-places-list: `gp-places'.
3335: ;; They will be linked to a pattern to be hilighted and to a face.
3336: ;; Well, not exactly to a face but to another symbol which
3337: ;; `hilit19.el' will recognise as corresponding to a face.
3338: ;; We call them `symbolic-face-name(s)', `symbolic-name(s)' or `color(s)'.
3339:
3340: (defsubst gp-place-to-name (gp-place)
3341: (cdr (assq gp-place hilit-face-translation-table)))
3342:
3343: (defun gp-add-to-gp-colors-list (asymbolic-name)
3344: (if (memq asymbolic-name gp-colors-list) nil
3345: (setq gp-colors-list (cons asymbolic-name gp-colors-list))))
3346:
3347: (defun gp-init-gp-colors-list nil
3348: (sort
3349: (mapcar
3350: (lambda (quoted-gp-place)
3351: (gp-add-to-gp-colors-list (gp-place-to-name (eval quoted-gp-place))))
3352: gp-places-list)
3353: (function
3354: (lambda (p q)
3355: (string-lessp (symbol-name (gp-place-to-name p))
3356: (symbol-name (gp-place-to-name q)))))))
3357:
3358: (defmacro gp-save-acolor (gp-place)
3359: (`
3360: (insert "(hilit-translate " (symbol-name (, gp-place)) " '"
3361: ;; the nil face-name is replaced by default.
3362: (if (string= (symbol-name (gp-place-to-name (, gp-place))) "nil")
3363: "default"
3364: (symbol-name (gp-place-to-name (, gp-place))))
3365: ")\n")))
3366:
3367: (defun gp-save-colors nil
3368: "Store the colors of the gp-places in the file specified by pari-colors"
3369: (interactive)
3370: (save-excursion
3371: (set-buffer (get-buffer-create "pari-colors.el"))
3372: (set-visited-file-name pari-colors)
3373: (mapcar (lambda (quoted-gp-place)
3374: (gp-save-acolor (eval quoted-gp-place)))
3375: gp-places-list)
3376:
3377: ;; Now we make the changes but we do NOT keep the old version.
3378: ;; Will send a message when done.
3379: (if (file-exists-p pari-colors)
3380: (save-buffer 0) (write-file pari-colors))
3381: (setq pari-colors-modifiedp nil)
3382: (kill-buffer "pari-colors.el")))
3383:
3384: (defun gp-hilit-translate ()
3385: "translate symbolic highlight group names to actual colors. If you work
3386: with a dark background, set hilit-background-mode to 'dark before calling
3387: this function"
3388: ;; Extend the list `hilit-face-translation-table' by adding the
3389: ;; conses (symbolic-name-here . symbolic-name-face). We recover the
3390: ;; symbolic-name-face by
3391: ;; (cdr (assq 'symbolic-name hilit-face-translation-table)).
3392:
3393: (interactive)
3394: (if (file-exists-p pari-colors)
3395: (progn
3396: (message (concat (gp-messager 24)
3397: (file-name-directory pari-colors) "..."))
3398: (load-file pari-colors))
3399: (if (eq hilit-background-mode 'light)
3400: ;; light background
3401: (hilit-translate
3402: gp-error 'red
3403: gp-history 'magenta3
3404: gp-prompt 'default
3405: gp-output 'blue3
3406: gp-input 'default
3407: gp-help 'red3
3408: gp-timer 'green3
3409:
3410: gp-comment 'blue3
3411: gp-control-statement 'red3
3412: gp-default-keywords 'red3
3413: gp-default-set 'green3
3414: gp-input-cmd 'green3
3415: gp-string 'grey50
3416: gp-global-var 'deepskyblue1-underline
3417: gp-function-proto 'deepskyblue1
3418: gp-function-args 'green3)
3419:
3420: ;; dark background
3421: (hilit-translate
3422: gp-error 'red
3423: gp-history 'magenta3
3424: gp-prompt 'brown
3425: gp-output 'hex-ffff60
3426: gp-input 'default
3427: gp-help 'red3
3428: gp-timer 'green3
3429:
3430: gp-comment 'hex-80a0ff
3431: gp-control-statement 'hex-ffff60
3432: gp-default-keywords 'red3
3433: gp-default-set 'green3
3434: gp-input-cmd 'green3
3435: gp-string 'grey50
3436: gp-global-var 'deepskyblue1-underline
3437: gp-function-proto 'deepskyblue1
3438: gp-function-args 'green3))))
3439:
3440:
3441: (defun gp-find-global-var (dummy)
3442: "A parser to find global variables. Called on a gp-program outside
3443: a function-definition, gives position via (cons start end) of
3444: next global-variable-definition not surrounded by {} and set the
3445: point at the end of the line. Answer nil if no global-variable is found.
3446: The end delimiter of a function definition surrounded by {} is
3447: '}\n' and the same holds with function definitions of the style
3448: 'fun(var)={foo}'.
3449: DUMMY is not used, but introduced for compatibility with
3450: 'hilit-set-mode-patterns"
3451: (let ((answer nil))
3452: (while (looking-at (concat comment-start-skip
3453: "\\|[ \\|\t\\|\n]\\|{\\([^}]\\|}[^\n]\\)*}\n\\|\\<[a-zA-Z]\\w*([^)]*) *={\\([^}]\\|}[^\n]\\)*}\n\\|\\<[a-zA-Z]\\w*([^)]*) *=\\([^=\\\\\"]\\|\\\\[ \t]*\\(\\\\\\\\.*$\\|/\\*\\([^\\*]\\|\\*[^/]\\)*\\*/\\)?\n\\|\"\\([^\"]*\\|\\\\\"\\)*\"\\)\\([^\\\\\n\"]\\|\"\\([^\"]*\\|\\\\\"\\)*\"\\|\\\\[ \t]*\\(\\\\\\\\.*$\\|/\\*\\([^\\*]\\|\\*[^/]\\)*\\*/\\)?\n\\)*\n\\|\\<[a-zA-Z]\\w*([^)]*)[;\n]"))
3454: ;; We look at a single line comment, or a long comment,
3455: ;; or a space/tab/newline character, or a function definition between {},
3456: ;; or a function definition of the type fun(var)={foo},
3457: ;; or a function definition not between {}, or a function call.
3458: ;; And skip them.
3459: (goto-char (match-end 0)))
3460: ;; We look whether there is a global-variable being defined here:
3461: (if (looking-at "\\<\\([a-zA-Z]\\w*\\)=[^=].*$")
3462: (progn
3463: (setq answer (cons (match-beginning 1) (match-end 1)))
3464: (goto-char (match-end 0))))
3465: answer))
3466:
3467: (defsubst gp-search-forward-string-delimiter (lim)
3468: "Give the position of next \" preceded by an even number
3469: of \\ . Move point after this point. Nil if no such place before lim."
3470: ;; Inspired from hilit-string-find in hilit19.el.
3471: (let (p)
3472: (while (and (setq p (search-forward "\"" lim t))
3473: (save-excursion
3474: (forward-char -1)
3475: (not (zerop (% (skip-chars-backward "\\\\") 2))))))
3476: p))
3477:
3478: (defun gp-find-comment (dummy)
3479: "A parser to find comments in gp. Called on a gp-program outside
3480: a string or a comment, gives position via (cons start end) of next comment and
3481: set point at the end of line. Answer nil if no comment is found.
3482: DUMMY is not used, but introduced for compatibility with
3483: 'hilit-set-mode-patterns"
3484: ;; Get tricked if one uses the empty string "" in a function-definition
3485: ;; not enclosed in `{}'. But it *should not* happen!
3486: ;; Anyway nothing very bad happens then.
3487: (let ((answer nil) (not-done t))
3488: (while not-done
3489: (let ((p-start (point))
3490: (p-comment
3491: (re-search-forward "\\\\\\\\\\|/\\*"
3492: nil t)))
3493: (goto-char p-start)
3494: (if p-comment
3495: ;; There is a candidate:
3496: (if (gp-search-forward-string-delimiter (1- p-comment))
3497: ;; There is a string before the comment.
3498: ;; Go to end of this string.
3499: (if (gp-search-forward-string-delimiter (1- p-comment))
3500: ;; The string ends before the candidate-comment:
3501: nil
3502: ;; The string ends after the candidate-comment:
3503: (if (gp-search-forward-string-delimiter (point-max))
3504: nil
3505: ;; Else the file ends on the definition of a string:
3506: (setq not-done nil)
3507: (goto-char (point-max))))
3508: ;; There is no string before the comment.
3509: (setq not-done nil)
3510: (if (re-search-forward "\\\\\\\\.*$\\|/\\*\\([^\\*]\\|\\*[^/]\\)*\\*/"
3511: nil t)
3512: (setq answer (cons (match-beginning 0) (match-end 0)))
3513: ;; Else the comment is not properly formed:
3514: ))
3515: ;; There is no candidate:
3516: (setq not-done nil))))
3517: answer))
3518:
3519: (defun gp-update-hilit nil "Update hilit."
3520: (interactive)
3521: (if gp-can-hilit
3522: ;; Rehilit only the visible part:
3523: (hilit-rehighlight-region
3524: (window-start) (min (window-end) (point-max)))))
3525:
3526: (defun gp-update-hilit-buffers nil
3527: "Update hilighting/unhilighting on all the buffers
3528: that are in gp-mode or in gp-script-mode."
3529: (interactive)
3530: (save-excursion
3531: (mapcar
3532: (lambda (abuffer)
3533: (set-buffer abuffer)
3534: (if (memq major-mode '(gp-script-mode gp-mode))
3535: (if gp-can-hilit (hilit-rehighlight-buffer)
3536: (hilit-unhighlight-region
3537: (point-min) (point-max)))))
3538: (buffer-list))
3539: (message "")))
3540:
3541: (defun gp-color-help nil
3542: (or (not gp-tutorial-requiredp) (gp-show-help (gp-messager 28))))
3543:
3544: ;;-------------------
3545: ;; PART VI : MENU-BAR
3546: ;;-------------------
3547:
3548: ;;---------------
3549: ;; MENU BUILDERS
3550: ;;---------------
3551:
3552: ;; Careful to the order! macro should be defined in good order.
3553: ;; See backquote.el for definition of 'backquote also (`, and see
3554: ;; this same file for (, --> variable 'backquote-unquote-symbol.
3555:
3556: (defmacro gp-cmd2-to-paint (gp-place)
3557: "Build the command to paint gp-place according to a read face-name."
3558: ;; See the comment attached to 'gp-cmd-to-paint.
3559: (` (list (list 'lambda nil
3560: '(interactive)
3561: (list (function gp-store-wind-conf))
3562: (list (function gp-color-help))
3563: (list 'let (list
3564: (list 'temp-name
3565: ;; We don't use 'read-face-name because this function
3566: ;; forces the user to enter a valid face-name. Here,
3567: ;; if the face-name chosen doesn't exist,
3568: ;; the default face-name will be used.
3569: (list (function read-from-minibuffer) (gp-messager 40)))
3570: (list 'a-face-name nil))
3571: (list 'setq 'a-face-name
3572: (list 'intern
3573: (list 'if (list 'string= 'temp-name "") '"default"
3574: 'temp-name)))
3575:
3576: (list 'if (list 'string= 'a-face-name "default")
3577: (list (function hilit-translate) (, gp-place) nil)
3578: (list (function hilit-translate) (, gp-place) 'a-face-name))
3579: (list (function setq) 'pari-colors-modifiedp t)
3580: (list (function gp-update-hilit-buffers))
3581: (list (function gp-add-to-gp-colors-list) 'a-face-name)
3582: ;; In fact, one should add a command here to modify the
3583: ;; menu-items that presents the colors...
3584: ;; It is a good deal of code for an almost empty use.
3585: ;; From this point of view, it was also useless to
3586: ;; modify 'gp-colors-list above...
3587:
3588: ;; We remove the help.
3589: (list 'if 'gp-tutorial-requiredp
3590: (list 'progn
3591: (list (function gp-window-manager) "*gp-help*"
3592: ''gp-remove-help-now-old-config)
3593: (list (function gp-restore-wind-conf))
3594: )))))))
3595:
3596: (defmacro gp-cmd-to-paint (acolor gp-place)
3597: "Build the command to paint gp-place to acolor."
3598: ;; A weird way of programming ... We build a Lisp expression
3599: ;; which is a function definition. A kind of automatic programming.
3600: (` (list (list 'lambda nil '(interactive)
3601: (list (function hilit-translate) (, gp-place)
3602: (list 'quote (, acolor)))
3603: (list (function setq) 'pari-colors-modifiedp t)
3604: (list (function gp-update-hilit-buffers))
3605: (list (function message) "") ;; Clear the minibuffer
3606: ))))
3607:
3608: (defsubst gp-cmd-to-enable (acolor gp-place)
3609: "Build the command that enable acolor to be chosen in the menu item
3610: [GP gp-place]. A color is enabled if it is not already the one
3611: that is being used for this item."
3612: ;; See the comment attached to 'gp-cmd-to-paint.
3613: (list 'and
3614: 'gp-can-hilit
3615: (list 'not (list 'eq (list 'quote acolor)
3616: (list (function gp-place-to-name)
3617: (list 'quote gp-place))))))
3618:
3619: (defsubst gp-build-color-submenu (gp-place)
3620: "Build the Colors submenu. The colors proposed are the one of
3621: the list 'gp-colors-list"
3622: (append
3623: (mapcar (lambda (acolor)
3624: (vector
3625: (symbol-name acolor)
3626: (gp-cmd-to-paint acolor gp-place)
3627: (gp-cmd-to-enable acolor gp-place)
3628: ':key-sequence nil))
3629: gp-colors-list)
3630: (list "----------------")
3631: (list (vector (gp-messager 42) (gp-cmd2-to-paint gp-place) t))))
3632:
3633: (defsubst gp-build-color-menu nil
3634: "Build the Colors menu"
3635: (if (and (not gp-no-color-item)
3636: (eq window-system 'x) (x-display-color-p))
3637: (if (not (eq gp-color-menu-list nil))
3638: gp-color-menu-list
3639: (setq gp-color-menu-list
3640: (list
3641: (append
3642: (list (gp-messager 43))
3643: ;; There is an entry for each pattern to be colored.
3644: ;; A list of these items can be found in gp-places-list.
3645: ;; The colors proposed are the ones of 'gp-colors-list.
3646: ;; The only color that is not choose-able (in grey)
3647: ;; is the one already used.
3648: (list (vector (gp-messager 44) 'hilit-recenter t))
3649: gp-separator
3650: (mapcar (lambda (quoted-gp-place)
3651: (cons
3652: (substring
3653: (upcase-initials (symbol-name (eval quoted-gp-place)))
3654: 3)
3655: (gp-build-color-submenu (eval quoted-gp-place))))
3656: gp-places-list)
3657: (list
3658: "------------------------------------------"
3659: ;; In order to save the changes made in the file pari-colors.
3660: (vector (gp-messager 45) 'gp-save-colors 'pari-colors-modifiedp)
3661: (vector (gp-messager 46) 'gp-hilit-switch t ':key-sequence nil)
3662: (vector (gp-messager 47) 'gp-update-hilit-buffers t))))))))
3663:
3664: (defconst gp-metakeys-gp-mode-menu
3665: (list
3666: (list (gp-messager 48)
3667: (vector (gp-messager 49) 'gp-meta-r '(processp gp-process))
3668: (vector (gp-messager 50) 'gp-meta-w '(processp gp-process))
3669: "------------------------------------------------"
3670: (list (gp-messager 51)
3671: ["Pretty Format" gp-meta-b (processp gp-process)]
3672: ["Matrix Pretty Format" gp-meta-m (processp gp-process)]
3673: ["Raw Format" gp-meta-a (processp gp-process)]
3674: ["Inner Structure" gp-meta-x (processp gp-process)])
3675: (list (gp-messager 52)
3676: (vector (gp-messager 53) 'gp-set-simple-prompt '(processp gp-process)
3677: ':key-sequence nil)
3678: (vector (gp-messager 54) 'gp-set-time-prompt '(processp gp-process)
3679: ':key-sequence nil)
3680: (vector (gp-messager 55) 'gp-set-date-prompt '(processp gp-process)
3681: ':key-sequence nil)
3682: (vector (gp-messager 56) 'gp-set-separator-prompt '(processp gp-process)
3683: ':key-sequence nil)
3684: (vector (gp-messager 42) 'gp-set-prompt '(processp gp-process)))
3685: "------------------------------------------------"
3686: ["PARI Types" gp-meta-t (processp gp-process)]
3687: ["Default" gp-meta-d (processp gp-process)]
3688: ["Version Number" gp-meta-v (processp gp-process)]
3689: ["Stack Info" gp-meta-s (processp gp-process)])))
3690:
3691: (defconst gp-metakeys-gp-script-mode-menu
3692: (list
3693: (list (gp-messager 48)
3694: ["PARI Types" gp-meta-t (processp gp-process)]
3695: ["Default" gp-meta-d (processp gp-process)]
3696: ["Version Number" gp-meta-v t])))
3697:
3698: (defsubst gp-build-main-cmds-menu nil ""
3699: (nconc
3700: (if (equal major-mode 'gp-script-mode)
3701: (list
3702: (list (gp-messager 57)
3703: (vector (gp-messager 58) 'gp-usual-start t)
3704: (vector (gp-messager 59) 'gp-start-with-parameters
3705: '(not (processp gp-process)))))
3706: nil)
3707: (list (vector (gp-messager 60) 'run-gp 't))
3708: (if (equal major-mode 'gp-script-mode)
3709: (list (vector (gp-messager 61) 'gp-run-in-region ':enable 'mark-active
3710: ':key-sequence nil)) nil)
3711: (list (vector (gp-messager 62) 'gp-meta-q '(processp gp-process)
3712: ':key-sequence nil))))
3713:
3714: (defconst gp-manual-menu
3715: (nconc
3716: (if (eq window-system 'x)
3717: (list ["Browser" gp-browser (eq window-system 'x) :key-sequence nil])
3718: nil)
3719: (list
3720: ["Info Survey" gp-menu t] ; Text info
3721: ["TeX Manual" gpman t :key-sequence nil] ; TeX info
3722: ["Tutorial" gp-tutorial t :key-sequence nil] ; TeX info
3723: "-------------------------"
3724: ["Info on Function..." gp-get-man-entry t] ; Text info
3725: ["Info on Subject..." gp-get-apropos t] ; Text info
3726: ["TeX Info on ..." gp-get-TeX-man-entry t :key-sequence nil] ; TeX info
3727: "-------------------------"
3728: (vector (gp-messager 63) 'gp-show-pariemacs 't ':key-sequence nil))))
3729:
3730: (defsubst gp-build-cpl-file-menu nil ""
3731: (list
3732: (nconc
3733: (list (gp-messager 64)
3734: (vector (gp-messager 65) 'gp-cpl-file ':enable t ':key-sequence nil)
3735: (vector (gp-messager 66) 'gp-edit-cpl-file
3736: ':enable t ':key-sequence nil))
3737: (if (equal major-mode 'gp-script-mode)
3738: (list (vector (gp-messager 67) 'gp-make-cpl-file
3739: ':enable t ':key-sequence nil)
3740: ["Info" gp-cpl-file-info :enable t :key-sequence nil]) nil))))
3741:
3742: (defsubst gp-build-utilities-menu nil ""
3743: (nconc
3744: (list (vector (gp-messager 72) 'gp-complete t))
3745: (list (vector (gp-messager 73) 'gp-skip-to-error t))
3746: (if (equal major-mode 'gp-mode)
3747: (list
3748: (list (gp-messager 74)
3749: (vector (gp-messager 75) 'gp-copy-last-input '(processp gp-process))
3750: (vector (gp-messager 76) 'gp-remove-last-output t)
3751: (vector (gp-messager 77) 'gp-remove-last-action t)))
3752: nil)
3753: (if (equal major-mode 'gp-mode)
3754: (list (vector (gp-messager 78) 'gp-toggle t)) nil)
3755: ))
3756:
3757: ;;--------------------------------------
3758: ;; MENU-BAR ITEM USED IN GP-SCRIPT-MODE
3759: ;;--------------------------------------
3760:
3761: (defun gp-init-script-menu-bar nil
3762: "Add menu-bar item GP if wanted and possible."
3763: (if (and (featurep 'easymenu) (not gp-no-menu-bar)
3764: (eq GP-script-menu-map nil))
3765: (easy-menu-define GP-script-menu-map gp-script-map
3766: "Menu-bar item used under gp-script-mode."
3767: (append
3768: (list "GP")
3769: (gp-build-main-cmds-menu) gp-separator
3770: gp-manual-menu gp-separator
3771: gp-metakeys-gp-script-mode-menu
3772: (gp-build-color-menu)
3773: (list (vector (gp-messager 70) 'gp-tutorial-switch t)) gp-separator
3774: (gp-build-utilities-menu) gp-separator
3775: (gp-build-cpl-file-menu)
3776: (list (vector (gp-messager 71) 'gp-restore-wind-conf
3777: 'gp-registers-list))
3778: ))))
3779:
3780: ;;-------------------------------
3781: ;; MENU-BAR ITEM USED IN GP-MODE
3782: ;;-------------------------------
3783:
3784: (defun gp-init-menu-bar nil
3785: "Add menu-bar item GP if wanted and possible."
3786: (if (and (featurep 'easymenu) (not gp-no-menu-bar)
3787: (eq GP-menu-map nil))
3788: (easy-menu-define GP-menu-map gp-map
3789: "Menu-bar item used under gp-mode."
3790: (append
3791: (list "GP")
3792: (gp-build-main-cmds-menu) gp-separator
3793: gp-manual-menu gp-separator
3794: gp-metakeys-gp-mode-menu
3795: (gp-build-color-menu)
3796: (list (vector (gp-messager 70) 'gp-tutorial-switch 't)) gp-separator
3797: (gp-build-utilities-menu) gp-separator
3798: (gp-build-cpl-file-menu)
3799: (list (vector (gp-messager 71) 'gp-restore-wind-conf
3800: 'gp-registers-list))))))
3801:
3802: ;;; pari.el ends here ----------3797 lines
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>