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