aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2004-03-03 23:50:41 +0000
committerKenichi Handa2004-03-03 23:50:41 +0000
commit4ca81955be9b7fed99f1300f8a96102b3b2b5dc5 (patch)
tree26f74664f8d80ee9c0530f852fe069afa737fbdd
parente071f4f2515284d9fe1b0800dc2169d8a6902685 (diff)
downloademacs-4ca81955be9b7fed99f1300f8a96102b3b2b5dc5.tar.gz
emacs-4ca81955be9b7fed99f1300f8a96102b3b2b5dc5.zip
(obj): Include bidi.o.
(bidi.o): New target. (xdisp.o): Depend on bidi.h.
Diffstat
-rwxr-xr-xINSTALL-CVS44
-rw-r--r--lisp/emacs-lisp/testcover-ses.el711
-rw-r--r--lisp/emacs-lisp/testcover-unsafep.el139
-rw-r--r--lisp/gdb-ui.el2461
-rw-r--r--lisp/toolbar/gud-display.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-display.xpm29
-rw-r--r--lisp/toolbar/gud-next.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-next.xpm34
-rw-r--r--lisp/toolbar/gud-nexti.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-nexti.xpm33
-rw-r--r--lisp/toolbar/gud-step.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-step.xpm33
-rw-r--r--lisp/toolbar/gud-stepi.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-stepi.xpm32
-rw-r--r--lispref/index.perm38
-rw-r--r--lispref/index.unperm29
-rw-r--r--lispref/permute-index124
-rw-r--r--mac/Emacs.app/Contents/Resources/Emacs.rsrcbin0 -> 6058 bytes
-rw-r--r--man/kmacro.texi522
-rw-r--r--nt/envadd.bat48
-rw-r--r--nt/multi-install-info.bat45
-rw-r--r--src/.gdbinit-union400
-rw-r--r--src/Makefile.in2
-rw-r--r--src/alloca.s350
24 files changed, 4459 insertions, 615 deletions
diff --git a/INSTALL-CVS b/INSTALL-CVS
new file mode 100755
index 00000000000..779262bfa63
--- /dev/null
+++ b/INSTALL-CVS
@@ -0,0 +1,44 @@
1 Building and Installing Emacs from CVS
2
3Some of the files that are included in the Emacs tarball, such as
4byte-compiled Lisp files, are not stored in the CVS repository.
5Therefore, to build from CVS you must run "make bootstrap"
6instead of just "make":
7
8 $ ./configure
9 $ make bootstrap
10
11The bootstrap process makes sure all necessary files are rebuilt
12before it builds the final Emacs binary.
13
14Normally, it is not necessary to use "make bootstrap" after every CVS
15update. Unless there are problems, we suggest the following
16procedure:
17
18 $ ./configure
19 $ make
20 $ cd lisp
21 $ make recompile EMACS=../src/emacs
22 $ cd ..
23 $ make
24
25(If you want to install the Emacs binary, type "make install" instead
26of "make" in the last command.)
27
28If the above procedure fails, try "make bootstrap".
29
30Users of non-Posix systems (MS-Windows etc.) should run the
31platform-specific configuration scripts (nt/configure.bat, config.bat,
32etc.) before "make bootstrap" or "make"; the rest of the procedure is
33applicable to those systems as well.
34
35Note that "make bootstrap" overwrites some files that are under CVS
36control, such as lisp/loaddefs.el. This could produce CVS conflicts
37next time that you resync with the CVS. If you see such conflicts,
38overwrite your local copy of the file with the clean version from the
39CVS repository. For example:
40
41 cvs update -C lisp/loaddefs.el
42
43Questions, requests, and bug reports about the CVS versions of Emacs
44sould be sent to emacs-pretest-bug@gnu.org rather.
diff --git a/lisp/emacs-lisp/testcover-ses.el b/lisp/emacs-lisp/testcover-ses.el
new file mode 100644
index 00000000000..2b8179a397f
--- /dev/null
+++ b/lisp/emacs-lisp/testcover-ses.el
@@ -0,0 +1,711 @@
1;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Jonathan Yavner <jyavner@engineer.com>
6;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
7;; Keywords: spreadsheet lisp utility
8
9;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24(require 'testcover)
25
26;;;Here are some macros that exercise SES. Set `pause' to t if you want the
27;;;macros to pause after each step.
28(let* ((pause nil)
29 (x (if pause "q" ""))
30 (y "ses-test.ses\r<"))
31 ;;Fiddle with the existing spreadsheet
32 (fset 'ses-exercise-example
33 (concat "" data-directory "ses-example.ses\r<"
34 x "10"
35 x " "
36 x ""
37 x "pses-center\r"
38 x "p\r"
39 x "\t\t"
40 x "\r A9 B9\r"
41 x ""
42 x "\r 2\r"
43 x ""
44 x "50\r"
45 x "4"
46 x " "
47 x ""
48 x "(+ o\0"
49 x "-1o \r"
50 x ""
51 x))
52 ;;Create a new spreadsheet
53 (fset 'ses-exercise-new
54 (concat y
55 x "\"%.8g\"\r"
56 x "2\r"
57 x ""
58 x ""
59 x "2"
60 x "\"Header\r"
61 x "(sqrt 1\r"
62 x "pses-center\r"
63 x "\t"
64 x "(+ A2 A3\r"
65 x "(* B2 A3\r"
66 x "2"
67 x "\rB3\r"
68 x ""
69 x))
70 ;;Basic cell display
71 (fset 'ses-exercise-display
72 (concat y ":(revert-buffer t t)\r"
73 x ""
74 x "\"Very long\r"
75 x "w3\r"
76 x "w3\r"
77 x "(/ 1 0\r"
78 x "234567\r"
79 x "5w"
80 x "\t1\r"
81 x ""
82 x "234567\r"
83 x "\t"
84 x ""
85 x "345678\r"
86 x "3w"
87 x "\0>"
88 x ""
89 x ""
90 x ""
91 x ""
92 x ""
93 x ""
94 x ""
95 x "1\r"
96 x ""
97 x ""
98 x "\"1234567-1234567-1234567\r"
99 x "123\r"
100 x "2"
101 x "\"1234567-1234567-1234567\r"
102 x "123\r"
103 x "w8\r"
104 x "\"1234567\r"
105 x "w5\r"
106 x))
107 ;;Cell formulas
108 (fset 'ses-exercise-formulas
109 (concat y ":(revert-buffer t t)\r"
110 x "\t\t"
111 x "\t"
112 x "(* B1 B2 D1\r"
113 x "(* B2 B3\r"
114 x "(apply '+ (ses-range B1 B3)\r"
115 x "(apply 'ses+ (ses-range B1 B3)\r"
116 x "(apply 'ses+ (ses-range A2 A3)\r"
117 x "(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r"
118 x "(apply 'concat (reverse (ses-range A3 D3))\r"
119 x "(* (+ A2 A3) (ses+ B2 B3)\r"
120 x ""
121 x "2"
122 x "5\t"
123 x "(apply 'ses+ (ses-range E1 E2)\r"
124 x "(apply 'ses+ (ses-range A5 B5)\r"
125 x "(apply 'ses+ (ses-range E1 F1)\r"
126 x "(apply 'ses+ (ses-range D1 E1)\r"
127 x "\t"
128 x "(ses-average (ses-range A2 A5)\r"
129 x "(apply 'ses+ (ses-range A5 A6)\r"
130 x "k"
131 x " "
132 x ""
133 x "2"
134 x "3 "
135 x "o"
136 x "2o"
137 x "3k"
138 x "(ses-average (ses-range B3 E3)\r"
139 x "k"
140 x "12345678\r"
141 x))
142 ;;Recalculating and reconstructing
143 (fset 'ses-exercise-recalc
144 (concat y ":(revert-buffer t t)\r"
145 x " "
146 x "\t\t"
147 x ""
148 x "(/ 1 0\r"
149 x ""
150 x "\n"
151 x ""
152 x "\"%.6g\"\r"
153 x " "
154 x ">nw"
155 x "\0>xdelete-region\r"
156 x " "
157 x "8"
158 x "\0>xdelete-region\r"
159 x " "
160 x ""
161 x " k"
162 x " "
163 x "\"Very long\r"
164 x ""
165 x "\r\r"
166 x ""
167 x "o"
168 x ""
169 x "\"Very long2\r"
170 x "o"
171 x ""
172 x "\rC3\r"
173 x "\rC2\r"
174 x "\0"
175 x "\rC4\r"
176 x "\rC2\r"
177 x "\0"
178 x ""
179 x "xses-mode\r"
180 x "<"
181 x "2k"
182 x))
183 ;;Header line
184 (fset 'ses-exercise-header-row
185 (concat y ":(revert-buffer t t)\r"
186 x "<"
187 x ">"
188 x "6<"
189 x ">"
190 x "7<"
191 x ">"
192 x "8<"
193 x "2<"
194 x ">"
195 x "3w"
196 x "10<"
197 x ">"
198 x "2 "
199 x))
200 ;;Detecting unsafe formulas and printers
201 (fset 'ses-exercise-unsafe
202 (concat y ":(revert-buffer t t)\r"
203 x "p(lambda (x) (delete-file x))\rn"
204 x "p(lambda (x) (delete-file \"ses-nothing\"))\ry"
205 x "\0n"
206 x "(delete-file \"x\"\rn"
207 x "(delete-file \"ses-nothing\"\ry"
208 x "\0n"
209 x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry"
210 x "\0n"
211 x))
212 ;;Inserting and deleting rows
213 (fset 'ses-exercise-rows
214 (concat y ":(revert-buffer t t)\r"
215 x ""
216 x "\"%s=\"\r"
217 x "20"
218 x "p\"%s+\"\r"
219 x ""
220 x "123456789\r"
221 x "\021"
222 x ""
223 x " "
224 x "(not B25\r"
225 x "k"
226 x "jA3\r"
227 x "19 "
228 x " "
229 x "100" ;Make this approx your CPU speed in MHz
230 x))
231 ;;Inserting and deleting columns
232 (fset 'ses-exercise-columns
233 (concat y ":(revert-buffer t t)\r"
234 x "\"%s@\"\r"
235 x "o"
236 x ""
237 x "o"
238 x " "
239 x "k"
240 x "w8\r"
241 x "p\"%.7s*\"\r"
242 x "o"
243 x ""
244 x "2o"
245 x "3k"
246 x "\"%.6g\"\r"
247 x "26o"
248 x "\026\t"
249 x "26o"
250 x "0\r"
251 x "26\t"
252 x "400"
253 x "50k"
254 x "\0D"
255 x))
256 (fset 'ses-exercise-editing
257 (concat y ":(revert-buffer t t)\r"
258 x "1\r"
259 x "('x\r"
260 x ""
261 x ""
262 x "\r\r"
263 x "w9\r"
264 x "\r.5\r"
265 x "\r 10\r"
266 x "w12\r"
267 x "\r'\r"
268 x "\r\r"
269 x "jA4\r"
270 x "(+ A2 100\r"
271 x "3\r"
272 x "jB1\r"
273 x "(not A1\r"
274 x "\"Very long\r"
275 x ""
276 x "h"
277 x "H"
278 x ""
279 x ">\t"
280 x ""
281 x ""
282 x "2"
283 x ""
284 x "o"
285 x "h"
286 x "\0"
287 x "\"Also very long\r"
288 x "H"
289 x "\0'\r"
290 x "'Trial\r"
291 x "'qwerty\r"
292 x "(concat o<\0"
293 x "-1o\r"
294 x "(apply '+ o<\0-1o\r"
295 x "2"
296 x "-2"
297 x "-2"
298 x "2"
299 x " "
300 x "H"
301 x "\0"
302 x "\"Another long one\r"
303 x "H"
304 x ""
305 x "<"
306 x ""
307 x ">"
308 x "\0"
309 x))
310 ;;Sorting of columns
311 (fset 'ses-exercise-sort-column
312 (concat y ":(revert-buffer t t)\r"
313 x "\"Very long\r"
314 x "99\r"
315 x "o13\r"
316 x "(+ A3 B3\r"
317 x "7\r8\r(* A4 B4\r"
318 x "\0A\r"
319 x "\0B\r"
320 x "\0C\r"
321 x "o"
322 x "\0C\r"
323 x))
324 ;;Simple cell printers
325 (fset 'ses-exercise-cell-printers
326 (concat y ":(revert-buffer t t)\r"
327 x "\"4\t76\r"
328 x "\"4\n7\r"
329 x "p\"{%S}\"\r"
330 x "p(\"[%s]\")\r"
331 x "p(\"<%s>\")\r"
332 x "\0"
333 x "p\r"
334 x "pnil\r"
335 x "pses-dashfill\r"
336 x "48\r"
337 x "\t"
338 x "\0p\r"
339 x "p\r"
340 x "pses-dashfill\r"
341 x "\0pnil\r"
342 x "5\r"
343 x "pses-center\r"
344 x "\"%s\"\r"
345 x "w8\r"
346 x "p\r"
347 x "p\"%.7g@\"\r"
348 x "\r"
349 x "\"%.6g#\"\r"
350 x "\"%.6g.\"\r"
351 x "\"%.6g.\"\r"
352 x "pidentity\r"
353 x "6\r"
354 x "\"UPCASE\r"
355 x "pdowncase\r"
356 x "(* 3 4\r"
357 x "p(lambda (x) '(\"Hi\"))\r"
358 x "p(lambda (x) '(\"Bye\"))\r"
359 x))
360 ;;Spanning cell printers
361 (fset 'ses-exercise-spanning-printers
362 (concat y ":(revert-buffer t t)\r"
363 x "p\"%.6g*\"\r"
364 x "pses-dashfill-span\r"
365 x "5\r"
366 x "pses-tildefill-span\r"
367 x "\"4\r"
368 x "p\"$%s\"\r"
369 x "p(\"$%s\")\r"
370 x "8\r"
371 x "p(\"!%s!\")\r"
372 x "\t\"12345678\r"
373 x "pses-dashfill-span\r"
374 x "\"23456789\r"
375 x "\t"
376 x "(not t\r"
377 x "w6\r"
378 x "\"5\r"
379 x "o"
380 x "k"
381 x "k"
382 x "\t"
383 x ""
384 x "o"
385 x "2k"
386 x "k"
387 x))
388 ;;Cut/copy/paste - within same buffer
389 (fset 'ses-exercise-paste-1buf
390 (concat y ":(revert-buffer t t)\r"
391 x "\0w"
392 x ""
393 x "o"
394 x "\"middle\r"
395 x "\0"
396 x "w"
397 x "\0"
398 x "w"
399 x ""
400 x ""
401 x "2y"
402 x "y"
403 x "y"
404 x ">"
405 x "y"
406 x ">y"
407 x "<"
408 x "p\"<%s>\"\r"
409 x "pses-dashfill\r"
410 x "\0"
411 x ""
412 x ""
413 x "y"
414 x "\r\0w"
415 x "\r"
416 x "3(+ G2 H1\r"
417 x "\0w"
418 x ">"
419 x ""
420 x "8(ses-average (ses-range G2 H2)\r"
421 x "\0k"
422 x "7"
423 x ""
424 x "(ses-average (ses-range E7 E9)\r"
425 x "\0 "
426 x ""
427 x "(ses-average (ses-range E7 F7)\r"
428 x "\0k"
429 x ""
430 x "(ses-average (ses-range D6 E6)\r"
431 x "\0k"
432 x ""
433 x "2"
434 x "\"Line A\r"
435 x "pses-tildefill-span\r"
436 x "\"Subline A(1)\r"
437 x "pses-dashfill-span\r"
438 x "\0w"
439 x ""
440 x ""
441 x "\0w"
442 x ""
443 x))
444 ;;Cut/copy/paste - between two buffers
445 (fset 'ses-exercise-paste-2buf
446 (concat y ":(revert-buffer t t)\r"
447 x "o\"middle\r\0"
448 x ""
449 x "4bses-test.txt\r"
450 x " "
451 x "\"xxx\0"
452 x "wo"
453 x ""
454 x ""
455 x "o\"\0"
456 x "wo"
457 x "o123.45\0"
458 x "o"
459 x "o1 \0"
460 x "o"
461 x ">y"
462 x "o symb\0"
463 x "oy2y"
464 x "o1\t\0"
465 x "o"
466 x "w9\np\"<%s>\"\n"
467 x "o\n2\t\"3\nxxx\t5\n\0"
468 x "oy"
469 x))
470 ;;Export text, import it back
471 (fset 'ses-exercise-import-export
472 (concat y ":(revert-buffer t t)\r"
473 x "\0xt"
474 x "4bses-test.txt\r"
475 x "\n-1o"
476 x "xTo-1o"
477 x "'crunch\r"
478 x "pses-center-span\r"
479 x "\0xT"
480 x "o\n-1o"
481 x "\0y"
482 x "\0xt"
483 x "\0y"
484 x "12345678\r"
485 x "'bunch\r"
486 x "\0xtxT"
487 x)))
488
489(defun ses-exercise-macros ()
490 "Executes all SES coverage-test macros."
491 (dolist (x '(ses-exercise-example
492 ses-exercise-new
493 ses-exercise-display
494 ses-exercise-formulas
495 ses-exercise-recalc
496 ses-exercise-header-row
497 ses-exercise-unsafe
498 ses-exercise-rows
499 ses-exercise-columns
500 ses-exercise-editing
501 ses-exercise-sort-column
502 ses-exercise-cell-printers
503 ses-exercise-spanning-printers
504 ses-exercise-paste-1buf
505 ses-exercise-paste-2buf
506 ses-exercise-import-export))
507 (message "<Testing %s>" x)
508 (execute-kbd-macro x)))
509
510(defun ses-exercise-signals ()
511 "Exercise code paths that lead to error signals, other than those for
512spreadsheet files with invalid formatting."
513 (message "<Checking for expected errors>")
514 (switch-to-buffer "ses-test.ses")
515 (deactivate-mark)
516 (ses-jump 'A1)
517 (ses-set-curcell)
518 (dolist (x '((ses-column-widths 14)
519 (ses-column-printers "%s")
520 (ses-column-printers ["%s" "%s" "%s"]) ;Should be two
521 (ses-column-widths [14])
522 (ses-delete-column -99)
523 (ses-delete-column 2)
524 (ses-delete-row -1)
525 (ses-goto-data 'hogwash)
526 (ses-header-row -56)
527 (ses-header-row 99)
528 (ses-insert-column -14)
529 (ses-insert-row 0)
530 (ses-jump 'B8) ;Covered by preceding cell
531 (ses-printer-validate '("%s" t))
532 (ses-printer-validate '([47]))
533 (ses-read-header-row -1)
534 (ses-read-header-row 32767)
535 (ses-relocate-all 0 0 -1 1)
536 (ses-relocate-all 0 0 1 -1)
537 (ses-select (ses-range A1 A2) 'x (ses-range B1 B1))
538 (ses-set-cell 0 0 'hogwash nil)
539 (ses-set-column-width 0 0)
540 (ses-yank-cells #("a\nb"
541 0 1 (ses (A1 nil nil))
542 2 3 (ses (A3 nil nil)))
543 nil)
544 (ses-yank-cells #("ab"
545 0 1 (ses (A1 nil nil))
546 1 2 (ses (A2 nil nil)))
547 nil)
548 (ses-yank-pop nil)
549 (ses-yank-tsf "1\t2\n3" nil)
550 (let ((curcell nil)) (ses-check-curcell))
551 (let ((curcell 'A1)) (ses-check-curcell 'needrange))
552 (let ((curcell '(A1 . A2))) (ses-check-curcell 'end))
553 (let ((curcell '(A1 . A2))) (ses-sort-column "B"))
554 (let ((curcell '(C1 . D2))) (ses-sort-column "B"))
555 (execute-kbd-macro "jB10\n2")
556 (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut])
557 (progn (kill-new "x") (execute-kbd-macro ">n"))
558 (execute-kbd-macro "\0w")))
559 (condition-case nil
560 (progn
561 (eval x)
562 (signal 'singularity-error nil)) ;Shouldn't get here
563 (singularity-error (error "No error from %s?" x))
564 (error nil)))
565 ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
566 (let ((inhibit-quit t))
567 (setq quit-flag t)
568 (condition-case nil
569 (progn
570 (ses-update-cells '(A1))
571 (signal 'singularity-error nil))
572 (singularity-error (error "Quit failure in ses-update-cells"))
573 (error nil))
574 (setq quit-flag nil)))
575
576(defun ses-exercise-invalid-spreadsheets ()
577 "Execute code paths that detect invalid spreadsheet files."
578 ;;Detect invalid spreadsheets
579 (let ((p&d "\n\n \n(ses-cell A1 nil nil nil nil)\n\n")
580 (cw "(ses-column-widths [7])\n")
581 (cp "(ses-column-printers [ses-center])\n")
582 (dp "(ses-default-printer \"%.7g\")\n")
583 (hr "(ses-header-row 0)\n")
584 (p11 "(2 1 1)")
585 (igp ses-initial-global-parameters))
586 (dolist (x (list "(1)"
587 "(x 2 3)"
588 "(1 x 3)"
589 "(1 -1 0)"
590 "(1 2 x)"
591 "(1 2 -1)"
592 "(3 1 1)"
593 "\n\n (2 1 1)"
594 "\n\n \n(ses-cell)(2 1 1)"
595 "\n\n \n(x)\n(2 1 1)"
596 "\n\n\n \n(ses-cell A2)\n(2 2 2)"
597 "\n\n\n \n(ses-cell B1)\n(2 2 2)"
598 "\n\n \n(ses-cell A1 nil nil nil nil)\n(2 1 1)"
599 (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11)
600 (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11)
601 (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)")
602 (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11)
603 (concat p&d cw cp "(x)\n(x)\n" p11)
604 (concat p&d cw cp "(ses-default-printer)(x)\n" p11)
605 (concat p&d cw cp dp "(x)\n" p11)
606 (concat p&d cw cp dp "(ses-header-row)" p11)
607 (concat p&d cw cp dp hr p11)
608 (concat p&d cw cp dp "\n" hr igp)))
609 (condition-case nil
610 (with-temp-buffer
611 (insert x)
612 (ses-load)
613 (signal 'singularity-error nil)) ;Shouldn't get here
614 (singularity-error (error "%S is an invalid spreadsheet!" x))
615 (error nil)))))
616
617(defun ses-exercise-startup ()
618 "Prepare for coverage tests"
619 ;;Clean up from any previous runs
620 (condition-case nil (kill-buffer "ses-example.ses") (error nil))
621 (condition-case nil (kill-buffer "ses-test.ses") (error nil))
622 (condition-case nil (delete-file "ses-test.ses") (file-error nil))
623 (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing
624 (setq ses-mode-map nil) ;Force rebuild
625 (testcover-unmark-all "ses.el")
626 ;;Enable
627 (let ((testcover-1value-functions
628 ;;forward-line always returns 0, for us.
629 ;;remove-text-properties always returns t for us.
630 ;;ses-recalculate-cell returns the same " " any time curcell is a cons
631 ;;Macros ses-dorange and ses-dotimes-msg generate code that always
632 ;; returns nil
633 (append '(forward-line remove-text-properties ses-recalculate-cell
634 ses-dorange ses-dotimes-msg)
635 testcover-1value-functions))
636 (testcover-constants
637 ;;These maps get initialized, then never changed again
638 (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map)
639 testcover-constants)))
640 (testcover-start "ses.el" t))
641 (require 'unsafep)) ;In case user has safe-functions = t!
642
643
644;;;#########################################################################
645(defun ses-exercise ()
646 "Executes all SES coverage tests and displays the results."
647 (interactive)
648 (ses-exercise-startup)
649 ;;Run the keyboard-macro tests
650 (let ((safe-functions nil)
651 (ses-initial-size '(1 . 1))
652 (ses-initial-column-width 7)
653 (ses-initial-default-printer "%.7g")
654 (ses-after-entry-functions '(forward-char))
655 (ses-mode-hook nil))
656 (ses-exercise-macros)
657 (ses-exercise-signals)
658 (ses-exercise-invalid-spreadsheets)
659 ;;Upgrade of old-style spreadsheet
660 (with-temp-buffer
661 (insert " \n\n \n(ses-cell A1 nil nil nil nil)\n\n(ses-column-widths [7])\n(ses-column-printers [nil])\n(ses-default-printer \"%.7g\")\n\n( ;Global parameters (these are read first)\n 1 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n")
662 (ses-load))
663 ;;ses-vector-delete is always called from buffer-undo-list with the same
664 ;;symbol as argument. We'll give it a different one here.
665 (let ((x [1 2 3]))
666 (ses-vector-delete 'x 0 0))
667 ;;ses-create-header-string behaves differently in a non-window environment
668 ;;but we always test under windows.
669 (let ((window-system (not window-system)))
670 (scroll-left 7)
671 (ses-create-header-string))
672 ;;Test for nonstandard after-entry functions
673 (let ((ses-after-entry-functions '(forward-line))
674 ses-mode-hook)
675 (ses-read-cell 0 0 1)
676 (ses-read-symbol 0 0 t)))
677 ;;Tests with unsafep disabled
678 (let ((safe-functions t)
679 ses-mode-hook)
680 (message "<Checking safe-functions = t>")
681 (kill-buffer "ses-example.ses")
682 (find-file "ses-example.ses"))
683 ;;Checks for nonstandard default values for new spreadsheets
684 (let (ses-mode-hook)
685 (dolist (x '(("%.6g" 8 (2 . 2))
686 ("%.8g" 6 (3 . 3))))
687 (let ((ses-initial-size (nth 2 x))
688 (ses-initial-column-width (nth 1 x))
689 (ses-initial-default-printer (nth 0 x)))
690 (with-temp-buffer
691 (set-buffer-modified-p t)
692 (ses-mode)))))
693 ;;Test error-handling in command hook, outside a macro.
694 ;;This will ring the bell.
695 (let (curcell-overlay)
696 (ses-command-hook))
697 ;;Due to use of run-with-timer, ses-command-hook sometimes gets called
698 ;;after we switch to another buffer.
699 (switch-to-buffer "*scratch*")
700 (ses-command-hook)
701 ;;Print results
702 (message "<Marking source code>")
703 (testcover-mark-all "ses.el")
704 (testcover-next-mark)
705 ;;Cleanup
706 (delete-other-windows)
707 (kill-buffer "ses-test.txt")
708 ;;Could do this here: (testcover-end "ses.el")
709 (message "Done"))
710
711;; testcover-ses.el ends here.
diff --git a/lisp/emacs-lisp/testcover-unsafep.el b/lisp/emacs-lisp/testcover-unsafep.el
new file mode 100644
index 00000000000..e54648e73ad
--- /dev/null
+++ b/lisp/emacs-lisp/testcover-unsafep.el
@@ -0,0 +1,139 @@
1;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Jonathan Yavner <jyavner@engineer.com>
6;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
7;; Keywords: safety lisp utility
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26(require 'testcover)
27
28;;;These forms are all considered safe
29(defconst testcover-unsafep-safe
30 '(((lambda (x) (* x 2)) 14)
31 (apply 'cdr (mapcar '(lambda (x) (car x)) y))
32 (cond ((= x 4) 5) (t 27))
33 (condition-case x (car y) (error (car x)))
34 (dolist (x y) (message "here: %s" x))
35 (dotimes (x 14 (* x 2)) (message "here: %d" x))
36 (let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
37 (let (x) (apply '(lambda (x) (* x 2)) 14))
38 (let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
39 (let ((x 1) (y 2)) (setq x (+ x y)))
40 (let ((x 1)) (let ((y (+ x 3))) (* x y)))
41 (let* nil (current-time))
42 (let* ((x 1) (y (+ x 3))) (* x y))
43 (mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3))
44 (mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ")
45 (setq buffer-display-count 14 mark-active t)
46 ;;This is not safe if you insert it into a buffer!
47 (propertize "x" 'display '(height (progn (delete-file "x") 1))))
48 "List of forms that `unsafep' should decide are safe.")
49
50;;;These forms are considered unsafe
51(defconst testcover-unsafep-unsafe
52 '(( (add-to-list x y)
53 . (unquoted x))
54 ( (add-to-list y x)
55 . (unquoted y))
56 ( (add-to-list 'y x)
57 . (global-variable y))
58 ( (not (delete-file "unsafep.el"))
59 . (function delete-file))
60 ( (cond (t (aset local-abbrev-table 0 0)))
61 . (function aset))
62 ( (cond (t (setq unsafep-vars "")))
63 . (risky-local-variable unsafep-vars))
64 ( (condition-case format-alist 1)
65 . (risky-local-variable format-alist))
66 ( (condition-case x 1 (error (setq format-alist "")))
67 . (risky-local-variable format-alist))
68 ( (dolist (x (sort globalvar 'car)) (princ x))
69 . (function sort))
70 ( (dotimes (x 14) (delete-file "x"))
71 . (function delete-file))
72 ( (let ((post-command-hook "/tmp/")) 1)
73 . (risky-local-variable post-command-hook))
74 ( (let ((x (delete-file "x"))) 2)
75 . (function delete-file))
76 ( (let (x) (add-to-list 'x (delete-file "x")))
77 . (function delete-file))
78 ( (let (x) (condition-case y (setq x 1 z 2)))
79 . (global-variable z))
80 ( (let (x) (condition-case z 1 (error (delete-file "x"))))
81 . (function delete-file))
82 ( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4))))
83 . (function setcar))
84 ( (let (y) (push (delete-file "x") y))
85 . (function delete-file))
86 ( (let* ((x 1)) (setq y 14))
87 . (global-variable y))
88 ( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el")))
89 . (function kill-buffer))
90 ( (mapcar x y)
91 . (unquoted x))
92 ( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el"))
93 . (function rename-file))
94 ( (mapconcat x1 x2 " ")
95 . (unquoted x1))
96 ( (pop format-alist)
97 . (risky-local-variable format-alist))
98 ( (push 1 format-alist)
99 . (risky-local-variable format-alist))
100 ( (setq buffer-display-count (delete-file "x"))
101 . (function delete-file))
102 ;;These are actualy safe (they signal errors)
103 ( (apply '(x) '(1 2 3))
104 . (function (x)))
105 ( (let (((x))) 1)
106 . (variable (x)))
107 ( (let (1) 2)
108 . (variable 1))
109 )
110 "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
111
112
113;;;#########################################################################
114(defun testcover-unsafep ()
115 "Executes all unsafep tests and displays the coverage results."
116 (interactive)
117 (testcover-unmark-all "unsafep.el")
118 (testcover-start "unsafep.el")
119 (let (save-functions)
120 (dolist (x testcover-unsafep-safe)
121 (if (unsafep x)
122 (error "%S should be safe" x)))
123 (dolist (x testcover-unsafep-unsafe)
124 (if (not (equal (unsafep (car x)) (cdr x)))
125 (error "%S should be unsafe: %s" (car x) (cdr x))))
126 (setq safe-functions t)
127 (if (or (unsafep '(delete-file "x"))
128 (unsafep-function 'delete-file))
129 (error "safe-functions=t should allow delete-file"))
130 (setq safe-functions '(setcar))
131 (if (unsafep '(setcar x 1))
132 (error "safe-functions=(setcar) should allow setcar"))
133 (if (not (unsafep '(setcdr x 1)))
134 (error "safe-functions=(setcar) should not allow setcdr")))
135 (testcover-mark-all "unsafep.el")
136 (testcover-end "unsafep.el")
137 (message "Done"))
138
139;; testcover-unsafep.el ends here.
diff --git a/lisp/gdb-ui.el b/lisp/gdb-ui.el
new file mode 100644
index 00000000000..08d5e901c73
--- /dev/null
+++ b/lisp/gdb-ui.el
@@ -0,0 +1,2461 @@
1;;; gdb-ui.el --- User Interface for running GDB
2
3;; Author: Nick Roberts <nick@nick.uklinux.net>
4;; Maintainer: FSF
5;; Keywords: unix, tools
6
7;; Copyright (C) 2002 Free Software Foundation, Inc.
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27
28;; This mode acts as a graphical user interface to GDB. You can interact with
29;; GDB through the GUD buffer in the usual way, but there are also further
30;; buffers which control the execution and describe the state of your program.
31;; It separates the input/output of your program from that of GDB and displays
32;; expressions and their current values in their own buffers. It also uses
33;; features of Emacs 21 such as the display margin for breakpoints, and the
34;; toolbar (see the GDB Graphical Interface section in the Emacs info manual).
35
36;; Start the debugger with M-x gdba.
37
38;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim
39;; Kingdon and uses GDB's annotation interface. You don't need to know about
40;; annotations to use this mode as a debugger, but if you are interested
41;; developing the mode itself, then see the Annotations section in the GDB
42;; info manual.
43;;
44;; Known Bugs:
45;; Does not auto-display arrays of structures or structures containing arrays.
46;; On MS Windows, Gdb 5.1.1 from MinGW 2.0 does not flush the output from the
47;; inferior.
48
49;;; Code:
50
51(require 'gud)
52
53(defcustom gdb-window-height 20
54 "Number of lines in a frame for a displayed expression in GDB-UI."
55 :type 'integer
56 :group 'gud)
57
58(defcustom gdb-window-width 30
59 "Width of a frame for a displayed expression in GDB-UI."
60 :type 'integer
61 :group 'gud)
62
63(defvar gdb-current-address "main" "Initialisation for Assembler buffer.")
64(defvar gdb-previous-address nil)
65(defvar gdb-previous-frame nil)
66(defvar gdb-current-frame "main")
67(defvar gdb-display-in-progress nil)
68(defvar gdb-dive nil)
69(defvar gdb-view-source t "Non-nil means that source code can be viewed")
70(defvar gdb-selected-view 'source "Code type that user wishes to view")
71(defvar gdb-buffer-type nil)
72(defvar gdb-variables '()
73 "A list of variables that are local to the GUD buffer.")
74
75
76;;;###autoload
77(defun gdba (command-line)
78 "Run gdb on program FILE in buffer *gud-FILE*.
79The directory containing FILE becomes the initial working directory
80and source-file directory for your debugger.
81
82If `gdb-many-windows' is nil (the default value) then gdb starts with
83just two windows : the GUD and the source buffer. If it is t the
84following layout will appear (keybindings given in relevant buffer) :
85
86---------------------------------------------------------------------
87 GDB Toolbar
88---------------------------------------------------------------------
89GUD buffer (I/O of GDB) | Locals buffer
90 |
91 |
92 |
93---------------------------------------------------------------------
94Source buffer | Input/Output (of debuggee) buffer
95 | (comint-mode)
96 |
97 |
98 |
99 |
100 |
101 |
102---------------------------------------------------------------------
103Stack buffer | Breakpoints buffer
104 RET gdb-frames-select | SPC gdb-toggle-breakpoint
105 | RET gdb-goto-breakpoint
106 | d gdb-delete-breakpoint
107---------------------------------------------------------------------
108
109All the buffers share the toolbar and source should always display in the same
110window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint
111icons are displayed both by setting a break with gud-break and by typing break
112in the GUD buffer.
113
114This works best (depending on the size of your monitor) using most of the
115screen.
116
117Displayed expressions appear in separate frames. Arrays may be displayed
118as slices and visualised using the graph program from plotutils if installed.
119Pointers in structures may be followed in a tree-like fashion.
120
121The following interactive lisp functions help control operation :
122
123`gdb-many-windows' - Toggle the number of windows gdb uses.
124`gdb-restore-windows' - To restore the window layout.
125`gdb-quit' - To delete (most) of the buffers used by GDB-UI and
126 reset variables."
127 ;;
128 (interactive (list (gud-query-cmdline 'gdba)))
129 ;;
130 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
131 (gdb command-line)
132 ;;
133 (set (make-local-variable 'gud-minor-mode) 'gdba)
134 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
135 ;;
136 (gud-def gud-break (if (not (string-equal mode-name "Assembler"))
137 (gud-call "break %f:%l" arg)
138 (save-excursion
139 (beginning-of-line)
140 (forward-char 2)
141 (gud-call "break *%a" arg)))
142 "\C-b" "Set breakpoint at current line or address.")
143 ;;
144 (gud-def gud-remove (if (not (string-equal mode-name "Assembler"))
145 (gud-call "clear %f:%l" arg)
146 (save-excursion
147 (beginning-of-line)
148 (forward-char 2)
149 (gud-call "clear *%a" arg)))
150 "\C-d" "Remove breakpoint at current line or address.")
151 ;;
152 (gud-def gud-until (if (not (string-equal mode-name "Assembler"))
153 (gud-call "until %f:%l" arg)
154 (save-excursion
155 (beginning-of-line)
156 (forward-char 2)
157 (gud-call "until *%a" arg)))
158 "\C-u" "Continue to current line or address.")
159
160 (setq comint-input-sender 'gdb-send)
161 ;;
162 ;; (re-)initialise
163 (setq gdb-current-address "main")
164 (setq gdb-previous-address nil)
165 (setq gdb-previous-frame nil)
166 (setq gdb-current-frame "main")
167 (setq gdb-display-in-progress nil)
168 (setq gdb-dive nil)
169 (setq gdb-view-source t)
170 (setq gdb-selected-view 'source)
171 ;;
172 (mapc 'make-local-variable gdb-variables)
173 (setq gdb-buffer-type 'gdba)
174 ;;
175 (gdb-clear-inferior-io)
176 ;;
177 (if (eq window-system 'w32)
178 (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
179 (gdb-enqueue-input (list "set height 0\n" 'ignore))
180 ;; find source file and compilation directory here
181 (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program
182 (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program
183 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
184 ;;
185 (run-hooks 'gdba-mode-hook))
186
187(defun gud-display ()
188 "Auto-display (possibly dereferenced) C expression at point."
189 (interactive)
190 (save-excursion
191 (let ((expr (gud-find-c-expr)))
192 (gdb-enqueue-input
193 (list (concat "server ptype " expr "\n")
194 `(lambda () (gud-display1 ,expr)))))))
195
196(defun gud-display1 (expr)
197 (goto-char (point-min))
198 (if (looking-at "No symbol")
199 (progn
200 (gdb-set-output-sink 'user)
201 (gud-call (concat "server ptype " expr)))
202 (goto-char (- (point-max) 1))
203 (if (equal (char-before) (string-to-char "\*"))
204 (gdb-enqueue-input
205 (list (concat "display* " expr "\n") 'ignore))
206 (gdb-enqueue-input
207 (list (concat "display " expr "\n") 'ignore)))))
208
209; this would messy because these bindings don't work with M-x gdb
210; (define-key global-map "\C-x\C-a\C-a" 'gud-display)
211; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display)
212
213
214
215;; ======================================================================
216;;
217;; In this world, there are gdb variables (of unspecified
218;; representation) and buffers associated with those objects.
219;; The list of variables is built up by the expansions of
220;; def-gdb-variable
221
222(defmacro def-gdb-var (root-symbol &optional default doc)
223 (let* ((root (symbol-name root-symbol))
224 (accessor (intern (concat "gdb-get-" root)))
225 (setter (intern (concat "gdb-set-" root)))
226 (name (intern (concat "gdb-" root))))
227 `(progn
228 (defvar ,name ,default ,doc)
229 (if (not (memq ',name gdb-variables))
230 (push ',name gdb-variables))
231 (defun ,accessor ()
232 (buffer-local-value ',name gud-comint-buffer))
233 (defun ,setter (val)
234 (with-current-buffer gud-comint-buffer
235 (setq ,name val))))))
236
237(def-gdb-var buffer-type nil
238 "One of the symbols bound in gdb-buffer-rules")
239
240(def-gdb-var burst ""
241 "A string of characters from gdb that have not yet been processed.")
242
243(def-gdb-var input-queue ()
244 "A list of high priority gdb command objects.")
245
246(def-gdb-var idle-input-queue ()
247 "A list of low priority gdb command objects.")
248
249(def-gdb-var prompting nil
250 "True when gdb is idle with no pending input.")
251
252(def-gdb-var output-sink 'user
253 "The disposition of the output of the current gdb command.
254Possible values are these symbols:
255
256 user -- gdb output should be copied to the GUD buffer
257 for the user to see.
258
259 inferior -- gdb output should be copied to the inferior-io buffer
260
261 pre-emacs -- output should be ignored util the post-prompt
262 annotation is received. Then the output-sink
263 becomes:...
264 emacs -- output should be collected in the partial-output-buffer
265 for subsequent processing by a command. This is the
266 disposition of output generated by commands that
267 gdb mode sends to gdb on its own behalf.
268 post-emacs -- ignore input until the prompt annotation is
269 received, then go to USER disposition.
270")
271
272(def-gdb-var current-item nil
273 "The most recent command item sent to gdb.")
274
275(def-gdb-var pending-triggers '()
276 "A list of trigger functions that have run later than their output
277handlers.")
278
279;; end of gdb variables
280
281(defun gdb-get-target-string ()
282 (with-current-buffer gud-comint-buffer
283 gud-target-name))
284
285
286;;
287;; gdb buffers.
288;;
289;; Each buffer has a TYPE -- a symbol that identifies the function
290;; of that particular buffer.
291;;
292;; The usual gdb interaction buffer is given the type `gdba' and
293;; is constructed specially.
294;;
295;; Others are constructed by gdb-get-create-buffer and
296;; named according to the rules set forth in the gdb-buffer-rules-assoc
297
298(defvar gdb-buffer-rules-assoc '())
299
300(defun gdb-get-buffer (key)
301 "Return the gdb buffer tagged with type KEY.
302The key should be one of the cars in `gdb-buffer-rules-assoc'."
303 (save-excursion
304 (gdb-look-for-tagged-buffer key (buffer-list))))
305
306(defun gdb-get-create-buffer (key)
307 "Create a new gdb buffer of the type specified by KEY.
308The key should be one of the cars in `gdb-buffer-rules-assoc'."
309 (or (gdb-get-buffer key)
310 (let* ((rules (assoc key gdb-buffer-rules-assoc))
311 (name (funcall (gdb-rules-name-maker rules)))
312 (new (get-buffer-create name)))
313 (with-current-buffer new
314 ;; FIXME: This should be set after calling the function, since the
315 ;; function should run kill-all-local-variables.
316 (set (make-local-variable 'gdb-buffer-type) key)
317 (if (cdr (cdr rules))
318 (funcall (car (cdr (cdr rules)))))
319 (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer)
320 (set (make-local-variable 'gud-minor-mode) 'gdba)
321 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
322 new))))
323
324(defun gdb-rules-name-maker (rules) (car (cdr rules)))
325
326(defun gdb-look-for-tagged-buffer (key bufs)
327 (let ((retval nil))
328 (while (and (not retval) bufs)
329 (set-buffer (car bufs))
330 (if (eq gdb-buffer-type key)
331 (setq retval (car bufs)))
332 (setq bufs (cdr bufs)))
333 retval))
334
335;;
336;; This assoc maps buffer type symbols to rules. Each rule is a list of
337;; at least one and possible more functions. The functions have these
338;; roles in defining a buffer type:
339;;
340;; NAME - Return a name for this buffer type.
341;;
342;; The remaining function(s) are optional:
343;;
344;; MODE - called in a new buffer with no arguments, should establish
345;; the proper mode for the buffer.
346;;
347
348(defun gdb-set-buffer-rules (buffer-type &rest rules)
349 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
350 (if binding
351 (setcdr binding rules)
352 (push (cons buffer-type rules)
353 gdb-buffer-rules-assoc))))
354
355;; GUD buffers are an exception to the rules
356(gdb-set-buffer-rules 'gdba 'error)
357
358;;
359;; Partial-output buffer : This accumulates output from a command executed on
360;; behalf of emacs (rather than the user).
361;;
362(gdb-set-buffer-rules 'gdb-partial-output-buffer
363 'gdb-partial-output-name)
364
365(defun gdb-partial-output-name ()
366 (concat "*partial-output-"
367 (gdb-get-target-string)
368 "*"))
369
370
371(gdb-set-buffer-rules 'gdb-inferior-io
372 'gdb-inferior-io-name
373 'gdb-inferior-io-mode)
374
375(defun gdb-inferior-io-name ()
376 (concat "*input/output of "
377 (gdb-get-target-string)
378 "*"))
379
380(defvar gdb-inferior-io-mode-map
381 (let ((map (make-sparse-keymap)))
382 (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt)
383 (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
384 (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
385 (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
386 map))
387
388(define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O"
389 "Major mode for gdb inferior-io."
390 :syntax-table nil :abbrev-table nil
391 ;; We want to use comint because it has various nifty and familiar
392 ;; features. We don't need a process, but comint wants one, so create
393 ;; a dummy one.
394 (make-comint-in-buffer
395 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
396 (current-buffer) "hexl")
397 (setq comint-input-sender 'gdb-inferior-io-sender))
398
399(defun gdb-inferior-io-sender (proc string)
400 ;; PROC is the pseudo-process created to satisfy comint.
401 (with-current-buffer (process-buffer proc)
402 (setq proc (get-buffer-process gud-comint-buffer))
403 (process-send-string proc string)
404 (process-send-string proc "\n")))
405
406(defun gdb-inferior-io-interrupt ()
407 "Interrupt the program being debugged."
408 (interactive)
409 (interrupt-process
410 (get-buffer-process gud-comint-buffer) comint-ptyp))
411
412(defun gdb-inferior-io-quit ()
413 "Send quit signal to the program being debugged."
414 (interactive)
415 (quit-process
416 (get-buffer-process gud-comint-buffer) comint-ptyp))
417
418(defun gdb-inferior-io-stop ()
419 "Stop the program being debugged."
420 (interactive)
421 (stop-process
422 (get-buffer-process gud-comint-buffer) comint-ptyp))
423
424(defun gdb-inferior-io-eof ()
425 "Send end-of-file to the program being debugged."
426 (interactive)
427 (process-send-eof
428 (get-buffer-process gud-comint-buffer)))
429
430
431;;
432;; gdb communications
433;;
434
435;; INPUT: things sent to gdb
436;;
437;; There is a high and low priority input queue. Low priority input is sent
438;; only when the high priority queue is idle.
439;;
440;; The queues are lists. Each element is either a string (indicating user or
441;; user-like input) or a list of the form:
442;;
443;; (INPUT-STRING HANDLER-FN)
444;;
445;; The handler function will be called from the partial-output buffer when the
446;; command completes. This is the way to write commands which invoke gdb
447;; commands autonomously.
448;;
449;; These lists are consumed tail first.
450;;
451
452(defun gdb-send (proc string)
453 "A comint send filter for gdb.
454This filter may simply queue output for a later time."
455 (gdb-enqueue-input (concat string "\n")))
456
457;; Note: Stuff enqueued here will be sent to the next prompt, even if it
458;; is a query, or other non-top-level prompt. To guarantee stuff will get
459;; sent to the top-level prompt, currently it must be put in the idle queue.
460;; ^^^^^^^^^
461;; [This should encourage gdb extensions that invoke gdb commands to let
462;; the user go first; it is not a bug. -t]
463;;
464
465(defun gdb-enqueue-input (item)
466 (if (gdb-get-prompting)
467 (progn
468 (gdb-send-item item)
469 (gdb-set-prompting nil))
470 (gdb-set-input-queue
471 (cons item (gdb-get-input-queue)))))
472
473(defun gdb-dequeue-input ()
474 (let ((queue (gdb-get-input-queue)))
475 (and queue
476 (if (not (cdr queue))
477 (let ((answer (car queue)))
478 (gdb-set-input-queue '())
479 answer)
480 (gdb-take-last-elt queue)))))
481
482(defun gdb-enqueue-idle-input (item)
483 (if (and (gdb-get-prompting)
484 (not (gdb-get-input-queue)))
485 (progn
486 (gdb-send-item item)
487 (gdb-set-prompting nil))
488 (gdb-set-idle-input-queue
489 (cons item (gdb-get-idle-input-queue)))))
490
491(defun gdb-dequeue-idle-input ()
492 (let ((queue (gdb-get-idle-input-queue)))
493 (and queue
494 (if (not (cdr queue))
495 (let ((answer (car queue)))
496 (gdb-set-idle-input-queue '())
497 answer)
498 (gdb-take-last-elt queue)))))
499
500;; Don't use this in general.
501(defun gdb-take-last-elt (l)
502 (if (cdr (cdr l))
503 (gdb-take-last-elt (cdr l))
504 (let ((answer (car (cdr l))))
505 (setcdr l '())
506 answer)))
507
508
509;;
510;; output -- things gdb prints to emacs
511;;
512;; GDB output is a stream interrupted by annotations.
513;; Annotations can be recognized by their beginning
514;; with \C-j\C-z\C-z<tag><opt>\C-j
515;;
516;; The tag is a string obeying symbol syntax.
517;;
518;; The optional part `<opt>' can be either the empty string
519;; or a space followed by more data relating to the annotation.
520;; For example, the SOURCE annotation is followed by a filename,
521;; line number and various useless goo. This data must not include
522;; any newlines.
523;;
524
525(defcustom gud-gdba-command-name "gdb -annotate=2 -noasync"
526 "Default command to execute an executable under the GDB-UI debugger."
527 :type 'string
528 :group 'gud)
529
530(defvar gdb-annotation-rules
531 '(("pre-prompt" gdb-pre-prompt)
532 ("prompt" gdb-prompt)
533 ("commands" gdb-subprompt)
534 ("overload-choice" gdb-subprompt)
535 ("query" gdb-subprompt)
536 ("prompt-for-continue" gdb-subprompt)
537 ("post-prompt" gdb-post-prompt)
538 ("source" gdb-source)
539 ("starting" gdb-starting)
540 ("exited" gdb-stopping)
541 ("signalled" gdb-stopping)
542 ("signal" gdb-stopping)
543 ("breakpoint" gdb-stopping)
544 ("watchpoint" gdb-stopping)
545 ("frame-begin" gdb-frame-begin)
546 ("stopped" gdb-stopped)
547 ("display-begin" gdb-display-begin)
548 ("display-end" gdb-display-end)
549; GDB commands info stack, info locals and frame generate an error-begin
550; annotation at start when there is no stack but this is a quirk/bug in
551; annotations.
552; ("error-begin" gdb-error-begin)
553 ("display-number-end" gdb-display-number-end)
554 ("array-section-begin" gdb-array-section-begin)
555 ("array-section-end" gdb-array-section-end)
556 ;; ("elt" gdb-elt)
557 ("field-begin" gdb-field-begin)
558 ("field-end" gdb-field-end)
559 ) "An assoc mapping annotation tags to functions which process them.")
560
561(defconst gdb-source-spec-regexp
562 "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)")
563
564;; Do not use this except as an annotation handler.
565(defun gdb-source (args)
566 (string-match gdb-source-spec-regexp args)
567 ;; Extract the frame position from the marker.
568 (setq gud-last-frame
569 (cons
570 (match-string 1 args)
571 (string-to-int (match-string 2 args))))
572 (setq gdb-current-address (match-string 3 args))
573 (setq gdb-view-source t)
574 ;;update with new frame for machine code if necessary
575 (gdb-invalidate-assembler))
576
577(defun gdb-send-item (item)
578 (gdb-set-current-item item)
579 (if (stringp item)
580 (progn
581 (gdb-set-output-sink 'user)
582 (process-send-string (get-buffer-process gud-comint-buffer) item))
583 (progn
584 (gdb-clear-partial-output)
585 (gdb-set-output-sink 'pre-emacs)
586 (process-send-string (get-buffer-process gud-comint-buffer)
587 (car item)))))
588
589(defun gdb-pre-prompt (ignored)
590 "An annotation handler for `pre-prompt'. This terminates the collection of
591output from a previous command if that happens to be in effect."
592 (let ((sink (gdb-get-output-sink)))
593 (cond
594 ((eq sink 'user) t)
595 ((eq sink 'emacs)
596 (gdb-set-output-sink 'post-emacs)
597 (let ((handler
598 (car (cdr (gdb-get-current-item)))))
599 (save-excursion
600 (set-buffer (gdb-get-create-buffer
601 'gdb-partial-output-buffer))
602 (funcall handler))))
603 (t
604 (gdb-set-output-sink 'user)
605 (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
606
607(defun gdb-prompt (ignored)
608 "An annotation handler for `prompt'.
609This sends the next command (if any) to gdb."
610 (let ((sink (gdb-get-output-sink)))
611 (cond
612 ((eq sink 'user) t)
613 ((eq sink 'post-emacs)
614 (gdb-set-output-sink 'user))
615 (t
616 (gdb-set-output-sink 'user)
617 (error "Phase error in gdb-prompt (got %s)" sink))))
618 (let ((highest (gdb-dequeue-input)))
619 (if highest
620 (gdb-send-item highest)
621 (let ((lowest (gdb-dequeue-idle-input)))
622 (if lowest
623 (gdb-send-item lowest)
624 (progn
625 (gdb-set-prompting t)
626 (gud-display-frame)))))))
627
628(defun gdb-subprompt (ignored)
629 "An annotation handler for non-top-level prompts."
630 (let ((highest (gdb-dequeue-input)))
631 (if highest
632 (gdb-send-item highest)
633 (gdb-set-prompting t))))
634
635(defun gdb-starting (ignored)
636 "An annotation handler for `starting'. This says that I/O for the
637subprocess is now the program being debugged, not GDB."
638 (let ((sink (gdb-get-output-sink)))
639 (cond
640 ((eq sink 'user)
641 (progn
642 (setq gud-running t)
643 (gdb-set-output-sink 'inferior)))
644 (t (error "Unexpected `starting' annotation")))))
645
646(defun gdb-stopping (ignored)
647 "An annotation handler for `exited' and other annotations which say that I/O
648for the subprocess is now GDB, not the program being debugged."
649 (let ((sink (gdb-get-output-sink)))
650 (cond
651 ((eq sink 'inferior)
652 (gdb-set-output-sink 'user))
653 (t (error "Unexpected stopping annotation")))))
654
655(defun gdb-frame-begin (ignored)
656 (let ((sink (gdb-get-output-sink)))
657 (cond
658 ((eq sink 'inferior)
659 (gdb-set-output-sink 'user))
660 ((eq sink 'user) t)
661 ((eq sink 'emacs) t)
662 (t (error "Unexpected frame-begin annotation (%S)" sink)))))
663
664(defun gdb-stopped (ignored)
665 "An annotation handler for `stopped'. It is just like gdb-stopping, except
666that if we already set the output sink to 'user in gdb-stopping, that is fine."
667 (setq gud-running nil)
668 (let ((sink (gdb-get-output-sink)))
669 (cond
670 ((eq sink 'inferior)
671 (gdb-set-output-sink 'user))
672 ((eq sink 'user) t)
673 (t (error "Unexpected stopped annotation")))))
674
675(defun gdb-post-prompt (ignored)
676 "An annotation handler for `post-prompt'. This begins the collection of
677output from the current command if that happens to be appropriate."
678 (if (not (gdb-get-pending-triggers))
679 (progn
680 (gdb-get-current-frame)
681 (gdb-invalidate-frames)
682 (gdb-invalidate-breakpoints)
683 (gdb-invalidate-assembler)
684 (gdb-invalidate-registers)
685 (gdb-invalidate-locals)
686 (gdb-invalidate-display)
687 (gdb-invalidate-threads)))
688 (let ((sink (gdb-get-output-sink)))
689 (cond
690 ((eq sink 'user) t)
691 ((eq sink 'pre-emacs)
692 (gdb-set-output-sink 'emacs))
693 (t
694 (gdb-set-output-sink 'user)
695 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
696
697;; If we get an error whilst evaluating one of the expressions
698;; we won't get the display-end annotation. Set the sink back to
699;; user to make sure that the error message is seen.
700;; NOT USED: see annotation-rules for reason.
701;(defun gdb-error-begin (ignored)
702; (gdb-set-output-sink 'user))
703
704(defun gdb-display-begin (ignored)
705 (gdb-set-output-sink 'emacs)
706 (gdb-clear-partial-output)
707 (setq gdb-display-in-progress t))
708
709(defvar gdb-expression-buffer-name nil)
710(defvar gdb-display-number nil)
711(defvar gdb-dive-display-number nil)
712
713(defun gdb-display-number-end (ignored)
714 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
715 (setq gdb-display-number (buffer-string))
716 (setq gdb-expression-buffer-name
717 (concat "*display " gdb-display-number "*"))
718 (save-excursion
719 (if (progn
720 (set-buffer (window-buffer))
721 gdb-dive)
722 (progn
723 (let ((number gdb-display-number))
724 (switch-to-buffer
725 (set-buffer (get-buffer-create gdb-expression-buffer-name)))
726 (gdb-expressions-mode)
727 (setq gdb-dive-display-number number)))
728 (set-buffer (get-buffer-create gdb-expression-buffer-name))
729 (if (display-graphic-p)
730 (catch 'frame-exists
731 (dolist (frame (frame-list))
732 (if (string-equal (frame-parameter frame 'name)
733 gdb-expression-buffer-name)
734 (throw 'frame-exists nil)))
735 (gdb-expressions-mode)
736 (make-frame `((height . ,gdb-window-height)
737 (width . ,gdb-window-width)
738 (tool-bar-lines . nil)
739 (menu-bar-lines . nil)
740 (minibuffer . nil))))
741 (gdb-expressions-mode)
742 (gdb-display-buffer (get-buffer gdb-expression-buffer-name)))))
743 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
744 (setq gdb-dive nil))
745
746(defvar gdb-nesting-level nil)
747(defvar gdb-expression nil)
748(defvar gdb-point nil)
749(defvar gdb-annotation-arg nil)
750
751(defun gdb-delete-line ()
752 "Delete the current line."
753 (delete-region (line-beginning-position) (line-beginning-position 2)))
754
755(defun gdb-display-end (ignored)
756 (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer))
757 (goto-char (point-min))
758 (search-forward ": ")
759 (looking-at "\\(.*?\\) =")
760 (let ((char "")
761 (gdb-temp-value (match-string 1)))
762 ;;move * to front of expression if necessary
763 (if (looking-at ".*\\*")
764 (progn
765 (setq char "*")
766 (setq gdb-temp-value (substring gdb-temp-value 1 nil))))
767 (with-current-buffer gdb-expression-buffer-name
768 (setq gdb-expression gdb-temp-value)
769 (if (not (string-match "::" gdb-expression))
770 (setq gdb-expression (concat char gdb-current-frame
771 "::" gdb-expression))
772 ;;else put * back on if necessary
773 (setq gdb-expression (concat char gdb-expression)))
774 (if (not header-line-format)
775 (setq header-line-format (concat "-- " gdb-expression " %-")))))
776 ;;
777 ;;-if scalar/string
778 (if (not (re-search-forward "##" nil t))
779 (progn
780 (with-current-buffer gdb-expression-buffer-name
781 (let ((buffer-read-only nil))
782 (delete-region (point-min) (point-max))
783 (insert-buffer-substring
784 (gdb-get-buffer 'gdb-partial-output-buffer)))))
785 ;; display expression name...
786 (goto-char (point-min))
787 (let ((start (progn (point)))
788 (end (progn (end-of-line) (point))))
789 (with-current-buffer gdb-expression-buffer-name
790 (let ((buffer-read-only nil))
791 (delete-region (point-min) (point-max))
792 (insert-buffer-substring (gdb-get-buffer
793 'gdb-partial-output-buffer)
794 start end)
795 (insert "\n"))))
796 (goto-char (point-min))
797 (re-search-forward "##" nil t)
798 (setq gdb-nesting-level 0)
799 (if (looking-at "array-section-begin")
800 (progn
801 (gdb-delete-line)
802 (setq gdb-point (point))
803 (gdb-array-format)))
804 (if (looking-at "field-begin \\(.\\)")
805 (progn
806 (setq gdb-annotation-arg (match-string 1))
807 (gdb-field-format-begin))))
808 (with-current-buffer gdb-expression-buffer-name
809 (if gdb-dive-display-number
810 (progn
811 (let ((buffer-read-only nil))
812 (goto-char (point-max))
813 (insert "\n")
814 (insert-text-button "[back]" 'type 'gdb-display-back)))))
815 (gdb-clear-partial-output)
816 (gdb-set-output-sink 'user)
817 (setq gdb-display-in-progress nil))
818
819(define-button-type 'gdb-display-back
820 'help-echo (purecopy "mouse-2, RET: go back to previous display buffer")
821 'action (lambda (button) (gdb-display-go-back)))
822
823(defun gdb-display-go-back ()
824 ;; delete display so they don't accumulate and delete buffer
825 (let ((number gdb-display-number))
826 (gdb-enqueue-input
827 (list (concat "server delete display " number "\n") 'ignore))
828 (switch-to-buffer (concat "*display " gdb-dive-display-number "*"))
829 (kill-buffer (get-buffer (concat "*display " number "*")))))
830
831;; prefix annotations with ## and process whole output in one chunk
832;; in gdb-partial-output-buffer (to allow recursion).
833
834;; array-section flags are just removed again but after counting. They
835;; might also be useful for arrays of structures and structures with arrays.
836(defun gdb-array-section-begin (args)
837 (if gdb-display-in-progress
838 (progn
839 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
840 (goto-char (point-max))
841 (insert (concat "\n##array-section-begin " args "\n"))))))
842
843(defun gdb-array-section-end (ignored)
844 (if gdb-display-in-progress
845 (progn
846 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
847 (goto-char (point-max))
848 (insert "\n##array-section-end\n")))))
849
850(defun gdb-field-begin (args)
851 (if gdb-display-in-progress
852 (progn
853 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
854 (goto-char (point-max))
855 (insert (concat "\n##field-begin " args "\n"))))))
856
857(defun gdb-field-end (ignored)
858 (if gdb-display-in-progress
859 (progn
860 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
861 (goto-char (point-max))
862 (insert "\n##field-end\n")))))
863
864(defun gdb-elt (ignored)
865 (if gdb-display-in-progress
866 (progn
867 (goto-char (point-max))
868 (insert "\n##elt\n"))))
869
870(defun gdb-field-format-begin ()
871 ;; get rid of ##field-begin
872 (gdb-delete-line)
873 (gdb-insert-field)
874 (setq gdb-nesting-level (+ gdb-nesting-level 1))
875 (while (re-search-forward "##" nil t)
876 ;; keep making recursive calls...
877 (if (looking-at "field-begin \\(.\\)")
878 (progn
879 (setq gdb-annotation-arg (match-string 1))
880 (gdb-field-format-begin)))
881 ;; until field-end.
882 (if (looking-at "field-end") (gdb-field-format-end))))
883
884(defun gdb-field-format-end ()
885 ;; get rid of ##field-end and `,' or `}'
886 (gdb-delete-line)
887 (gdb-delete-line)
888 (setq gdb-nesting-level (- gdb-nesting-level 1)))
889
890(defvar gdb-dive-map
891 (let ((map (make-sparse-keymap)))
892 (define-key map [mouse-2] 'gdb-dive)
893 (define-key map [S-mouse-2] 'gdb-dive-new-frame)
894 map))
895
896(defun gdb-dive (event)
897 "Dive into structure."
898 (interactive "e")
899 (setq gdb-dive t)
900 (gdb-dive-new-frame event))
901
902(defun gdb-dive-new-frame (event)
903 "Dive into structure and display in a new frame."
904 (interactive "e")
905 (save-excursion
906 (mouse-set-point event)
907 (let ((point (point)) (gdb-full-expression gdb-expression)
908 (end (progn (end-of-line) (point)))
909 (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil))
910 (beginning-of-line)
911 (if (looking-at "\*") (setq gdb-display-char "*"))
912 (re-search-forward "\\(\\S-+\\) = " end t)
913 (setq gdb-last-field (match-string-no-properties 1))
914 (goto-char (match-beginning 1))
915 (let ((last-column (current-column)))
916 (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t)
917 (goto-char (match-beginning 1))
918 (if (and (< (current-column) last-column)
919 (> (count-lines 1 (point)) 1))
920 (progn
921 (setq gdb-part-expression
922 (concat "." (match-string-no-properties 1)
923 gdb-part-expression))
924 (setq last-column (current-column))))))
925 ;; * not needed for components of a pointer to a structure in gdb
926 (if (string-equal "*" (substring gdb-full-expression 0 1))
927 (setq gdb-full-expression (substring gdb-full-expression 1 nil)))
928 (setq gdb-full-expression
929 (concat gdb-full-expression gdb-part-expression "." gdb-last-field))
930 (gdb-enqueue-input
931 (list (concat "server display" gdb-display-char
932 " " gdb-full-expression "\n")
933 'ignore)))))
934
935(defun gdb-insert-field ()
936 (let ((start (progn (point)))
937 (end (progn (next-line) (point)))
938 (num 0))
939 (with-current-buffer gdb-expression-buffer-name
940 (let ((buffer-read-only nil))
941 (if (string-equal gdb-annotation-arg "\*") (insert "\*"))
942 (while (<= num gdb-nesting-level)
943 (insert "\t")
944 (setq num (+ num 1)))
945 (insert-buffer-substring (gdb-get-buffer
946 'gdb-partial-output-buffer)
947 start end)
948 (put-text-property (- (point) (- end start)) (- (point) 1)
949 'mouse-face 'highlight)
950 (put-text-property (- (point) (- end start)) (- (point) 1)
951 'local-map gdb-dive-map)))
952 (delete-region start end)))
953
954(defvar gdb-values nil)
955
956(defun gdb-array-format ()
957 (while (re-search-forward "##" nil t)
958 ;; keep making recursive calls...
959 (if (looking-at "array-section-begin")
960 (progn
961 ;;get rid of ##array-section-begin
962 (gdb-delete-line)
963 (setq gdb-nesting-level (+ gdb-nesting-level 1))
964 (gdb-array-format)))
965 ;;until *matching* array-section-end is found
966 (if (looking-at "array-section-end")
967 (if (eq gdb-nesting-level 0)
968 (progn
969 (let ((values (buffer-substring gdb-point (- (point) 2))))
970 (with-current-buffer gdb-expression-buffer-name
971 (setq gdb-values
972 (concat "{" (replace-regexp-in-string "\n" "" values)
973 "}"))
974 (gdb-array-format1))))
975 ;;else get rid of ##array-section-end etc
976 (gdb-delete-line)
977 (setq gdb-nesting-level (- gdb-nesting-level 1))
978 (gdb-array-format)))))
979
980(defvar gdb-array-start nil)
981(defvar gdb-array-stop nil)
982
983(defvar gdb-array-slice-map
984 (let ((map (make-sparse-keymap)))
985 (define-key map "\r" 'gdb-array-slice)
986 (define-key map [mouse-2] 'gdb-mouse-array-slice)
987 map))
988
989(defun gdb-mouse-array-slice (event)
990 "Select an array slice to display."
991 (interactive "e")
992 (mouse-set-point event)
993 (gdb-array-slice))
994
995(defun gdb-array-slice ()
996 (interactive)
997 (save-excursion
998 (let ((n -1) (stop 0) (start 0) (point (point)))
999 (beginning-of-line)
1000 (while (search-forward "[" point t)
1001 (setq n (+ n 1)))
1002 (setq start (string-to-int (read-string "Start index: ")))
1003 (aset gdb-array-start n start)
1004 (setq stop (string-to-int (read-string "Stop index: ")))
1005 (aset gdb-array-stop n stop)))
1006 (gdb-array-format1))
1007
1008(defvar gdb-display-string nil)
1009(defvar gdb-array-size nil)
1010
1011(defun gdb-array-format1 ()
1012 (setq gdb-display-string "")
1013 (let ((buffer-read-only nil))
1014 (delete-region (point-min) (point-max))
1015 (let ((gdb-value-list (split-string gdb-values ", ")))
1016 (string-match "\\({+\\)" (car gdb-value-list))
1017 (let* ((depth (- (match-end 1) (match-beginning 1)))
1018 (indices (make-vector depth '0))
1019 (index 0) (num 0) (array-start "")
1020 (array-stop "") (array-slice "") (array-range nil)
1021 (flag t) (indices-string ""))
1022 (dolist (gdb-value gdb-value-list)
1023 (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value)
1024 (setq num 0)
1025 (while (< num depth)
1026 (setq indices-string
1027 (concat indices-string
1028 "[" (int-to-string (aref indices num)) "]"))
1029 (if (not (= (aref gdb-array-start num) -1))
1030 (if (or (< (aref indices num) (aref gdb-array-start num))
1031 (> (aref indices num) (aref gdb-array-stop num)))
1032 (setq flag nil))
1033 (aset gdb-array-size num (aref indices num)))
1034 (setq num (+ num 1)))
1035 (if flag
1036 (let ((gdb-display-value (match-string 1 gdb-value)))
1037 (setq gdb-display-string (concat gdb-display-string " "
1038 gdb-display-value))
1039 (insert
1040 (concat indices-string "\t" gdb-display-value "\n"))))
1041 (setq indices-string "")
1042 (setq flag t)
1043 ;; 0<= index < depth, start at right : (- depth 1)
1044 (setq index (- (- depth 1)
1045 (- (match-end 2) (match-beginning 2))))
1046 ;;don't set for very last brackets
1047 (when (>= index 0)
1048 (aset indices index (+ 1 (aref indices index)))
1049 (setq num (+ 1 index))
1050 (while (< num depth)
1051 (aset indices num 0)
1052 (setq num (+ num 1)))))
1053 (setq num 0)
1054 (while (< num depth)
1055 (if (= (aref gdb-array-start num) -1)
1056 (progn
1057 (aset gdb-array-start num 0)
1058 (aset gdb-array-stop num (aref indices num))))
1059 (setq array-start (int-to-string (aref gdb-array-start num)))
1060 (setq array-stop (int-to-string (aref gdb-array-stop num)))
1061 (setq array-range (concat "[" array-start
1062 ":" array-stop "]"))
1063 (put-text-property 1 (+ (length array-start)
1064 (length array-stop) 2)
1065 'mouse-face 'highlight array-range)
1066 (put-text-property 1 (+ (length array-start)
1067 (length array-stop) 2)
1068 'local-map gdb-array-slice-map array-range)
1069 (goto-char (point-min))
1070 (setq array-slice (concat array-slice array-range))
1071 (setq num (+ num 1)))
1072 (goto-char (point-min))
1073 (insert "Array Size : ")
1074 (setq num 0)
1075 (while (< num depth)
1076 (insert
1077 (concat "["
1078 (int-to-string (+ (aref gdb-array-size num) 1)) "]"))
1079 (setq num (+ num 1)))
1080 (insert
1081 (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n"))))))
1082
1083(defun gud-gdba-marker-filter (string)
1084 "A gud marker filter for gdb. Handle a burst of output from GDB."
1085 (let (
1086 ;; Recall the left over burst from last time
1087 (burst (concat (gdb-get-burst) string))
1088 ;; Start accumulating output for the GUD buffer
1089 (output ""))
1090 ;;
1091 ;; Process all the complete markers in this chunk.
1092 (while (string-match "\n\032\032\\(.*\\)\n" burst)
1093 (let ((annotation (match-string 1 burst)))
1094 ;;
1095 ;; Stuff prior to the match is just ordinary output.
1096 ;; It is either concatenated to OUTPUT or directed
1097 ;; elsewhere.
1098 (setq output
1099 (gdb-concat-output
1100 output
1101 (substring burst 0 (match-beginning 0))))
1102
1103 ;; Take that stuff off the burst.
1104 (setq burst (substring burst (match-end 0)))
1105
1106 ;; Parse the tag from the annotation, and maybe its arguments.
1107 (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation)
1108 (let* ((annotation-type (match-string 1 annotation))
1109 (annotation-arguments (match-string 2 annotation))
1110 (annotation-rule (assoc annotation-type
1111 gdb-annotation-rules)))
1112 ;; Call the handler for this annotation.
1113 (if annotation-rule
1114 (funcall (car (cdr annotation-rule))
1115 annotation-arguments)
1116 ;; Else the annotation is not recognized. Ignore it silently,
1117 ;; so that GDB can add new annotations without causing
1118 ;; us to blow up.
1119 ))))
1120 ;;
1121 ;; Does the remaining text end in a partial line?
1122 ;; If it does, then keep part of the burst until we get more.
1123 (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'"
1124 burst)
1125 (progn
1126 ;; Everything before the potential marker start can be output.
1127 (setq output
1128 (gdb-concat-output output
1129 (substring burst 0 (match-beginning 0))))
1130 ;;
1131 ;; Everything after, we save, to combine with later input.
1132 (setq burst (substring burst (match-beginning 0))))
1133 ;;
1134 ;; In case we know the burst contains no partial annotations:
1135 (progn
1136 (setq output (gdb-concat-output output burst))
1137 (setq burst "")))
1138 ;;
1139 ;; Save the remaining burst for the next call to this function.
1140 (gdb-set-burst burst)
1141 output))
1142
1143(defun gdb-concat-output (so-far new)
1144 (let ((sink (gdb-get-output-sink )))
1145 (cond
1146 ((eq sink 'user) (concat so-far new))
1147 ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far)
1148 ((eq sink 'emacs)
1149 (gdb-append-to-partial-output new)
1150 so-far)
1151 ((eq sink 'inferior)
1152 (gdb-append-to-inferior-io new)
1153 so-far)
1154 (t (error "Bogon output sink %S" sink)))))
1155
1156(defun gdb-append-to-partial-output (string)
1157 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1158 (goto-char (point-max))
1159 (insert string)))
1160
1161(defun gdb-clear-partial-output ()
1162 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
1163 (delete-region (point-min) (point-max))))
1164
1165(defun gdb-append-to-inferior-io (string)
1166 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
1167 (goto-char (point-max))
1168 (insert-before-markers string))
1169 (if (not (string-equal string ""))
1170 (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io))))
1171
1172(defun gdb-clear-inferior-io ()
1173 (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io)
1174 (delete-region (point-min) (point-max))))
1175
1176
1177;; One trick is to have a command who's output is always available in a buffer
1178;; of it's own, and is always up to date. We build several buffers of this
1179;; type.
1180;;
1181;; There are two aspects to this: gdb has to tell us when the output for that
1182;; command might have changed, and we have to be able to run the command
1183;; behind the user's back.
1184;;
1185;; The idle input queue and the output phasing associated with the variable
1186;; gdb-output-sink help us to run commands behind the user's back.
1187;;
1188;; Below is the code for specificly managing buffers of output from one
1189;; command.
1190;;
1191
1192;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES
1193;; It adds an idle input for the command we are tracking. It should be the
1194;; annotation rule binding of whatever gdb sends to tell us this command
1195;; might have changed it's output.
1196;;
1197;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1198;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the
1199;; input in the input queue (see comment about ``gdb communications'' above).
1200
1201(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1202 output-handler)
1203 `(defun ,name (&optional ignored)
1204 (if (and (,demand-predicate)
1205 (not (member ',name
1206 (gdb-get-pending-triggers))))
1207 (progn
1208 (gdb-enqueue-idle-input
1209 (list ,gdb-command ',output-handler))
1210 (gdb-set-pending-triggers
1211 (cons ',name
1212 (gdb-get-pending-triggers)))))))
1213
1214(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1215 `(defun ,name ()
1216 (gdb-set-pending-triggers
1217 (delq ',trigger
1218 (gdb-get-pending-triggers)))
1219 (let ((buf (gdb-get-buffer ',buf-key)))
1220 (and buf
1221 (with-current-buffer buf
1222 (let ((p (point))
1223 (buffer-read-only nil))
1224 (delete-region (point-min) (point-max))
1225 (insert-buffer-substring (gdb-get-create-buffer
1226 'gdb-partial-output-buffer))
1227 (goto-char p)))))
1228 ;; put customisation here
1229 (,custom-defun)))
1230
1231(defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command
1232 output-handler-name custom-defun)
1233 `(progn
1234 (def-gdb-auto-update-trigger ,trigger-name
1235 ;; The demand predicate:
1236 (lambda () (gdb-get-buffer ',buffer-key))
1237 ,gdb-command
1238 ,output-handler-name)
1239 (def-gdb-auto-update-handler ,output-handler-name
1240 ,trigger-name ,buffer-key ,custom-defun)))
1241
1242
1243;;
1244;; Breakpoint buffer : This displays the output of `info breakpoints'.
1245;;
1246(gdb-set-buffer-rules 'gdb-breakpoints-buffer
1247 'gdb-breakpoints-buffer-name
1248 'gdb-breakpoints-mode)
1249
1250(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1251 ;; This defines the auto update rule for buffers of type
1252 ;; `gdb-breakpoints-buffer'.
1253 ;;
1254 ;; It defines a function to serve as the annotation handler that
1255 ;; handles the `foo-invalidated' message. That function is called:
1256 gdb-invalidate-breakpoints
1257 ;;
1258 ;; To update the buffer, this command is sent to gdb.
1259 "server info breakpoints\n"
1260 ;;
1261 ;; This also defines a function to be the handler for the output
1262 ;; from the command above. That function will copy the output into
1263 ;; the appropriately typed buffer. That function will be called:
1264 gdb-info-breakpoints-handler
1265 ;; buffer specific functions
1266 gdb-info-breakpoints-custom)
1267
1268(defvar gdb-cdir nil "Compilation directory.")
1269
1270(defconst breakpoint-xpm-data "/* XPM */
1271static char *magick[] = {
1272/* columns rows colors chars-per-pixel */
1273\"12 12 2 1\",
1274\" c red\",
1275\"+ c None\",
1276/* pixels */
1277\"++++++++++++\",
1278\"+++ +++\",
1279\"++ ++\",
1280\"+ +\",
1281\"+ +\",
1282\"+ +\",
1283\"+ +\",
1284\"+ +\",
1285\"+ +\",
1286\"++ ++\",
1287\"+++ +++\",
1288\"++++++++++++\"
1289};"
1290 "XPM data used for breakpoint icon.")
1291
1292(defconst breakpoint-enabled-pbm-data
1293"P1
129412 12\",
12950 0 0 0 0 0 0 0 0 0 0 0
12960 0 0 1 1 1 1 1 1 0 0 0
12970 0 1 1 1 1 1 1 1 1 0 0
12980 1 1 1 1 1 1 1 1 1 1 0
12990 1 1 1 1 1 1 1 1 1 1 0
13000 1 1 1 1 1 1 1 1 1 1 0
13010 1 1 1 1 1 1 1 1 1 1 0
13020 1 1 1 1 1 1 1 1 1 1 0
13030 1 1 1 1 1 1 1 1 1 1 0
13040 0 1 1 1 1 1 1 1 1 0 0
13050 0 0 1 1 1 1 1 1 0 0 0
13060 0 0 0 0 0 0 0 0 0 0 0"
1307 "PBM data used for enabled breakpoint icon.")
1308
1309(defconst breakpoint-disabled-pbm-data
1310"P1
131112 12\",
13120 0 0 0 0 0 0 0 0 0 0 0
13130 0 0 1 0 1 0 1 0 0 0 0
13140 0 1 0 1 0 1 0 1 0 0 0
13150 1 0 1 0 1 0 1 0 1 0 0
13160 0 1 0 1 0 1 0 1 0 1 0
13170 1 0 1 0 1 0 1 0 1 0 0
13180 0 1 0 1 0 1 0 1 0 1 0
13190 1 0 1 0 1 0 1 0 1 0 0
13200 0 1 0 1 0 1 0 1 0 1 0
13210 0 0 1 0 1 0 1 0 1 0 0
13220 0 0 0 1 0 1 0 1 0 0 0
13230 0 0 0 0 0 0 0 0 0 0 0"
1324 "PBM data used for disabled breakpoint icon.")
1325
1326(defvar breakpoint-enabled-icon
1327 (find-image `((:type xpm :data ,breakpoint-xpm-data)
1328 (:type pbm :data ,breakpoint-enabled-pbm-data)))
1329 "Icon for enabled breakpoint in display margin")
1330
1331(defvar breakpoint-disabled-icon
1332 (find-image `((:type xpm :data ,breakpoint-xpm-data :conversion disabled)
1333 (:type pbm :data ,breakpoint-disabled-pbm-data)))
1334 "Icon for disabled breakpoint in display margin")
1335
1336;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
1337(defun gdb-info-breakpoints-custom ()
1338 (let ((flag)(address))
1339 ;;
1340 ;; remove all breakpoint-icons in source buffers but not assembler buffer
1341 (dolist (buffer (buffer-list))
1342 (with-current-buffer buffer
1343 (if (and (eq gud-minor-mode 'gdba)
1344 (not (string-match "^\*" (buffer-name))))
1345 (if (eq window-system 'x)
1346 (remove-images (point-min) (point-max))
1347 (gdb-remove-strings (point-min) (point-max))))))
1348 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1349 (save-excursion
1350 (goto-char (point-min))
1351 (while (< (point) (- (point-max) 1))
1352 (forward-line 1)
1353 (if (looking-at "[^\t].*breakpoint")
1354 (progn
1355 (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)")
1356 (setq flag (char-after (match-beginning 1)))
1357 (beginning-of-line)
1358 (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1359 (progn
1360 (looking-at "\\(\\S-*\\):\\([0-9]+\\)")
1361 (let ((line (match-string 2)) (buffer-read-only nil)
1362 (file (match-string 1)))
1363 (put-text-property (progn (beginning-of-line) (point))
1364 (progn (end-of-line) (point))
1365 'mouse-face 'highlight)
1366 (with-current-buffer
1367 (find-file-noselect
1368 (if (file-exists-p file) file
1369 (expand-file-name file gdb-cdir)))
1370 (save-current-buffer
1371 (set (make-local-variable 'gud-minor-mode) 'gdba)
1372 (set (make-local-variable 'tool-bar-map)
1373 gud-tool-bar-map)
1374 (setq left-margin-width 2)
1375 (if (get-buffer-window (current-buffer))
1376 (set-window-margins (get-buffer-window
1377 (current-buffer))
1378 left-margin-width
1379 right-margin-width)))
1380 ;; only want one breakpoint icon at each location
1381 (save-excursion
1382 (goto-line (string-to-number line))
1383 (let ((start (progn (beginning-of-line)
1384 (- (point) 1)))
1385 (end (progn (end-of-line) (+ (point) 1))))
1386 (if (eq window-system 'x)
1387 (progn
1388 (remove-images start end)
1389 (if (eq ?y flag)
1390 (put-image breakpoint-enabled-icon
1391 (+ start 1)
1392 "breakpoint icon enabled"
1393 'left-margin)
1394 (put-image breakpoint-disabled-icon
1395 (+ start 1)
1396 "breakpoint icon disabled"
1397 'left-margin)))
1398 (gdb-remove-strings start end)
1399 (if (eq ?y flag)
1400 (gdb-put-string "B" (+ start 1))
1401 (gdb-put-string "b" (+ start 1))))))))))))
1402 (end-of-line))))))
1403
1404(defun gdb-breakpoints-buffer-name ()
1405 (with-current-buffer gud-comint-buffer
1406 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1407
1408(defun gdb-display-breakpoints-buffer ()
1409 (interactive)
1410 (gdb-display-buffer
1411 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1412
1413(defun gdb-frame-breakpoints-buffer ()
1414 (interactive)
1415 (switch-to-buffer-other-frame
1416 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
1417
1418(defvar gdb-breakpoints-mode-map
1419 (let ((map (make-sparse-keymap))
1420 (menu (make-sparse-keymap "Breakpoints")))
1421 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
1422 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1423 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1424
1425 (suppress-keymap map)
1426 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1427 (define-key map " " 'gdb-toggle-breakpoint)
1428 (define-key map "d" 'gdb-delete-breakpoint)
1429 (define-key map "\r" 'gdb-goto-breakpoint)
1430 (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint)
1431 map))
1432
1433(defun gdb-breakpoints-mode ()
1434 "Major mode for gdb breakpoints.
1435
1436\\{gdb-breakpoints-mode-map}"
1437 (setq major-mode 'gdb-breakpoints-mode)
1438 (setq mode-name "Breakpoints")
1439 (use-local-map gdb-breakpoints-mode-map)
1440 (setq buffer-read-only t)
1441 (gdb-invalidate-breakpoints))
1442
1443(defun gdb-toggle-breakpoint ()
1444 "Enable/disable the breakpoint at current line."
1445 (interactive)
1446 (save-excursion
1447 (beginning-of-line 1)
1448 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1449 (error "Not recognized as break/watchpoint line")
1450 (gdb-enqueue-input
1451 (list
1452 (concat
1453 (if (eq ?y (char-after (match-beginning 2)))
1454 "server disable "
1455 "server enable ")
1456 (match-string 1) "\n")
1457 'ignore)))))
1458
1459(defun gdb-delete-breakpoint ()
1460 "Delete the breakpoint at current line."
1461 (interactive)
1462 (beginning-of-line 1)
1463 (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)"))
1464 (error "Not recognized as break/watchpoint line")
1465 (gdb-enqueue-input
1466 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1467
1468(defvar gdb-source-window nil)
1469
1470(defun gdb-goto-breakpoint ()
1471 "Display the file in the source buffer at the breakpoint specified on the
1472current line."
1473 (interactive)
1474 (save-excursion
1475 (beginning-of-line 1)
1476 (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t)
1477 (looking-at "\\(\\S-*\\):\\([0-9]+\\)"))
1478 (if (match-string 2)
1479 (let ((line (match-string 2))
1480 (file (match-string 1)))
1481 (save-selected-window
1482 (select-window gdb-source-window)
1483 (switch-to-buffer (find-file-noselect
1484 (if (file-exists-p file)
1485 file
1486 (expand-file-name file gdb-cdir))))
1487 (goto-line (string-to-number line))))))
1488;; I'll get this to work one day!
1489;; (defun gdb-goto-breakpoint ()
1490;; "Display the file in the source buffer at the breakpoint specified on the
1491;; current line."
1492;; (interactive)
1493;; (save-excursion
1494;; (let ((eol (progn (end-of-line) (point))))
1495;; (beginning-of-line 1)
1496;; (if (re-search-forward "\\(\\S-*\\):\\([0-9]+\\)" eol t)
1497;; (let ((line (match-string 2))
1498;; (file (match-string 1)))
1499;; (save-selected-window
1500;; (select-window gdb-source-window)
1501;; (switch-to-buffer (find-file-noselect
1502;; (if (file-exists-p file)
1503;; file
1504;; (expand-file-name file gdb-cdir))))
1505;; (goto-line (string-to-number line))))))
1506;; (let ((eol (progn (end-of-line) (point))))
1507;; (beginning-of-line 1)
1508;; (if (re-search-forward "<\\(\\S-*?\\)\\(\\+*[0-9]*\\)>" eol t)
1509;; (save-selected-window
1510;; (select-window gdb-source-window)
1511;; (gdb-get-create-buffer 'gdb-assembler-buffer)
1512;; (gdb-enqueue-input
1513;; (list (concat "server disassemble " (match-string 1) "\n")
1514;; 'gdb-assembler-handler))
1515;; (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
1516;; (re-search-forward
1517;; (concat (match-string 1) (match-string 2)))))))))
1518
1519(defun gdb-mouse-goto-breakpoint (event)
1520 "Display the file in the source buffer at the selected breakpoint."
1521 (interactive "e")
1522 (mouse-set-point event)
1523 (gdb-goto-breakpoint))
1524
1525;;
1526;; Frames buffer. This displays a perpetually correct bactracktrace
1527;; (from the command `where').
1528;;
1529;; Alas, if your stack is deep, it is costly.
1530;;
1531(gdb-set-buffer-rules 'gdb-stack-buffer
1532 'gdb-stack-buffer-name
1533 'gdb-frames-mode)
1534
1535(def-gdb-auto-updated-buffer gdb-stack-buffer
1536 gdb-invalidate-frames
1537 "server where\n"
1538 gdb-info-frames-handler
1539 gdb-info-frames-custom)
1540
1541(defun gdb-info-frames-custom ()
1542 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
1543 (save-excursion
1544 (let ((buffer-read-only nil))
1545 (goto-char (point-min))
1546 (while (< (point) (point-max))
1547 (put-text-property (progn (beginning-of-line) (point))
1548 (progn (end-of-line) (point))
1549 'mouse-face 'highlight)
1550 (beginning-of-line)
1551 (if (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
1552 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
1553 (if (equal (match-string 1) gdb-current-frame)
1554 (put-text-property (progn (beginning-of-line) (point))
1555 (progn (end-of-line) (point))
1556 'face
1557 `(:background ,(face-attribute 'default :foreground)
1558 :foreground ,(face-attribute 'default :background)))))
1559 (forward-line 1))))))
1560
1561(defun gdb-stack-buffer-name ()
1562 (with-current-buffer gud-comint-buffer
1563 (concat "*stack frames of " (gdb-get-target-string) "*")))
1564
1565(defun gdb-display-stack-buffer ()
1566 (interactive)
1567 (gdb-display-buffer
1568 (gdb-get-create-buffer 'gdb-stack-buffer)))
1569
1570(defun gdb-frame-stack-buffer ()
1571 (interactive)
1572 (switch-to-buffer-other-frame
1573 (gdb-get-create-buffer 'gdb-stack-buffer)))
1574
1575(defvar gdb-frames-mode-map
1576 (let ((map (make-sparse-keymap)))
1577 (suppress-keymap map)
1578 (define-key map "\r" 'gdb-frames-select)
1579 (define-key map [mouse-2] 'gdb-frames-mouse-select)
1580 map))
1581
1582(defun gdb-frames-mode ()
1583 "Major mode for gdb frames.
1584
1585\\{gdb-frames-mode-map}"
1586 (setq major-mode 'gdb-frames-mode)
1587 (setq mode-name "Frames")
1588 (setq buffer-read-only t)
1589 (use-local-map gdb-frames-mode-map)
1590 (font-lock-mode -1)
1591 (gdb-invalidate-frames))
1592
1593(defun gdb-get-frame-number ()
1594 (save-excursion
1595 (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t))
1596 (n (or (and pos (match-string-no-properties 1)) "0")))
1597 n)))
1598
1599(defun gdb-frames-select ()
1600 "Make the frame on the current line become the current frame and display the
1601source in the source buffer."
1602 (interactive)
1603 (gdb-enqueue-input
1604 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1605 (gud-display-frame))
1606
1607(defun gdb-frames-mouse-select (event)
1608 "Make the selected frame become the current frame and display the source in
1609the source buffer."
1610 (interactive "e")
1611 (mouse-set-point event)
1612 (gdb-frames-select))
1613
1614;;
1615;; Threads buffer. This displays a selectable thread list.
1616;;
1617(gdb-set-buffer-rules 'gdb-threads-buffer
1618 'gdb-threads-buffer-name
1619 'gdb-threads-mode)
1620
1621(def-gdb-auto-updated-buffer gdb-threads-buffer
1622 gdb-invalidate-threads
1623 "info threads\n"
1624 gdb-info-threads-handler
1625 gdb-info-threads-custom)
1626
1627(defun gdb-info-threads-custom ()
1628 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
1629 (let ((buffer-read-only nil))
1630 (goto-char (point-min))
1631 (while (< (point) (point-max))
1632 (put-text-property (progn (beginning-of-line) (point))
1633 (progn (end-of-line) (point))
1634 'mouse-face 'highlight)
1635 (forward-line 1)))))
1636
1637(defun gdb-threads-buffer-name ()
1638 (with-current-buffer gud-comint-buffer
1639 (concat "*threads of " (gdb-get-target-string) "*")))
1640
1641(defun gdb-display-threads-buffer ()
1642 (interactive)
1643 (gdb-display-buffer
1644 (gdb-get-create-buffer 'gdb-threads-buffer)))
1645
1646(defun gdb-frame-threads-buffer ()
1647 (interactive)
1648 (switch-to-buffer-other-frame
1649 (gdb-get-create-buffer 'gdb-threads-buffer)))
1650
1651(defvar gdb-threads-mode-map
1652 (let ((map (make-sparse-keymap)))
1653 (suppress-keymap map)
1654 (define-key map "\r" 'gdb-threads-select)
1655 (define-key map [mouse-2] 'gdb-threads-mouse-select)
1656 map))
1657
1658(defun gdb-threads-mode ()
1659 "Major mode for gdb frames.
1660
1661\\{gdb-frames-mode-map}"
1662 (setq major-mode 'gdb-threads-mode)
1663 (setq mode-name "Threads")
1664 (setq buffer-read-only t)
1665 (use-local-map gdb-threads-mode-map)
1666 (gdb-invalidate-threads))
1667
1668(defun gdb-get-thread-number ()
1669 (save-excursion
1670 (re-search-backward "^\\s-*\\([0-9]*\\)" nil t)
1671 (match-string-no-properties 1)))
1672
1673
1674(defun gdb-threads-select ()
1675 "Make the thread on the current line become the current thread and display the
1676source in the source buffer."
1677 (interactive)
1678 (gdb-enqueue-input
1679 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1680 (gud-display-frame))
1681
1682(defun gdb-threads-mouse-select (event)
1683 "Make the selected frame become the current frame and display the source in
1684the source buffer."
1685 (interactive "e")
1686 (mouse-set-point event)
1687 (gdb-threads-select))
1688
1689;;
1690;; Registers buffer.
1691;;
1692(gdb-set-buffer-rules 'gdb-registers-buffer
1693 'gdb-registers-buffer-name
1694 'gdb-registers-mode)
1695
1696(def-gdb-auto-updated-buffer gdb-registers-buffer
1697 gdb-invalidate-registers
1698 "server info registers\n"
1699 gdb-info-registers-handler
1700 gdb-info-registers-custom)
1701
1702(defun gdb-info-registers-custom ())
1703
1704(defvar gdb-registers-mode-map
1705 (let ((map (make-sparse-keymap)))
1706 (suppress-keymap map)
1707 map))
1708
1709(defun gdb-registers-mode ()
1710 "Major mode for gdb registers.
1711
1712\\{gdb-registers-mode-map}"
1713 (setq major-mode 'gdb-registers-mode)
1714 (setq mode-name "Registers")
1715 (setq buffer-read-only t)
1716 (use-local-map gdb-registers-mode-map)
1717 (gdb-invalidate-registers))
1718
1719(defun gdb-registers-buffer-name ()
1720 (with-current-buffer gud-comint-buffer
1721 (concat "*registers of " (gdb-get-target-string) "*")))
1722
1723(defun gdb-display-registers-buffer ()
1724 (interactive)
1725 (gdb-display-buffer
1726 (gdb-get-create-buffer 'gdb-registers-buffer)))
1727
1728(defun gdb-frame-registers-buffer ()
1729 (interactive)
1730 (switch-to-buffer-other-frame
1731 (gdb-get-create-buffer 'gdb-registers-buffer)))
1732
1733;;
1734;; Locals buffer.
1735;;
1736(gdb-set-buffer-rules 'gdb-locals-buffer
1737 'gdb-locals-buffer-name
1738 'gdb-locals-mode)
1739
1740(def-gdb-auto-updated-buffer gdb-locals-buffer
1741 gdb-invalidate-locals
1742 "server info locals\n"
1743 gdb-info-locals-handler
1744 gdb-info-locals-custom)
1745
1746;; Abbreviate for arrays and structures.
1747;; These can be expanded using gud-display.
1748(defun gdb-info-locals-handler nil
1749 (gdb-set-pending-triggers (delq 'gdb-invalidate-locals
1750 (gdb-get-pending-triggers)))
1751 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1752 (with-current-buffer buf
1753 (goto-char (point-min))
1754 (while (re-search-forward "^ .*\n" nil t)
1755 (replace-match "" nil nil))
1756 (goto-char (point-min))
1757 (while (re-search-forward "{[-0-9, {}\]*\n" nil t)
1758 (replace-match "(array);\n" nil nil))
1759 (goto-char (point-min))
1760 (while (re-search-forward "{.*=.*\n" nil t)
1761 (replace-match "(structure);\n" nil nil))))
1762 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1763 (and buf (with-current-buffer buf
1764 (let ((p (point))
1765 (buffer-read-only nil))
1766 (delete-region (point-min) (point-max))
1767 (insert-buffer-substring (gdb-get-create-buffer
1768 'gdb-partial-output-buffer))
1769 (goto-char p)))))
1770 (run-hooks 'gdb-info-locals-hook))
1771
1772(defun gdb-info-locals-custom ()
1773 nil)
1774
1775(defvar gdb-locals-mode-map
1776 (let ((map (make-sparse-keymap)))
1777 (suppress-keymap map)
1778 map))
1779
1780(defun gdb-locals-mode ()
1781 "Major mode for gdb locals.
1782
1783\\{gdb-locals-mode-map}"
1784 (setq major-mode 'gdb-locals-mode)
1785 (setq mode-name "Locals")
1786 (setq buffer-read-only t)
1787 (use-local-map gdb-locals-mode-map)
1788 (gdb-invalidate-locals))
1789
1790(defun gdb-locals-buffer-name ()
1791 (with-current-buffer gud-comint-buffer
1792 (concat "*locals of " (gdb-get-target-string) "*")))
1793
1794(defun gdb-display-locals-buffer ()
1795 (interactive)
1796 (gdb-display-buffer
1797 (gdb-get-create-buffer 'gdb-locals-buffer)))
1798
1799(defun gdb-frame-locals-buffer ()
1800 (interactive)
1801 (switch-to-buffer-other-frame
1802 (gdb-get-create-buffer 'gdb-locals-buffer)))
1803
1804;;
1805;; Display expression buffer.
1806;;
1807(gdb-set-buffer-rules 'gdb-display-buffer
1808 'gdb-display-buffer-name
1809 'gdb-display-mode)
1810
1811(def-gdb-auto-updated-buffer gdb-display-buffer
1812 ;; `gdb-display-buffer'.
1813 gdb-invalidate-display
1814 "server info display\n"
1815 gdb-info-display-handler
1816 gdb-info-display-custom)
1817
1818(defun gdb-info-display-custom ()
1819 (let ((display-list nil))
1820 (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
1821 (goto-char (point-min))
1822 (while (< (point) (- (point-max) 1))
1823 (forward-line 1)
1824 (if (looking-at "\\([0-9]+\\): \\([ny]\\)")
1825 (setq display-list
1826 (cons (string-to-int (match-string 1)) display-list)))
1827 (end-of-line)))
1828 (if (not (display-graphic-p))
1829 (progn
1830 (dolist (buffer (buffer-list))
1831 (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer))
1832 (progn
1833 (let ((number
1834 (match-string 1 (buffer-name buffer))))
1835 (if (not (memq (string-to-int number) display-list))
1836 (kill-buffer
1837 (get-buffer (concat "*display " number "*")))))))))
1838 (gdb-delete-frames display-list))))
1839
1840(defun gdb-delete-frames (display-list)
1841 (dolist (frame (frame-list))
1842 (let ((frame-name (frame-parameter frame 'name)))
1843 (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name)
1844 (progn
1845 (let ((number (match-string 1 frame-name)))
1846 (if (not (memq (string-to-int number) display-list))
1847 (progn (kill-buffer
1848 (get-buffer (concat "*display " number "*")))
1849 (delete-frame frame)))))))))
1850
1851(defvar gdb-display-mode-map
1852 (let ((map (make-sparse-keymap))
1853 (menu (make-sparse-keymap "Display")))
1854 (define-key menu [toggle] '("Toggle" . gdb-toggle-display))
1855 (define-key menu [delete] '("Delete" . gdb-delete-display))
1856
1857 (suppress-keymap map)
1858 (define-key map [menu-bar display] (cons "Display" menu))
1859 (define-key map " " 'gdb-toggle-display)
1860 (define-key map "d" 'gdb-delete-display)
1861 map))
1862
1863(defun gdb-display-mode ()
1864 "Major mode for gdb display.
1865
1866\\{gdb-display-mode-map}"
1867 (setq major-mode 'gdb-display-mode)
1868 (setq mode-name "Display")
1869 (setq buffer-read-only t)
1870 (use-local-map gdb-display-mode-map)
1871 (gdb-invalidate-display))
1872
1873(defun gdb-display-buffer-name ()
1874 (with-current-buffer gud-comint-buffer
1875 (concat "*Displayed expressions of " (gdb-get-target-string) "*")))
1876
1877(defun gdb-display-display-buffer ()
1878 (interactive)
1879 (gdb-display-buffer
1880 (gdb-get-create-buffer 'gdb-display-buffer)))
1881
1882(defun gdb-frame-display-buffer ()
1883 (interactive)
1884 (switch-to-buffer-other-frame
1885 (gdb-get-create-buffer 'gdb-display-buffer)))
1886
1887(defun gdb-toggle-display ()
1888 "Enable/disable the displayed expression at current line."
1889 (interactive)
1890 (save-excursion
1891 (beginning-of-line 1)
1892 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1893 (error "No expression on this line")
1894 (gdb-enqueue-input
1895 (list
1896 (concat
1897 (if (eq ?y (char-after (match-beginning 2)))
1898 "server disable display "
1899 "server enable display ")
1900 (match-string 1) "\n")
1901 'ignore)))))
1902
1903(defun gdb-delete-display ()
1904 "Delete the displayed expression at current line."
1905 (interactive)
1906 (with-current-buffer (gdb-get-buffer 'gdb-display-buffer)
1907 (beginning-of-line 1)
1908 (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)"))
1909 (error "No expression on this line")
1910 (let ((number (match-string 1)))
1911 (gdb-enqueue-input
1912 (list (concat "server delete display " number "\n") 'ignore))))))
1913
1914(defvar gdb-expressions-mode-map
1915 (let ((map (make-sparse-keymap)))
1916 (suppress-keymap map)
1917 (define-key map "v" 'gdb-array-visualise)
1918 (define-key map "q" 'gdb-delete-expression)
1919 (define-key map [mouse-3] 'gdb-expressions-popup-menu)
1920 map))
1921
1922(defvar gdb-expressions-mode-menu
1923 '("GDB Expressions Commands"
1924 "----"
1925 ["Visualise" gdb-array-visualise t]
1926 ["Delete" gdb-delete-expression t])
1927 "Menu for `gdb-expressions-mode'.")
1928
1929(defun gdb-expressions-popup-menu (event)
1930 "Explicit Popup menu as this buffer doesn't have a menubar."
1931 (interactive "@e")
1932 (mouse-set-point event)
1933 (popup-menu gdb-expressions-mode-menu))
1934
1935(defun gdb-expressions-mode ()
1936 "Major mode for display expressions.
1937
1938\\{gdb-expressions-mode-map}"
1939 (setq major-mode 'gdb-expressions-mode)
1940 (setq mode-name "Expressions")
1941 (use-local-map gdb-expressions-mode-map)
1942 (make-local-variable 'gdb-display-number)
1943 (make-local-variable 'gdb-values)
1944 (make-local-variable 'gdb-expression)
1945 (set (make-local-variable 'gdb-display-string) nil)
1946 (set (make-local-variable 'gdb-dive-display-number) nil)
1947 (set (make-local-variable 'gud-minor-mode) 'gdba)
1948 (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1))
1949 (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1))
1950 (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1))
1951 (setq buffer-read-only t))
1952
1953
1954;;;; Window management
1955
1956;;; The way we abuse the dedicated-p flag is pretty gross, but seems
1957;;; to do the right thing. Seeing as there is no way for Lisp code to
1958;;; get at the use_time field of a window, I'm not sure there exists a
1959;;; more elegant solution without writing C code.
1960
1961(defun gdb-display-buffer (buf &optional size)
1962 (let ((must-split nil)
1963 (answer nil))
1964 (unwind-protect
1965 (progn
1966 (walk-windows
1967 '(lambda (win)
1968 (if (or (eq gud-comint-buffer (window-buffer win))
1969 (eq gdb-source-window win))
1970 (set-window-dedicated-p win t))))
1971 (setq answer (get-buffer-window buf))
1972 (if (not answer)
1973 (let ((window (get-lru-window)))
1974 (if window
1975 (progn
1976 (set-window-buffer window buf)
1977 (setq answer window))
1978 (setq must-split t)))))
1979 (walk-windows
1980 '(lambda (win)
1981 (if (or (eq gud-comint-buffer (window-buffer win))
1982 (eq gdb-source-window win))
1983 (set-window-dedicated-p win nil)))))
1984 (if must-split
1985 (let* ((largest (get-largest-window))
1986 (cur-size (window-height largest))
1987 (new-size (and size (< size cur-size) (- cur-size size))))
1988 (setq answer (split-window largest new-size))
1989 (set-window-buffer answer buf)))
1990 answer))
1991
1992(defun gdb-display-source-buffer (buffer)
1993 (if (eq gdb-selected-view 'source)
1994 (set-window-buffer gdb-source-window buffer)
1995 (set-window-buffer gdb-source-window
1996 (gdb-get-buffer 'gdb-assembler-buffer)))
1997 gdb-source-window)
1998
1999
2000;;; Shared keymap initialization:
2001
2002(let ((menu (make-sparse-keymap "GDB-Frames")))
2003 (define-key gud-menu-map [frames]
2004 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
2005 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
2006 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
2007 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2008 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
2009 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
2010 (define-key menu [display] '("Display" . gdb-frame-display-buffer))
2011 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2012; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer))
2013)
2014
2015(let ((menu (make-sparse-keymap "GDB-Windows")))
2016 (define-key gud-menu-map [displays]
2017 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
2018 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2019 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
2020 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
2021 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
2022 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
2023 (define-key menu [display] '("Display" . gdb-display-display-buffer))
2024 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2025; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer))
2026)
2027
2028(let ((menu (make-sparse-keymap "View")))
2029 (define-key gud-menu-map [view]
2030 `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba)))
2031; (define-key menu [both] '(menu-item "Both" gdb-view-both
2032; :help "Display both source and assembler"
2033; :button (:radio . (eq gdb-selected-view 'both))))
2034 (define-key menu [assembler] '(menu-item "Assembler" gdb-view-assembler
2035 :help "Display assembler only"
2036 :button (:radio . (eq gdb-selected-view 'assembler))))
2037 (define-key menu [source] '(menu-item "Source" gdb-view-source-function
2038 :help "Display source only"
2039 :button (:radio . (eq gdb-selected-view 'source)))))
2040
2041(let ((menu (make-sparse-keymap "GDB-UI")))
2042 (define-key gud-menu-map [ui]
2043 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
2044 (define-key menu [gdb-restore-windows]
2045 '("Restore window layout" . gdb-restore-windows))
2046 (define-key menu [gdb-many-windows]
2047 (menu-bar-make-toggle gdb-many-windows gdb-many-windows
2048 "Display other windows" "Many Windows %s"
2049 "Display locals, stack and breakpoint information")))
2050
2051(defun gdb-frame-gdb-buffer ()
2052 (interactive)
2053 (switch-to-buffer-other-frame
2054 (gdb-get-create-buffer 'gdba)))
2055
2056(defun gdb-display-gdb-buffer ()
2057 (interactive)
2058 (gdb-display-buffer
2059 (gdb-get-create-buffer 'gdba)))
2060
2061(defvar gdb-main-file nil "Source file from which program execution begins.")
2062
2063(defun gdb-view-source-function ()
2064 (interactive)
2065 (if gdb-view-source
2066 (if gud-last-last-frame
2067 (set-window-buffer gdb-source-window
2068 (gud-find-file (car gud-last-last-frame)))
2069 (set-window-buffer gdb-source-window (gud-find-file gdb-main-file))))
2070 (setq gdb-selected-view 'source))
2071
2072(defun gdb-view-assembler()
2073 (interactive)
2074 (set-window-buffer gdb-source-window
2075 (gdb-get-create-buffer 'gdb-assembler-buffer))
2076 (setq gdb-selected-view 'assembler))
2077
2078;(defun gdb-view-both()
2079;(interactive)
2080;(setq gdb-selected-view 'both))
2081
2082;; layout for all the windows
2083(defun gdb-setup-windows ()
2084 (gdb-display-locals-buffer)
2085 (gdb-display-stack-buffer)
2086 (delete-other-windows)
2087 (gdb-display-breakpoints-buffer)
2088 (gdb-display-display-buffer)
2089 (delete-other-windows)
2090 (switch-to-buffer gud-comint-buffer)
2091 (split-window nil ( / ( * (window-height) 3) 4))
2092 (split-window nil ( / (window-height) 3))
2093 (split-window-horizontally)
2094 (other-window 1)
2095 (switch-to-buffer (gdb-locals-buffer-name))
2096 (other-window 1)
2097 (if (and gdb-view-source
2098 (eq gdb-selected-view 'source))
2099 (switch-to-buffer
2100 (if gud-last-last-frame
2101 (gud-find-file (car gud-last-last-frame))
2102 (gud-find-file gdb-main-file)))
2103 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
2104 (setq gdb-source-window (get-buffer-window (current-buffer)))
2105 (split-window-horizontally)
2106 (other-window 1)
2107 (switch-to-buffer (gdb-inferior-io-name))
2108 (other-window 1)
2109 (switch-to-buffer (gdb-stack-buffer-name))
2110 (split-window-horizontally)
2111 (other-window 1)
2112 (switch-to-buffer (gdb-breakpoints-buffer-name))
2113 (other-window 1))
2114
2115(defcustom gdb-many-windows nil
2116 "Nil means that gdb starts with just two windows : the GUD and
2117the source buffer."
2118 :type 'boolean
2119 :group 'gud)
2120
2121(defun gdb-many-windows (arg)
2122"Toggle the number of windows in the basic arrangement."
2123 (interactive "P")
2124 (setq gdb-many-windows
2125 (if (null arg)
2126 (not gdb-many-windows)
2127 (> (prefix-numeric-value arg) 0)))
2128 (gdb-restore-windows))
2129
2130(defun gdb-restore-windows ()
2131 "Restore the basic arrangement of windows used by gdba.
2132This arrangement depends on the value of `gdb-many-windows'."
2133 (interactive)
2134 (if gdb-many-windows
2135 (progn
2136 (switch-to-buffer gud-comint-buffer)
2137 (delete-other-windows)
2138 (gdb-setup-windows))
2139 (switch-to-buffer gud-comint-buffer)
2140 (delete-other-windows)
2141 (split-window)
2142 (other-window 1)
2143 (if (and gdb-view-source
2144 (eq gdb-selected-view 'source))
2145 (switch-to-buffer
2146 (if gud-last-last-frame
2147 (gud-find-file (car gud-last-last-frame))
2148 (gud-find-file gdb-main-file)))
2149 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)))
2150 (setq gdb-source-window (get-buffer-window (current-buffer)))
2151 (other-window 1)))
2152
2153(defun gdb-reset ()
2154 "Exit a debugging session cleanly by killing the gdb buffers and resetting
2155 the source buffers."
2156 (gdb-delete-frames '())
2157 (dolist (buffer (buffer-list))
2158 (if (not (eq buffer gud-comint-buffer))
2159 (with-current-buffer buffer
2160 (if (eq gud-minor-mode 'gdba)
2161 (if (string-match "^\*.+*$" (buffer-name))
2162 (kill-buffer nil)
2163 (if (eq window-system 'x)
2164 (remove-images (point-min) (point-max))
2165 (gdb-remove-strings (point-min) (point-max)))
2166 (setq left-margin-width 0)
2167 (setq gud-minor-mode nil)
2168 (kill-local-variable 'tool-bar-map)
2169 (setq gud-running nil)
2170 (if (get-buffer-window (current-buffer))
2171 (set-window-margins (get-buffer-window
2172 (current-buffer))
2173 left-margin-width
2174 right-margin-width))))))))
2175
2176(defun gdb-source-info ()
2177 "Find the source file where the program starts and displays it with related
2178buffers."
2179 (goto-char (point-min))
2180 (if (search-forward "directory is " nil t)
2181 (progn
2182 (if (looking-at "\\S-*:\\(\\S-*\\)")
2183 (setq gdb-cdir (match-string 1))
2184 (looking-at "\\S-*")
2185 (setq gdb-cdir (match-string 0)))
2186 (search-forward "Located in ")
2187 (looking-at "\\S-*")
2188 (setq gdb-main-file (match-string 0)))
2189 (setq gdb-view-source nil))
2190 (delete-other-windows)
2191 (switch-to-buffer gud-comint-buffer)
2192 (if gdb-many-windows
2193 (gdb-setup-windows)
2194 (gdb-display-breakpoints-buffer)
2195 (gdb-display-display-buffer)
2196 (delete-other-windows)
2197 (split-window)
2198 (other-window 1)
2199 (if gdb-view-source
2200 (switch-to-buffer
2201 (if gud-last-last-frame
2202 (gud-find-file (car gud-last-last-frame))
2203 (gud-find-file gdb-main-file)))
2204 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
2205 (gdb-invalidate-assembler))
2206 (setq gdb-source-window (get-buffer-window (current-buffer)))
2207 (other-window 1)))
2208
2209;;from put-image
2210(defun gdb-put-string (putstring pos)
2211 "Put string PUTSTRING in front of POS in the current buffer.
2212PUTSTRING is displayed by putting an overlay into the current buffer with a
2213`before-string' STRING that has a `display' property whose value is
2214PUTSTRING."
2215 (setq string "x")
2216 (let ((buffer (current-buffer)))
2217 (setq string (copy-sequence string))
2218 (let ((overlay (make-overlay pos pos buffer))
2219 (prop (list (list 'margin 'left-margin) putstring)))
2220 (put-text-property 0 (length string) 'display prop string)
2221 (overlay-put overlay 'put-break t)
2222 (overlay-put overlay 'before-string string))))
2223
2224;;from remove-images
2225(defun gdb-remove-strings (start end &optional buffer)
2226 "Remove strings between START and END in BUFFER.
2227Remove only strings that were put in BUFFER with calls to `put-string'.
2228BUFFER nil or omitted means use the current buffer."
2229 (unless buffer
2230 (setq buffer (current-buffer)))
2231 (let ((overlays (overlays-in start end)))
2232 (while overlays
2233 (let ((overlay (car overlays)))
2234 (when (overlay-get overlay 'put-break)
2235 (delete-overlay overlay)))
2236 (setq overlays (cdr overlays)))))
2237
2238(defun gdb-put-arrow (putstring pos)
2239 "Put arrow string PUTSTRING in the left margin in front of POS
2240in the current buffer. PUTSTRING is displayed by putting an
2241overlay into the current buffer with a `before-string'
2242\"gdb-arrow\" that has a `display' property whose value is
2243PUTSTRING. STRING is defaulted if you omit it. POS may be an
2244integer or marker."
2245 (setq string "gdb-arrow")
2246 (let ((buffer (current-buffer)))
2247 (setq string (copy-sequence string))
2248 (let ((overlay (make-overlay pos pos buffer))
2249 (prop (list (list 'margin 'left-margin) putstring)))
2250 (put-text-property 0 (length string) 'display prop string)
2251 (overlay-put overlay 'put-arrow t)
2252 (overlay-put overlay 'before-string string))))
2253
2254(defun gdb-remove-arrow (&optional buffer)
2255 "Remove arrow in BUFFER.
2256Remove only images that were put in BUFFER with calls to `put-arrow'.
2257BUFFER nil or omitted means use the current buffer."
2258 (unless buffer
2259 (setq buffer (current-buffer)))
2260 (let ((overlays (overlays-in (point-min) (point-max))))
2261 (while overlays
2262 (let ((overlay (car overlays)))
2263 (when (overlay-get overlay 'put-arrow)
2264 (delete-overlay overlay)))
2265 (setq overlays (cdr overlays)))))
2266
2267(defun gdb-array-visualise ()
2268 "Visualise arrays and slices using graph program from plotutils."
2269 (interactive)
2270 (when (and (display-graphic-p) gdb-display-string)
2271 (let ((n 0) m)
2272 (catch 'multi-dimensional
2273 (while (eq (aref gdb-array-start n) (aref gdb-array-stop n))
2274 (setq n (+ n 1)))
2275 (setq m (+ n 1))
2276 (while (< m (length gdb-array-start))
2277 (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m)))
2278 (progn
2279 (x-popup-dialog
2280 t `(,(concat "Only one dimensional data can be visualised.\n"
2281 "Use an array slice to reduce the number of\n"
2282 "dimensions") ("OK" t)))
2283 (throw 'multi-dimensional nil))
2284 (setq m (+ m 1))))
2285 (shell-command (concat "echo" gdb-display-string " | graph -a 1 "
2286 (int-to-string (aref gdb-array-start n))
2287 " -x "
2288 (int-to-string (aref gdb-array-start n))
2289 " "
2290 (int-to-string (aref gdb-array-stop n))
2291 " 1 -T X"))))))
2292
2293(defun gdb-delete-expression ()
2294 "Delete displayed expression and its frame."
2295 (interactive)
2296 (gdb-enqueue-input
2297 (list (concat "server delete display " gdb-display-number "\n")
2298 'ignore)))
2299
2300;;
2301;; Assembler buffer.
2302;;
2303(gdb-set-buffer-rules 'gdb-assembler-buffer
2304 'gdb-assembler-buffer-name
2305 'gdb-assembler-mode)
2306
2307(def-gdb-auto-updated-buffer gdb-assembler-buffer
2308 gdb-invalidate-assembler
2309 (concat "server disassemble " gdb-current-address "\n")
2310 gdb-assembler-handler
2311 gdb-assembler-custom)
2312
2313(defun gdb-assembler-custom ()
2314 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
2315 (gdb-arrow-position 1) (address) (flag))
2316 (with-current-buffer buffer
2317 (if (not (equal gdb-current-address "main"))
2318 (progn
2319 (gdb-remove-arrow)
2320 (goto-char (point-min))
2321 (if (re-search-forward gdb-current-address nil t)
2322 (progn
2323 (setq gdb-arrow-position (point))
2324 (gdb-put-arrow "=>" (point))))))
2325 ;; remove all breakpoint-icons in assembler buffer before updating.
2326 (if (eq window-system 'x)
2327 (remove-images (point-min) (point-max))
2328 (gdb-remove-strings (point-min) (point-max))))
2329 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
2330 (goto-char (point-min))
2331 (while (< (point) (- (point-max) 1))
2332 (forward-line 1)
2333 (if (looking-at "[^\t].*breakpoint")
2334 (progn
2335 (looking-at
2336 "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)")
2337 (setq flag (char-after (match-beginning 1)))
2338 (setq address (match-string 2))
2339 ;; remove leading 0s from output of info break.
2340 (if (string-match "^0+\\(.*\\)" address)
2341 (setq address (match-string 1 address)))
2342 (with-current-buffer buffer
2343 (goto-char (point-min))
2344 (if (re-search-forward address nil t)
2345 (let ((start (progn (beginning-of-line) (- (point) 1)))
2346 (end (progn (end-of-line) (+ (point) 1))))
2347 (if (eq window-system 'x)
2348 (progn
2349 (remove-images start end)
2350 (if (eq ?y flag)
2351 (put-image breakpoint-enabled-icon
2352 (+ start 1)
2353 "breakpoint icon enabled"
2354 'left-margin)
2355 (put-image breakpoint-disabled-icon
2356 (+ start 1)
2357 "breakpoint icon disabled"
2358 'left-margin)))
2359 (gdb-remove-strings start end)
2360 (if (eq ?y flag)
2361 (gdb-put-string "B" (+ start 1))
2362 (gdb-put-string "b" (+ start 1)))))))))))
2363 (if (not (equal gdb-current-address "main"))
2364 (set-window-point (get-buffer-window buffer) gdb-arrow-position))))
2365
2366(defvar gdb-assembler-mode-map
2367 (let ((map (make-sparse-keymap)))
2368 (suppress-keymap map)
2369 map))
2370
2371(defun gdb-assembler-mode ()
2372 "Major mode for viewing code assembler.
2373
2374\\{gdb-assembler-mode-map}"
2375 (setq major-mode 'gdb-assembler-mode)
2376 (setq mode-name "Assembler")
2377 (setq left-margin-width 2)
2378 (setq fringes-outside-margins t)
2379 (setq buffer-read-only t)
2380 (use-local-map gdb-assembler-mode-map)
2381 (gdb-invalidate-assembler)
2382 (gdb-invalidate-breakpoints))
2383
2384(defun gdb-assembler-buffer-name ()
2385 (with-current-buffer gud-comint-buffer
2386 (concat "*Machine Code " (gdb-get-target-string) "*")))
2387
2388(defun gdb-display-assembler-buffer ()
2389 (interactive)
2390 (gdb-display-buffer
2391 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2392
2393(defun gdb-frame-assembler-buffer ()
2394 (interactive)
2395 (switch-to-buffer-other-frame
2396 (gdb-get-create-buffer 'gdb-assembler-buffer)))
2397
2398;; modified because if gdb-current-address has changed value a new command
2399;; must be enqueued to update the buffer with the new output
2400(defun gdb-invalidate-assembler (&optional ignored)
2401 (if (gdb-get-buffer 'gdb-assembler-buffer)
2402 (progn
2403 (if (string-equal gdb-current-frame gdb-previous-frame)
2404 (gdb-assembler-custom)
2405 (if (or (not (member 'gdb-invalidate-assembler
2406 (gdb-get-pending-triggers)))
2407 (not (string-equal gdb-current-address
2408 gdb-previous-address)))
2409 (progn
2410 ;; take previous disassemble command off the queue
2411 (with-current-buffer gud-comint-buffer
2412 (let ((queue (gdb-get-idle-input-queue)) (item))
2413 (dolist (item queue)
2414 (if (equal (cdr item) '(gdb-assembler-handler))
2415 (gdb-set-idle-input-queue
2416 (delete item (gdb-get-idle-input-queue)))))))
2417 (gdb-enqueue-idle-input
2418 (list (concat "server disassemble " gdb-current-address "\n")
2419 'gdb-assembler-handler))
2420 (gdb-set-pending-triggers
2421 (cons 'gdb-invalidate-assembler
2422 (gdb-get-pending-triggers)))
2423 (setq gdb-previous-address gdb-current-address)
2424 (setq gdb-previous-frame gdb-current-frame)))))))
2425
2426(defun gdb-get-current-frame ()
2427 (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers)))
2428 (progn
2429 (gdb-enqueue-idle-input
2430 (list (concat "server info frame\n") 'gdb-frame-handler))
2431 (gdb-set-pending-triggers
2432 (cons 'gdb-get-current-frame
2433 (gdb-get-pending-triggers))))))
2434
2435(defun gdb-frame-handler ()
2436 (gdb-set-pending-triggers
2437 (delq 'gdb-get-current-frame (gdb-get-pending-triggers)))
2438 (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
2439 (goto-char (point-min))
2440 (forward-line)
2441 (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)")
2442 (progn
2443 (setq gdb-current-frame (match-string 2))
2444 (let ((address (match-string 1)))
2445 ;; remove leading 0s from output of info frame command.
2446 (if (string-match "^0+\\(.*\\)" address)
2447 (setq gdb-current-address
2448 (concat "0x" (match-string 1 address)))
2449 (setq gdb-current-address (concat "0x" address))))
2450 (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)"))
2451 (progn (setq gdb-view-source nil) t))
2452 (eq gdb-selected-view 'assembler))
2453 (progn
2454 (set-window-buffer
2455 gdb-source-window
2456 (gdb-get-create-buffer 'gdb-assembler-buffer))
2457 (gdb-invalidate-assembler)))))))
2458
2459(provide 'gdb-ui)
2460
2461;;; gdb-ui.el ends here
diff --git a/lisp/toolbar/gud-display.pbm b/lisp/toolbar/gud-display.pbm
new file mode 100644
index 00000000000..df2349619e7
--- /dev/null
+++ b/lisp/toolbar/gud-display.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-display.xpm b/lisp/toolbar/gud-display.xpm
new file mode 100644
index 00000000000..85c57bc2aa1
--- /dev/null
+++ b/lisp/toolbar/gud-display.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * display_xpm[] = {
3"24 24 2 1",
4" c #C0C0C0C0C0C0",
5". c #000000000000",
6" ",
7" ",
8" ",
9" ",
10" ... ",
11" .. ",
12" .. ",
13" .. ",
14" ..... ",
15" .. .. ",
16" .. .. ",
17" .. .. ",
18" .. .. ",
19" .. .. ",
20" .. .. ",
21" .. .. ",
22" ...... ",
23" ",
24" ",
25" ",
26" ",
27" ",
28" ",
29" "};
diff --git a/lisp/toolbar/gud-next.pbm b/lisp/toolbar/gud-next.pbm
new file mode 100644
index 00000000000..dc2a15323e3
--- /dev/null
+++ b/lisp/toolbar/gud-next.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-next.xpm b/lisp/toolbar/gud-next.xpm
new file mode 100644
index 00000000000..0e631de18e1
--- /dev/null
+++ b/lisp/toolbar/gud-next.xpm
@@ -0,0 +1,34 @@
1/* XPM */
2static char * next_xpm[] = {
3"24 24 7 1",
4" c #c0c0c0",
5". c #cc0033",
6"X c #616161",
7"o c #2a1f55",
8"O c #adadad",
9"+ c #d40000",
10"@ c #cc9999",
11" ",
12" ",
13" ",
14" ",
15" .......... ",
16" . . ",
17" . . ",
18" . Xo oX . ",
19" . XoO OoX . ",
20" . oo oo +@.@+ ",
21" oo oo @...@ ",
22" oo oo ... ",
23" oX Xo @.@ ",
24" oo oo . ",
25" oX Xo ",
26" oo oo ",
27" oo oo ",
28" oo oo ",
29" XoO OoX ",
30" Xo oX ",
31" ",
32" ",
33" ",
34" "};
diff --git a/lisp/toolbar/gud-nexti.pbm b/lisp/toolbar/gud-nexti.pbm
new file mode 100644
index 00000000000..ecad2965b0d
--- /dev/null
+++ b/lisp/toolbar/gud-nexti.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-nexti.xpm b/lisp/toolbar/gud-nexti.xpm
new file mode 100644
index 00000000000..cdb8c38e8d4
--- /dev/null
+++ b/lisp/toolbar/gud-nexti.xpm
@@ -0,0 +1,33 @@
1/* XPM */
2static char * gud_nexti_xpm[] = {
3"24 24 6 1",
4" c #C0C0C0C0C0C0",
5". c #CCCC00003333",
6"X c #616161616161",
7"o c #D4D400000000",
8"O c #CCCC99999999",
9"+ c #2A2A1F1F5555",
10" ",
11" ",
12" ",
13" ",
14" .......... ",
15" . . ",
16" . . ",
17" . . ",
18" . . ",
19" . X X oO.Oo ",
20" X+ +X O...O ",
21" X+ +X ... ",
22" X+ +X O.O ",
23" X+ +X . ",
24" +X X+ ",
25" +X X+ ",
26" +X X+ ",
27" +X X+ ",
28" + + ",
29" ",
30" ",
31" ",
32" ",
33" "};
diff --git a/lisp/toolbar/gud-step.pbm b/lisp/toolbar/gud-step.pbm
new file mode 100644
index 00000000000..de7caa50ed5
--- /dev/null
+++ b/lisp/toolbar/gud-step.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-step.xpm b/lisp/toolbar/gud-step.xpm
new file mode 100644
index 00000000000..7b4eb876235
--- /dev/null
+++ b/lisp/toolbar/gud-step.xpm
@@ -0,0 +1,33 @@
1/* XPM */
2static char * step_xpm[] = {
3"24 24 6 1",
4" c #c0c0c0",
5". c #d40000",
6"X c #616161",
7"o c #2a1f55",
8"O c #adadad",
9"+ c #cc9999",
10" ",
11" ",
12" ",
13" ",
14" ..... ",
15" . . ",
16" . . ",
17" . Xo . oX ",
18" . XoO . OoX ",
19" . oo .+.+. oo ",
20" oo +...+ oo ",
21" oo ... oo ",
22" oX +.+ Xo ",
23" oo . oo ",
24" oX Xo ",
25" oo oo ",
26" oo oo ",
27" oo oo ",
28" XoO OoX ",
29" Xo oX ",
30" ",
31" ",
32" ",
33" "};
diff --git a/lisp/toolbar/gud-stepi.pbm b/lisp/toolbar/gud-stepi.pbm
new file mode 100644
index 00000000000..eed55cc4a33
--- /dev/null
+++ b/lisp/toolbar/gud-stepi.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-stepi.xpm b/lisp/toolbar/gud-stepi.xpm
new file mode 100644
index 00000000000..d2667fc70b6
--- /dev/null
+++ b/lisp/toolbar/gud-stepi.xpm
@@ -0,0 +1,32 @@
1/* XPM */
2static char * gud_stepi_xpm[] = {
3"24 24 5 1",
4" c #C0C0C0C0C0C0",
5". c #D4D400000000",
6"X c #616161616161",
7"o c #2A2A1F1F5555",
8"O c #CCCC99999999",
9" ",
10" ",
11" ",
12" ",
13" ..... ",
14" . . ",
15" . . ",
16" . . ",
17" . X . X ",
18" . Xo .O.O. oX ",
19" Xo O...O oX ",
20" Xo ... oX ",
21" Xo O.O oX ",
22" oX . Xo ",
23" oX Xo ",
24" oX Xo ",
25" oX Xo ",
26" o o ",
27" ",
28" ",
29" ",
30" ",
31" ",
32" "};
diff --git a/lispref/index.perm b/lispref/index.perm
new file mode 100644
index 00000000000..0b391e85379
--- /dev/null
+++ b/lispref/index.perm
@@ -0,0 +1,38 @@
1@setfilename ../info/index
2
3@c Indexing guidelines
4
5@c I assume that all indexes will be combinded.
6@c Therefore, if a generated findex and permutations
7@c cover the ways an index user would look up the entry,
8@c then no cindex is added.
9@c Concept index (cindex) entries will also be permuted. Therefore, they
10@c have no commas and few irrelevant connectives in them.
11
12@c I tried to include words in a cindex that give the context of the entry,
13@c particularly if there is more than one entry for the same concept.
14@c For example, "nil in keymap"
15@c Similarly for explicit findex and vindex entries, e.g., "print example".
16
17@c Error codes are given cindex entries, e.g., "end-of-file error".
18
19@c pindex is used for .el files and Unix programs
20
21@node Index, New Symbols, Standard Hooks, Top
22@unnumbered Index
23
24
25All variables, functions, keys, programs, files, and concepts are
26in this one index.
27
28All names and concepts are permuted, so they appear several times, one
29for each permutation of the parts of the name. For example,
30@code{function-name} would appear as @b{function-name} and @b{name,
31function-}.
32
33
34@c Print the indices
35
36@printindex fn
37
38
diff --git a/lispref/index.unperm b/lispref/index.unperm
new file mode 100644
index 00000000000..95c76e5a00c
--- /dev/null
+++ b/lispref/index.unperm
@@ -0,0 +1,29 @@
1@c -*-texinfo-*-
2@setfilename ../info/index
3
4@c Indexing guidelines
5
6@c I assume that all indexes will be combinded.
7@c Therefore, if a generated findex and permutations
8@c cover the ways an index user would look up the entry,
9@c then no cindex is added.
10@c Concept index (cindex) entries will also be permuted. Therefore, they
11@c have no commas and few irrelevant connectives in them.
12
13@c I tried to include words in a cindex that give the context of the entry,
14@c particularly if there is more than one entry for the same concept.
15@c For example, "nil in keymap"
16@c Similarly for explicit findex and vindex entries, e.g. "print example".
17
18@c Error codes are given cindex entries, e.g. "end-of-file error".
19
20@c pindex is used for .el files and Unix programs
21
22@node Index, New Symbols, Standard Hooks, Top
23@unnumbered Index
24
25@c Print the indices
26
27@printindex fn
28
29
diff --git a/lispref/permute-index b/lispref/permute-index
new file mode 100644
index 00000000000..bbe2be75cba
--- /dev/null
+++ b/lispref/permute-index
@@ -0,0 +1,124 @@
1#!/bin/sh
2# Generate a permuted index of all names.
3# The result is a file called index.fns.
4
5# Copyright (C) 2001 Free Software Foundation, Inc.
6#
7# This file is part of GNU Emacs.
8#
9# GNU Emacs is free software; you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; either version 2, or (at your option)
12# any later version.
13#
14# GNU Emacs is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17# GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License
20# along with GNU Emacs; see the file COPYING. If not, write to the
21# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22# Boston, MA 02111-1307, USA.
23
24# You will need to modify this for your needs.
25
26
27set TEXINDEX=texindex # path to texindex command
28#set EMACS=gnuemacs # your emacs command
29#set TEX=tex # your tex command
30
31set MANUAL=elisp # the base name of the manual
32
33# goto 3
34
351:
36echo "Extract raw index from texinfo fn index."
37# Let texindex combine duplicate entries, later.
38# But it wants to protect non-alphanumerics thus confusing ptx.
39# Also change `\ ' to just a ` ', since texindex will fail. This is produced
40# by `@findex two words' in an example environment (no doubt among others).
41# delete wrapper parens
42# change dots {} to dots{}
43# change {-} to char form, so ptx wont ignore it.
44# delete leading \entry {
45# change '\ ' to ' '
46# change lines with = < > since they mess up field extraction.
47# separate into fields delimited by "
48rm -f permuted.raw
49cat ${MANUAL}.fn | \
50 sed \
51 -e 's/(\([^)]*\))/\1/' \
52 -e 's/\\dots {}/(\\dots{})/' \
53 -e "s/{-}/{{\\tt\\char'055}}/" \
54 -e 's,^[^ ]* {,,' \
55 -e 's, },},' \
56 -e 's,\\ , ,g' \
57 -e 's/{\\tt\\char61}/=/' \
58 -e 's/{\\tt\\gtr}/>/' \
59 -e 's/{\\tt\\less}/</' \
60 -e 's/}{/"/g' \
61 | awk -F\" '{print $2, $1}' > permuted.raw
62
632:
64# Build break file for ptx.
65cat <<EOF > permuted.break
66-
67:
68EOF
69# Build the ignore file for ptx.
70# We would like to ignore "and", "or", and "for",
71# but ptx ignores ignore words even if they stand alone.
72cat <<EOF > permuted.ignore
73the
74in
75to
76as
77a
78an
79of
80on
81them
82how
83from
84by
85EOF
86
87echo "Make troff permuted index."
88rm -f permuted.t
89ptx -i permuted.ignore -b permuted.break -f -r -w 144 \
90 < permuted.raw > permuted.t
91
923:
93echo "Extract the desired fields."
94rm -f permuted.fields
95awk -F\" '{printf "%s\"%s\"%s\n", $4,$6,$9}' permuted.t > permuted.fields
96
974:
98echo "Format for texindex."
99# delete lines that start with "and ", "for "
100sed < permuted.fields \
101 -e 's/=/{\\tt\\char61}/' \
102 -e 's/>/{\\tt\\gtr}/' \
103 -e 's/</{\\tt\\less}/' \
104 -e '/"and /d' \
105 -e '/"for /d' \
106 | awk -F\" 'NF>0 {if ($1=="") {\
107 print "\entry {" $2 "}{" 0+$3 "}{" $2 "}" }\
108 else {\
109 print "\entry {" $2 ", " $1 "}{" 0+$3 "}{" $2 ", " $1 "}"} }'\
110 > permuted.fn
111
1125:
113echo "Sort with texindex."
114${TEXINDEX} permuted.fn
115#mv permuted.fns ${MANUAL}.fns
116
117# The resulting permuted.fns will be read when we run TeX
118# on the manual the second time. Or you can use permuted.texinfo here.
119#${TEX} permuted.texinfo
120
1216:
122echo "Clean up."
123rm -f permuted.fields permuted.t permuted.raw
124rm -f permuted.break permuted.ignore permuted.fn
diff --git a/mac/Emacs.app/Contents/Resources/Emacs.rsrc b/mac/Emacs.app/Contents/Resources/Emacs.rsrc
new file mode 100644
index 00000000000..1a017ac4fe4
--- /dev/null
+++ b/mac/Emacs.app/Contents/Resources/Emacs.rsrc
Binary files differ
diff --git a/man/kmacro.texi b/man/kmacro.texi
deleted file mode 100644
index be2b520fc59..00000000000
--- a/man/kmacro.texi
+++ /dev/null
@@ -1,522 +0,0 @@
1@c This is part of the Emacs manual.
2@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001,2002,2003
3@c Free Software Foundation, Inc.
4@c See file emacs.texi for copying conditions.
5@node Keyboard Macros, Files, Fixit, Top
6@chapter Keyboard Macros
7@cindex defining keyboard macros
8@cindex keyboard macro
9
10 In this chapter we describe how a sequence of editing commands can
11be recorded and repeated multiple times.
12
13 A @dfn{keyboard macro} is a command defined by the user to stand for
14another sequence of keys. For example, if you discover that you are
15about to type @kbd{C-n C-d} forty times, you can speed your work by
16defining a keyboard macro to do @kbd{C-n C-d} and calling it with a
17repeat count of forty.
18
19 You define a keyboard macro while executing the commands which are the
20definition. Put differently, as you define a keyboard macro, the
21definition is being executed for the first time. This way, you can see
22what the effects of your commands are, so that you don't have to figure
23them out in your head. When you are finished, the keyboard macro is
24defined and also has been, in effect, executed once. You can then do the
25whole thing over again by invoking the macro.
26
27 Keyboard macros differ from ordinary Emacs commands in that they are
28written in the Emacs command language rather than in Lisp. This makes it
29easier for the novice to write them, and makes them more convenient as
30temporary hacks. However, the Emacs command language is not powerful
31enough as a programming language to be useful for writing anything
32intelligent or general. For such things, Lisp must be used.
33
34@menu
35* Basic Keyboard Macro:: Defining and running keyboard macros.
36* Keyboard Macro Ring:: Where previous keyboard macros are saved.
37* Keyboard Macro Counter:: Inserting incrementing numbers in macros.
38* Keyboard Macro Query:: Making keyboard macros do different things each time.
39* Save Keyboard Macro:: Giving keyboard macros names; saving them in files.
40* Edit Keyboard Macro:: Editing keyboard macros.
41* Keyboard Macro Step-Edit:: Interactively executing and editing a keyboard macro.
42@end menu
43
44@node Basic Keyboard Macro
45@section Basic Use
46
47@table @kbd
48@item C-x (
49Start defining a keyboard macro (@code{kmacro-start-macro}).
50@item C-x )
51End the definition of a keyboard macro (@code{kmacro-end-macro}).
52@item C-x e
53Execute the most recent keyboard macro (@code{kmacro-end-and-call-macro}).
54First end the definition of the keyboard macro, if currently defining it.
55To immediately execute the keyboard macro again, just repeat the @kbd{e}.
56@item C-u C-x (
57Re-execute last keyboard macro, then add more keys to its definition.
58@item C-u C-u C-x (
59Add more keys to the last keyboard macro without re-executing it.
60@item C-x q
61When this point is reached during macro execution, ask for confirmation
62(@code{kbd-macro-query}).
63@item C-x C-k n
64Give a command name (for the duration of the session) to the most
65recently defined keyboard macro (@code{name-last-kbd-macro}).
66@item C-x C-k b
67Bind the most recently defined keyboard macro to a key sequence (for
68the duration of the session) (@code{kmacro-bind-to-key}).
69@item M-x insert-kbd-macro
70Insert in the buffer a keyboard macro's definition, as Lisp code.
71@item C-x C-k e
72Edit a previously defined keyboard macro (@code{edit-kbd-macro}).
73@item C-x C-k r
74Run the last keyboard macro on each complete line in the region
75(@code{apply-macro-to-region-lines}).
76@end table
77
78@kindex C-x (
79@kindex C-x )
80@kindex C-x e
81@findex kmacro-start-macro
82@findex kmacro-end-macro
83@findex kmacro-end-and-call-macro
84 To start defining a keyboard macro, type the @kbd{C-x (} command
85(@code{kmacro-start-macro}). From then on, your keys continue to be
86executed, but also become part of the definition of the macro. @samp{Def}
87appears in the mode line to remind you of what is going on. When you are
88finished, the @kbd{C-x )} command (@code{kmacro-end-macro}) terminates the
89definition (without becoming part of it!). For example,
90
91@example
92C-x ( M-f foo C-x )
93@end example
94
95@noindent
96defines a macro to move forward a word and then insert @samp{foo}.
97
98 The macro thus defined can be invoked again with the @kbd{C-x e}
99command (@code{kmacro-end-and-call-macro}), which may be given a
100repeat count as a numeric argument to execute the macro many times.
101If you enter @kbd{C-x e} while defining a macro, the macro is
102terminated and executed immediately.
103
104 After executing the macro with @kbd{C-x e}, you can use @kbd{e}
105repeatedly to immediately repeat the macro one or more times. For example,
106
107@example
108C-x ( xyz C-x e e e
109@end example
110
111@noindent
112inserts @samp{xyzxyzxyzxyz} in the current buffer.
113
114 @kbd{C-x )} can also be given a repeat count as an argument, in
115which case it repeats the macro that many times right after defining
116it, but defining the macro counts as the first repetition (since it is
117executed as you define it). Therefore, giving @kbd{C-x )} an argument
118of 4 executes the macro immediately 3 additional times. An argument
119of zero to @kbd{C-x e} or @kbd{C-x )} means repeat the macro
120indefinitely (until it gets an error or you type @kbd{C-g} or, on
121MS-DOS, @kbd{C-@key{BREAK}}).
122
123@kindex C-x C-k C-s
124@kindex C-x C-k C-k
125Alternatively, you can use @kbd{C-x C-k C-s} to start a keyboard macro,
126and @kbd{C-x C-k C-k...} to end and execute it.
127
128 If you wish to repeat an operation at regularly spaced places in the
129text, define a macro and include as part of the macro the commands to move
130to the next place you want to use it. For example, if you want to change
131each line, you should position point at the start of a line, and define a
132macro to change that line and leave point at the start of the next line.
133Then repeating the macro will operate on successive lines.
134
135 When a command reads an argument with the minibuffer, your
136minibuffer input becomes part of the macro along with the command. So
137when you replay the macro, the command gets the same argument as
138when you entered the macro. For example,
139
140@example
141C-x ( C-a C-@key{SPC} C-n M-w C-x b f o o @key{RET} C-y C-x b @key{RET} C-x )
142@end example
143
144@noindent
145defines a macro that copies the current line into the buffer
146@samp{foo}, then returns to the original buffer.
147
148 You can use function keys in a keyboard macro, just like keyboard
149keys. You can even use mouse events, but be careful about that: when
150the macro replays the mouse event, it uses the original mouse position
151of that event, the position that the mouse had while you were defining
152the macro. The effect of this may be hard to predict. (Using the
153current mouse position would be even less predictable.)
154
155 One thing that doesn't always work well in a keyboard macro is the
156command @kbd{C-M-c} (@code{exit-recursive-edit}). When this command
157exits a recursive edit that started within the macro, it works as you'd
158expect. But if it exits a recursive edit that started before you
159invoked the keyboard macro, it also necessarily exits the keyboard macro
160as part of the process.
161
162 After you have terminated the definition of a keyboard macro, you can add
163to the end of its definition by typing @kbd{C-u C-x (}. This is equivalent
164to plain @kbd{C-x (} followed by retyping the whole definition so far. As
165a consequence it re-executes the macro as previously defined.
166
167 You can also add to the end of the definition of the last keyboard
168macro without re-execuing it by typing @kbd{C-u C-u C-x (}.
169
170 The variable @code{kmacro-execute-before-append} specifies whether
171a single @kbd{C-u} prefix causes the existing macro to be re-executed
172before appending to it.
173
174@findex apply-macro-to-region-lines
175@kindex C-x C-k r
176 The command @kbd{C-x C-k r} (@code{apply-macro-to-region-lines})
177repeats the last defined keyboard macro on each complete line within
178the current region. It does this line by line, by moving point to the
179beginning of the line and then executing the macro.
180
181@node Keyboard Macro Ring
182@section Where previous keyboard macros are saved
183
184 All defined keyboard macros are recorded in the ``keyboard macro ring'',
185a list of sequences of keys. There is only one keyboard macro ring,
186shared by all buffers.
187
188 All commands which operates on the keyboard macro ring use the
189same @kbd{C-x C-k} prefix. Most of these commands can be executed and
190repeated immediately after each other without repeating the @kbd{C-x
191C-k} prefix. For example,
192
193@example
194C-x C-k C-p C-p C-k C-k C-k C-n C-n C-k C-p C-k C-d
195@end example
196
197@noindent
198will rotate the keyboard macro ring to the ``second previous'' macro,
199execute the resulting head macro three times, rotate back to the
200original head macro, execute that once, rotate to the ``previous''
201macro, execute that, and finally delete it from the macro ring.
202
203@findex kmacro-end-or-call-macro-repeat
204@kindex C-x C-k C-k
205 The command @kbd{C-x C-k C-k} (@code{kmacro-end-or-call-macro-repeat})
206executes the keyboard macro at the head of the macro ring. You can
207repeat the macro immediately by typing another @kbd{C-k}, or you can
208rotate the macro ring immediately by typing @kbd{C-n} or @kbd{C-p}.
209
210@findex kmacro-cycle-ring-next
211@kindex C-x C-k C-n
212@findex kmacro-cycle-ring-previous
213@kindex C-x C-k C-p
214 The commands @kbd{C-x C-k C-n} (@code{kmacro-cycle-ring-next}) and
215@kbd{C-x C-k C-p} (@code{kmacro-cycle-ring-previous}) rotates the
216macro ring, bringing the next or previous keyboard macro to the head
217of the macro ring. The definition of the new head macro is displayed
218in the echo area. You can continue to rotate the macro ring
219immediately by repeating just @kbd{C-n} and @kbd{C-p} until the
220desired macro is at the head of the ring. To execute the new macro
221ring head immediately, just type @kbd{C-k}.
222
223@findex kmacro-view-macro-repeat
224@kindex C-x C-k C-v
225
226 The commands @kbd{C-x C-k C-v} (@code{kmacro-view-macro-repeat})
227displays the last keyboard macro, or when repeated (with @kbd{C-v}),
228it displays the previous macro on the macro ring, just like @kbd{C-x
229C-k C-p}, but without actually rotating the macro ring. If you enter
230@kbd{C-k} immediately after displaying a macro from the ring, that
231macro is executed, but still without altering the macro ring.
232
233 So while e.g. @kbd{C-x C-k C-p C-p C-k C-k} makes the 3rd previous
234macro the current macro and executes it twice, @kbd{C-x C-k C-v C-v
235C-v C-k C-k} will display and execute the 3rd previous macro once and
236then the current macro once.
237
238@findex kmacro-delete-ring-head
239@kindex C-x C-k C-d
240
241 The commands @kbd{C-x C-k C-d} (@code{kmacro-delete-ring-head})
242removes and deletes the macro currently at the head of the macro
243ring. You can use this to delete a macro that didn't work as
244expected, or which you don't need anymore.
245
246@findex kmacro-swap-ring
247@kindex C-x C-k C-t
248
249 The commands @kbd{C-x C-k C-t} (@code{kmacro-swap-ring})
250interchanges the head of the macro ring with the previous element on
251the macro ring.
252
253@findex kmacro-call-ring-2nd-repeat
254@kindex C-x C-k C-l
255
256 The commands @kbd{C-x C-k C-l} (@code{kmacro-call-ring-2nd-repeat})
257executes the previous (rather than the head) element on the macro ring.
258
259@node Keyboard Macro Counter
260@section Inserting incrementing numbers in macros
261
262 Each keyboard macro has an associated counter which is automatically
263incremented on every repetition of the keyboard macro. Normally, the
264macro counter is initialized to 0 when you start defining the macro,
265and incremented by 1 after each insertion of the counter value;
266that is, if you insert the macro counter twice while defining the
267macro, it will be incremented by 2 time for each repetition of the
268macro.
269
270@findex kmacro-insert-counter
271@kindex C-x C-k C-i
272 The command @kbd{C-x C-k C-i} (@code{kmacro-insert-counter}) inserts
273the current value of the keyboard macro counter and increments the
274counter by 1. You can use a numeric prefix argument to specify a
275different increment. If you specify a @kbd{C-u} prefix, the last
276inserted counter value is repeated and the counter is not incremented.
277For example, if you enter the following sequence while defining a macro
278
279@example
280C-x C-k C-i C-x C-k C-i C-u C-x C-k C-i C-x C-k C-i
281@end example
282
283@noindent
284the text @samp{0112} is inserted in the buffer, and for the first and
285second execution of the macro @samp{3445} and @samp{6778} are
286inserted.
287
288@findex kmacro-set-counter
289@kindex C-x C-k C-c
290 The command @kbd{C-x C-k C-c} (@code{kmacro-set-counter}) prompts
291for the initial value of the keyboard macro counter if you use it
292before you define a keyboard macro. If you use it while defining a
293keyboard macro, you set the macro counter to the same (initial) value
294on each repetition of the macro. If you specify a @kbd{C-u} prefix,
295the counter is reset to the value it had prior to the current
296repetition of the macro (undoing any increments so far in this
297repetition).
298
299@findex kmacro-add-counter
300@kindex C-x C-k C-a
301 The command @kbd{C-x C-k C-a} (@code{kmacro-add-counter}) prompts
302for a value to add to the macro counter.
303
304@findex kmacro-set-format
305@kindex C-x C-k C-f
306 The command @kbd{C-x C-k C-f} (@code{kmacro-set-format}) prompts
307for the format to use when inserting the macro counter. The default
308format is @samp{%d}. If you set the counter format before you define a
309macro, that format is restored before each repetition of the macro.
310Consequently, any changes you make to the macro counter format while
311defining a macro are only active for the rest of the macro.
312
313@node Keyboard Macro Query
314@section Executing Macros with Variations
315
316@kindex C-x q
317@findex kbd-macro-query
318 Using @kbd{C-x q} (@code{kbd-macro-query}), you can get an effect
319similar to that of @code{query-replace}, where the macro asks you each
320time around whether to make a change. While defining the macro,
321type @kbd{C-x q} at the point where you want the query to occur. During
322macro definition, the @kbd{C-x q} does nothing, but when you run the
323macro later, @kbd{C-x q} asks you interactively whether to continue.
324
325 The valid responses when @kbd{C-x q} asks are @key{SPC} (or @kbd{y}),
326@key{DEL} (or @kbd{n}), @key{RET} (or @kbd{q}), @kbd{C-l} and @kbd{C-r}.
327The answers are the same as in @code{query-replace}, though not all of
328the @code{query-replace} options are meaningful.
329
330 These responses include @key{SPC} to continue, and @key{DEL} to skip
331the remainder of this repetition of the macro and start right away with
332the next repetition. @key{RET} means to skip the remainder of this
333repetition and cancel further repetitions. @kbd{C-l} redraws the screen
334and asks you again for a character to say what to do.
335
336 @kbd{C-r} enters a recursive editing level, in which you can perform
337editing which is not part of the macro. When you exit the recursive
338edit using @kbd{C-M-c}, you are asked again how to continue with the
339keyboard macro. If you type a @key{SPC} at this time, the rest of the
340macro definition is executed. It is up to you to leave point and the
341text in a state such that the rest of the macro will do what you
342want.@refill
343
344 @kbd{C-u C-x q}, which is @kbd{C-x q} with a numeric argument,
345performs a completely different function. It enters a recursive edit
346reading input from the keyboard, both when you type it during the
347definition of the macro, and when it is executed from the macro. During
348definition, the editing you do inside the recursive edit does not become
349part of the macro. During macro execution, the recursive edit gives you
350a chance to do some particularized editing on each repetition.
351@xref{Recursive Edit}.
352
353 Another way to vary the behavior of a keyboard macro is to use a
354register as a counter, incrementing it on each repetition of the macro.
355@xref{RegNumbers}.
356
357@node Save Keyboard Macro
358@section Naming and Saving Keyboard Macros
359
360@cindex saving keyboard macros
361@findex name-last-kbd-macro
362@kindex C-x C-k n
363 If you wish to save a keyboard macro for later use, you can give it
364a name using @kbd{C-x C-k n} (@code{name-last-kbd-macro}).
365This reads a name as an argument using the minibuffer and defines that name
366to execute the macro. The macro name is a Lisp symbol, and defining it in
367this way makes it a valid command name for calling with @kbd{M-x} or for
368binding a key to with @code{global-set-key} (@pxref{Keymaps}). If you
369specify a name that has a prior definition other than another keyboard
370macro, an error message is shown and nothing is changed.
371
372@cindex binding keyboard macros
373@findex kmacro-bind-to-key
374@kindex C-x C-k b
375 Rather than giving a keyboard macro a name, you can bind it to a
376key using @kbd{C-x C-k b} (@code{kmacro-bind-to-key}) followed by the
377key sequence you want the keyboard macro to be bound to. You can
378bind to any key sequence in the global keymap, but since most key
379sequences already have other bindings, you should select the key
380sequence carefylly. If you try to bind to a key sequence with an
381existing binding (in any keymap), you will be asked if you really
382want to replace the existing binding of that key.
383
384To avoid problems caused by overriding existing bindings, the key
385sequences @kbd{C-x C-k 0} through @kbd{C-x C-k 9} and @kbd{C-x C-k A}
386through @kbd{C-x C-k Z} are reserved for your own keyboard macro
387bindings. In fact, to bind to one of these key sequences, you only
388need to type the digit or letter rather than the whole key sequences.
389For example,
390
391@example
392C-x C-k b 4
393@end example
394
395@noindent
396will bind the last keyboard macro to the key sequence @kbd{C-x C-k 4}.
397
398@findex insert-kbd-macro
399 Once a macro has a command name, you can save its definition in a file.
400Then it can be used in another editing session. First, visit the file
401you want to save the definition in. Then use this command:
402
403@example
404M-x insert-kbd-macro @key{RET} @var{macroname} @key{RET}
405@end example
406
407@noindent
408This inserts some Lisp code that, when executed later, will define the
409same macro with the same definition it has now. (You need not
410understand Lisp code to do this, because @code{insert-kbd-macro} writes
411the Lisp code for you.) Then save the file. You can load the file
412later with @code{load-file} (@pxref{Lisp Libraries}). If the file you
413save in is your init file @file{~/.emacs} (@pxref{Init File}) then the
414macro will be defined each time you run Emacs.
415
416 If you give @code{insert-kbd-macro} a numeric argument, it makes
417additional Lisp code to record the keys (if any) that you have bound to the
418keyboard macro, so that the macro will be reassigned the same keys when you
419load the file.
420
421@node Edit Keyboard Macro
422@section Interactively executing and editing a keyboard macro
423
424@findex kmacro-edit-macro
425@kindex C-x C-k C-e
426@kindex C-x C-k RET
427 You can edit the last keyboard macro by typing @kbd{C-x C-k C-e} or
428@kbd{C-x C-k RET} (@code{kmacro-edit-macro}). This formats the macro
429definition in a buffer and enters a specialized major mode for editing
430it. Type @kbd{C-h m} once in that buffer to display details of how to
431edit the macro. When you are finished editing, type @kbd{C-c C-c}.
432
433@findex edit-kbd-macro
434@kindex C-x C-k e
435 You can edit a named keyboard macro or a macro bound to a key by typing
436@kbd{C-x C-k e} (@code{edit-kbd-macro}). Follow that with the
437keyboard input that you would use to invoke the macro---@kbd{C-x e} or
438@kbd{M-x @var{name}} or some other key sequence.
439
440@findex kmacro-edit-lossage
441@kindex C-x C-k l
442 You can edit the last 100 keystrokes as a macro by typing
443@kbd{C-x C-k l} (@code{kmacro-edit-lossage}).
444
445@node Keyboard Macro Step-Edit
446@section Interactively executing and editing a keyboard macro
447
448@findex kmacro-step-edit-macro
449@kindex C-x C-k SPC
450 You can interactively and stepwise replay and edit the last keyboard
451macro one command at a time by typing @kbd{C-x C-k SPC}
452(@code{kmacro-step-edit-macro}). Unless you quit the macro using
453@kbd{q} or @kbd{C-g}, the edited macro replaces the last macro on the
454macro ring.
455
456This shows the last macro in the minibuffer together with the first
457(or next) command to be executed, and prompts you for an action.
458You can enter @kbd{?} to get a command summary.
459
460The following commands are available in the step-edit mode and relate
461to the first (or current) command in the keyboard macro:
462
463@itemize @bullet{}
464@item
465@kbd{SPC} and @kbd{y} execute the current command, and advance to the
466next command in the keyboard macro.
467@item
468@kbd{n}, @kbd{d}, and @kbd{DEL} skip and delete the current command.
469@item
470@kbd{f} skips the current command in this execution of the keyboard
471macro, but doesn't delete it from the macro.
472@item
473@kbd{TAB} executes the current command, as well as all similar
474commands immediately following the current command; for example, TAB
475may be used to insert a sequence of characters (corresponding to a
476sequence of @code{self-insert-command} commands).
477@item
478@kbd{c} continues execution (without further editing) until the end of
479the keyboard macro. If execution terminates normally, the edited
480macro replaces the original keyboard macro.
481@item
482@kbd{C-k} skips and deletes the rest of the keyboard macro,
483terminates step-editing, and replaces the original keyboard macro
484with the edited macro.
485@item
486@kbd{q} and @kbd{C-g} cancels the step-editing of the keyboard macro;
487discarding any changes made to the keyboard macro.
488@item
489@kbd{i KEY... C-j} reads and executes a series of key sequences (not
490including the final @kbd{C-j}), and inserts them before the current
491command in the keyboard macro, without advancing over the current
492command.
493@item
494@kbd{I KEY...} reads one key sequence, executes it, and inserts it
495before the current command in the keyboard macro, without advancing
496over the current command.
497@item
498@kbd{r KEY... C-j} reads and executes a series of key sequences (not
499including the final @kbd{C-j}), and replaces the current command in
500the keyboard macro with them, advancing over the inserted key
501sequences.
502@item
503@kbd{R KEY...} reads one key sequence, executes it, and replaces the
504current command in the keyboard macro with that key sequence,
505advancing over the inserted key sequence.
506@item
507@kbd{a KEY... C-j} executes the current command, then reads and
508executes a series of key sequences (not including the final
509@kbd{C-j}), and inserts them after the current command in the keyboard
510macro; it then advances over the current command and the inserted key
511sequences.
512@item
513@kbd{A KEY... C-j} executes the rest of the commands in the keyboard
514macro, then reads and executes a series of key sequences (not
515including the final @kbd{C-j}), and appends them at the end of the
516keyboard macro; it then terminates the step-editing and replaces the
517original keyboard macro with the edited macro.
518@end itemize
519
520@ignore
521 arch-tag: c1b0dd3b-3159-4c08-928f-52e763953e9c
522@end ignore
diff --git a/nt/envadd.bat b/nt/envadd.bat
deleted file mode 100644
index ec9326a56c9..00000000000
--- a/nt/envadd.bat
+++ /dev/null
@@ -1,48 +0,0 @@
1rem Hack to change/add environment variables in the makefiles for the
2rem Windows platform.
3rem
4rem Copyright (c) 2003 Free Software Foundation, Inc.
5rem
6rem This file is part of GNU Emacs.
7rem
8rem GNU Emacs is free software; you can redistribute it and/or modify
9rem it under the terms of the GNU General Public License as published by
10rem the Free Software Foundation; either version 2, or (at your option)
11rem any later version.
12rem
13rem GNU Emacs is distributed in the hope that it will be useful,
14rem but WITHOUT ANY WARRANTY; without even the implied warranty of
15rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16rem GNU General Public License for more details.
17rem
18rem You should have received a copy of the GNU General Public License
19rem along with GNU Emacs; see the file COPYING. If not, write to
20rem the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21rem Boston, MA 02111-1307, USA.
22rem
23rem
24rem Usage:
25rem envadd "ENV1=VAL1" "ENV2=VAL2" ... /C <command line>
26rem
27rem The "/C" switch marks the end of environment variables, and the
28rem beginning of the command line.
29rem
30rem By Peter 'Luna' Runestig <peter@runestig.com> 2003
31
32:Loop
33if .%1% == ./C goto EndLoop
34rem just to avoid an endless loop:
35if .%1% == . goto EndLoop
36set %1
37shift
38goto Loop
39:EndLoop
40
41rem Eat the "/C"
42shift
43rem Now, run the command line
44%1 %2 %3 %4 %5 %6 %7 %8 %9
45
46goto skipArchTag
47 arch-tag: 148c5181-dbce-43ae-bba6-1cc6e2a9ea75
48:skipArchTag
diff --git a/nt/multi-install-info.bat b/nt/multi-install-info.bat
deleted file mode 100644
index c252dfb4a85..00000000000
--- a/nt/multi-install-info.bat
+++ /dev/null
@@ -1,45 +0,0 @@
1@echo off
2
3rem Hack to run install-info with multiple info files on the command
4rem line on the Windows platform.
5rem
6rem Copyright (c) 2003 Free Software Foundation, Inc.
7rem
8rem This file is part of GNU Emacs.
9rem
10rem GNU Emacs is free software; you can redistribute it and/or modify
11rem it under the terms of the GNU General Public License as published by
12rem the Free Software Foundation; either version 2, or (at your option)
13rem any later version.
14rem
15rem GNU Emacs is distributed in the hope that it will be useful,
16rem but WITHOUT ANY WARRANTY; without even the implied warranty of
17rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18rem GNU General Public License for more details.
19rem
20rem You should have received a copy of the GNU General Public License
21rem along with GNU Emacs; see the file COPYING. If not, write to
22rem the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23rem Boston, MA 02111-1307, USA.
24rem
25rem
26rem Usage:
27rem multi-install-info <switch passed to install-info> FILE1 FILE2 ...
28rem
29rem By Peter 'Luna' Runestig <peter@runestig.com> 2003
30
31set INSTALL_INFO=install-info
32set II_SWITCH=%1=%2
33rem Eat the install-info switch:
34shift
35
36:Loop
37shift
38if .%1% == . goto EndLoop
39%INSTALL_INFO% %II_SWITCH% %1
40goto Loop
41:EndLoop
42
43goto skipArchTag
44 arch-tag: 4f590862-8ead-497a-a71c-fb4b0e5d50db
45:skipArchTag
diff --git a/src/.gdbinit-union b/src/.gdbinit-union
new file mode 100644
index 00000000000..406388273ed
--- /dev/null
+++ b/src/.gdbinit-union
@@ -0,0 +1,400 @@
1# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001
2# Free Software Foundation, Inc.
3#
4# This file is part of GNU Emacs.
5#
6# GNU Emacs is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2, or (at your option)
9# any later version.
10#
11# GNU Emacs is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with GNU Emacs; see the file COPYING. If not, write to the
18# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19# Boston, MA 02111-1307, USA.
20
21# Force loading of symbols, enough to give us gdb_valbits etc.
22set main
23
24# Find lwlib source files too.
25dir ../lwlib
26#dir /gd/gnu/lesstif-0.89.9/lib/Xm
27
28# Don't enter GDB when user types C-g to quit.
29# This has one unfortunate effect: you can't type C-c
30# at the GDB to stop Emacs, when using X.
31# However, C-z works just as well in that case.
32handle 2 noprint pass
33
34# Don't pass SIGALRM to Emacs. This makes problems when
35# debugging.
36handle SIGALRM ignore
37
38# Set up a mask to use.
39# This should be EMACS_INT, but in some cases that is a macro.
40# long ought to work in all cases right now.
41set $valmask = ((long)1 << gdb_valbits) - 1
42set $nonvalbits = gdb_emacs_intbits - gdb_valbits
43
44# Set up something to print out s-expressions.
45define pr
46set debug_print ($)
47end
48document pr
49Print the emacs s-expression which is $.
50Works only when an inferior emacs is executing.
51end
52
53define xtype
54output (enum Lisp_Type) (($.i >> gdb_valbits) & 0x7)
55echo \n
56output ((($.i >> gdb_valbits) & 0x7) == Lisp_Misc ? (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) : (($.i >> gdb_valbits) & 0x7) == Lisp_Vectorlike ? ($size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size, (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)) : 0)
57echo \n
58end
59document xtype
60Print the type of $, assuming it is an Emacs Lisp value.
61If the first type printed is Lisp_Vector or Lisp_Misc,
62the second line gives the more precise type.
63Otherwise the second line doesn't mean anything.
64end
65
66define xvectype
67 set $size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size
68 output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)
69 echo \n
70end
71document xvectype
72 Print the vector subtype of $, assuming it is a vector or pseudovector.
73end
74
75define xmisctype
76 output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type)
77 echo \n
78end
79document xmisctype
80 Print the specific type of $, assuming it is some misc type.
81end
82
83define xint
84 print (($.i & $valmask) << $nonvalbits) >> $nonvalbits
85end
86document xint
87 Print $, assuming it is an Emacs Lisp integer. This gets the sign right.
88end
89
90define xptr
91 print (void *) (($.i & $valmask) | gdb_data_seg_bits)
92end
93document xptr
94 Print the pointer portion of $, assuming it is an Emacs Lisp value.
95end
96
97define xmarker
98 print (struct Lisp_Marker *) (($.i & $valmask) | gdb_data_seg_bits)
99end
100document xmarker
101 Print $ as a marker pointer, assuming it is an Emacs Lisp marker value.
102end
103
104define xoverlay
105 print (struct Lisp_Overlay *) (($.i & $valmask) | gdb_data_seg_bits)
106end
107document xoverlay
108 Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value.
109end
110
111define xmiscfree
112 print (struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits)
113end
114document xmiscfree
115 Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value.
116end
117
118define xintfwd
119 print (struct Lisp_Intfwd *) (($.i & $valmask) | gdb_data_seg_bits)
120end
121document xintfwd
122 Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value.
123end
124
125define xboolfwd
126 print (struct Lisp_Boolfwd *) (($.i & $valmask) | gdb_data_seg_bits)
127end
128document xboolfwd
129 Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value.
130end
131
132define xobjfwd
133 print (struct Lisp_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
134end
135document xobjfwd
136 Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value.
137end
138
139define xbufobjfwd
140 print (struct Lisp_Buffer_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
141end
142document xbufobjfwd
143 Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
144end
145
146define xkbobjfwd
147 print (struct Lisp_Kboard_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits)
148end
149document xkbobjfwd
150 Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value.
151end
152
153define xbuflocal
154 print (struct Lisp_Buffer_Local_Value *) (($.i & $valmask) | gdb_data_seg_bits)
155end
156document xbuflocal
157 Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value.
158end
159
160define xsymbol
161 print (struct Lisp_Symbol *) (($.i & $valmask) | gdb_data_seg_bits)
162 xprintsymptr $
163end
164document xsymbol
165 Print the name and address of the symbol $.
166 This command assumes that $ is an Emacs Lisp symbol value.
167end
168
169define xstring
170 print (struct Lisp_String *) (($.i & $valmask) | gdb_data_seg_bits)
171 output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte)
172 echo \n
173end
174document xstring
175 Print the contents and address of the string $.
176 This command assumes that $ is an Emacs Lisp string value.
177end
178
179define xvector
180 print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
181 output ($->size > 50) ? 0 : ($->contents[0])@($->size)
182 echo \n
183end
184document xvector
185 Print the contents and address of the vector $.
186 This command assumes that $ is an Emacs Lisp vector value.
187end
188
189define xprocess
190 print (struct Lisp_Process *) (($.i & $valmask) | gdb_data_seg_bits)
191 output *$
192 echo \n
193end
194document xprocess
195 Print the address of the struct Lisp_process which the Lisp_Object $ points to.
196end
197
198define xframe
199 print (struct frame *) (($.i & $valmask) | gdb_data_seg_bits)
200end
201document xframe
202 Print $ as a frame pointer, assuming it is an Emacs Lisp frame value.
203end
204
205define xcompiled
206 print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
207 output ($->contents[0])@($->size & 0xff)
208end
209document xcompiled
210 Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value.
211end
212
213define xwindow
214 print (struct window *) (($.i & $valmask) | gdb_data_seg_bits)
215 printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top
216end
217document xwindow
218 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
219 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
220end
221
222define xwinconfig
223 print (struct save_window_data *) (($.i & $valmask) | gdb_data_seg_bits)
224end
225document xwinconfig
226 Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value.
227end
228
229define xsubr
230 print (struct Lisp_Subr *) (($.i & $valmask) | gdb_data_seg_bits)
231 output *$
232 echo \n
233end
234document xsubr
235 Print the address of the subr which the Lisp_Object $ points to.
236end
237
238define xchartable
239 print (struct Lisp_Char_Table *) (($.i & $valmask) | gdb_data_seg_bits)
240 printf "Purpose: "
241 output (char*)&((struct Lisp_Symbol *) (($->purpose.i & $valmask) | gdb_data_seg_bits))->name->data
242 printf " %d extra slots", ($->size & 0x1ff) - 388
243 echo \n
244end
245document xchartable
246 Print the address of the char-table $, and its purpose.
247 This command assumes that $ is an Emacs Lisp char-table value.
248end
249
250define xboolvector
251 print (struct Lisp_Bool_Vector *) (($.i & $valmask) | gdb_data_seg_bits)
252 output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8)
253 echo \n
254end
255document xboolvector
256 Print the contents and address of the bool-vector $.
257 This command assumes that $ is an Emacs Lisp bool-vector value.
258end
259
260define xbuffer
261 print (struct buffer *) (($.i & $valmask) | gdb_data_seg_bits)
262 output ((struct Lisp_String *) (($->name.i & $valmask) | gdb_data_seg_bits))->data
263 echo \n
264end
265document xbuffer
266 Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value.
267 Print the name of the buffer.
268end
269
270define xhashtable
271 print (struct Lisp_Hash_Table *) (($.i & $valmask) | gdb_data_seg_bits)
272end
273document xhashtable
274 Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value.
275end
276
277define xcons
278 print (struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits)
279 output/x *$
280 echo \n
281end
282document xcons
283 Print the contents of $, assuming it is an Emacs Lisp cons.
284end
285
286define nextcons
287 p $.cdr
288 xcons
289end
290document nextcons
291 Print the contents of the next cell in a list.
292 This assumes that the last thing you printed was a cons cell contents
293 (type struct Lisp_Cons) or a pointer to one.
294end
295
296define xcar
297 print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->car : 0)
298end
299document xcar
300 Print the car of $, assuming it is an Emacs Lisp pair.
301end
302
303define xcdr
304 print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->cdr : 0)
305end
306document xcdr
307 Print the cdr of $, assuming it is an Emacs Lisp pair.
308end
309
310define xfloat
311 print ((struct Lisp_Float *) (($.i & $valmask) | gdb_data_seg_bits))->data
312end
313document xfloat
314 Print $ assuming it is a lisp floating-point number.
315end
316
317define xscrollbar
318 print (struct scrollbar *) (($.i & $valmask) | gdb_data_seg_bits)
319 output *$
320 echo \n
321end
322document xscrollbar
323 Print $ as a scrollbar pointer.
324end
325
326define xprintsym
327 set $sym = ((struct Lisp_Symbol *) (($arg0.i & $valmask) | gdb_data_seg_bits))
328 xprintsymptr $sym
329end
330document xprintsym
331 Print argument as a symbol.
332end
333define xprintsymptr
334 set $sym = $arg0
335 set $sym_name = ((struct Lisp_String *)(($sym->xname.i & $valmask) | gdb_data_seg_bits))
336 output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte)
337 echo \n
338end
339
340define xbacktrace
341 set $bt = backtrace_list
342 while $bt
343 set $type = (enum Lisp_Type) (((*$bt->function).i >> gdb_valbits) & 0x7)
344 if $type == Lisp_Symbol
345 xprintsym (*$bt->function)
346 else
347 printf "0x%x ", (*$bt->function).i
348 if $type == Lisp_Vectorlike
349 set $size = ((struct Lisp_Vector *) (((*$bt->function).i & $valmask) | gdb_data_seg_bits))->size
350 output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0)
351 else
352 printf "Lisp type %d", $type
353 end
354 echo \n
355 end
356 set $bt = $bt->next
357 end
358end
359document xbacktrace
360 Print a backtrace of Lisp function calls from backtrace_list.
361 Set a breakpoint at Fsignal and call this to see from where
362 an error was signaled.
363end
364
365define xreload
366 set $valmask = ((long)1 << gdb_valbits) - 1
367 set $nonvalbits = gdb_emacs_intbits - gdb_valbits
368end
369document xreload
370 When starting Emacs a second time in the same gdb session under
371 FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost
372 their values. (The same happens on current (2000) versions of GNU/Linux
373 with gdb 5.0.)
374 This function reloads them.
375end
376
377define hook-run
378 xreload
379end
380
381# Call xreload if a new Emacs executable is loaded.
382define hookpost-run
383 xreload
384end
385
386set print pretty on
387set print sevenbit-strings
388
389# show environment DISPLAY
390# show environment TERM
391# set args -geometry 80x40+0+0
392
393# Don't let abort actually run, as it will make
394# stdio stop working and therefore the `pr' command above as well.
395# break abort
396
397# If we are running in synchronous mode, we want a chance to look around
398# before Emacs exits. Perhaps we should put the break somewhere else
399# instead...
400# break x_error_quitter
diff --git a/src/Makefile.in b/src/Makefile.in
index 3a4b0cf0ec2..085f25c2758 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -572,6 +572,7 @@ XMENU_OBJ = xmenu.o
572/* lastfile must follow all files 572/* lastfile must follow all files
573 whose initialized data areas should be dumped as pure by dump-emacs. */ 573 whose initialized data areas should be dumped as pure by dump-emacs. */
574obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ 574obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \
575 bidi.o \
575 charset.o coding.o category.o ccl.o character.o chartab.o \ 576 charset.o coding.o category.o ccl.o character.o chartab.o \
576 cm.o term.o xfaces.o $(XOBJ) \ 577 cm.o term.o xfaces.o $(XOBJ) \
577 emacs.o keyboard.o macros.o keymap.o sysdep.o \ 578 emacs.o keyboard.o macros.o keymap.o sysdep.o \
@@ -1047,6 +1048,7 @@ alloca.o : alloca.s $(config_h)
1047 1048
1048abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \ 1049abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \
1049 $(config_h) 1050 $(config_h)
1051bidi.o: bidi.c buffer.h character.h
1050buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ 1052buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \
1051 dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h character.h \ 1053 dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h character.h \
1052 $(config_h) 1054 $(config_h)
diff --git a/src/alloca.s b/src/alloca.s
new file mode 100644
index 00000000000..0833cba997c
--- /dev/null
+++ b/src/alloca.s
@@ -0,0 +1,350 @@
1/* `alloca' standard 4.2 subroutine for 68000's and 16000's and others.
2 Also has _setjmp and _longjmp for pyramids.
3 Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
4
5 This program is free software; you can redistribute it and/or modify it
6 under the terms of the GNU General Public License as published by the
7 Free Software Foundation; either version 2, or (at your option) any
8 later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License along
16 with this program; if not, write to the Free Software Foundation, Inc.,
17 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
18
19/* Both 68000 systems I have run this on have had broken versions of alloca.
20 Also, I am told that non-berkeley systems do not have it at all.
21 So replace whatever system-provided alloca there may be
22 on all 68000 systems. */
23
24#define NOT_C_CODE
25#ifdef emacs
26#include <config.h>
27#else
28#include "config.h"
29#endif
30
31#ifndef HAVE_ALLOCA /* define this to use system's alloca */
32
33#ifndef hp9000s300
34#ifndef m68k
35#ifndef m68000
36#ifndef WICAT
37#ifndef ns32000
38#ifndef ns16000
39#ifndef sequent
40#ifndef pyramid
41#ifndef ATT3B5
42#ifndef XENIX
43you
44lose!!
45#endif /* XENIX */
46#endif /* ATT3B5 */
47#endif /* pyramid */
48#endif /* sequent */
49#endif /* ns16000 */
50#endif /* ns32000 */
51#endif /* WICAT */
52#endif /* m68000 */
53#endif /* m68k */
54#endif /* hp9000s300 */
55
56
57#ifdef hp9000s300
58#ifdef OLD_HP_ASSEMBLER
59 data
60 text
61 globl _alloca
62_alloca
63 move.l (sp)+,a0 ; pop return addr from top of stack
64 move.l (sp)+,d0 ; pop size in bytes from top of stack
65 add.l #ROUND,d0 ; round size up to long word
66 and.l #MASK,d0 ; mask out lower two bits of size
67 sub.l d0,sp ; allocate by moving stack pointer
68 tst.b PROBE(sp) ; stack probe to allocate pages
69 move.l sp,d0 ; return pointer
70 add.l #-4,sp ; new top of stack
71 jmp (a0) ; not a normal return
72MASK equ -4 ; Longword alignment
73ROUND equ 3 ; ditto
74PROBE equ -128 ; safety buffer for C compiler scratch
75 data
76#else /* new hp assembler syntax */
77/*
78 The new compiler does "move.m <registers> (%sp)" to save registers,
79 so we must copy the saved registers when we mung the sp.
80 The old compiler did "move.m <register> <offset>(%a6)", which
81 gave us no trouble
82 */
83 text
84 set PROBE,-128 # safety for C frame temporaries
85 set MAXREG,22 # d2-d7, a2-a5, fp2-fp7 may have been saved
86 global _alloca
87_alloca:
88 mov.l (%sp)+,%a0 # return address
89 mov.l (%sp)+,%d0 # number of bytes to allocate
90 mov.l %sp,%a1 # save old sp for register copy
91 mov.l %sp,%d1 # compute new sp
92 sub.l %d0,%d1 # space requested
93 and.l &-4,%d1 # round down to longword
94 sub.l &MAXREG*4,%d1 # space for saving registers
95 mov.l %d1,%sp # save new value of sp
96 tst.b PROBE(%sp) # create pages (sigh)
97 mov.l %a2,%d1 # save reg a2
98 mov.l %sp,%a2
99 move.w &MAXREG-1,%d0
100copy_regs_loop: /* save caller's saved registers */
101 mov.l (%a1)+,(%a2)+
102 dbra %d0,copy_regs_loop
103 mov.l %a2,%d0 # return value
104 mov.l %d1,%a2 # restore a2
105 add.l &-4,%sp # adjust tos
106 jmp (%a0) # rts
107#endif /* new hp assembler */
108#else
109#ifdef m68k /* SGS assembler totally different */
110 file "alloca.s"
111 global alloca
112alloca:
113#ifdef MOTOROLA_DELTA
114/* slightly modified version of alloca to motorola sysV/68 pcc - based
115 compiler.
116 this compiler saves used registers relative to %sp instead of %fp.
117 alright, just make new copy of saved register set whenever we allocate
118 new space from stack..
119 this is true at last until SVR3V7 . bug has reported to Motorola. */
120 set MAXREG,10 # max no of registers to save (d2-d7, a2-a5)
121 mov.l (%sp)+,%a1 # pop return addr from top of stack
122 mov.l (%sp)+,%d0 # pop size in bytes from top of stack
123 mov.l %sp,%a0 # save stack pointer for register copy
124 addq.l &3,%d0 # round size up to long word
125 andi.l &-4,%d0 # mask out lower two bits of size
126 mov.l %sp,%d1 # compute new value of sp to d1
127 sub.l %d0,%d1 # pseudo-allocate by moving stack pointer
128 sub.l &MAXREG*4,%d1 # allocate more space for saved regs.
129 mov.l %d1,%sp # actual allocation.
130 move.w &MAXREG-1,%d0 # d0 counts saved regs.
131 mov.l %a2,%d1 # preserve a2.
132 mov.l %sp,%a2 # make pointer to new reg save area.
133copy_regs_loop: # copy stuff from old save area.
134 mov.l (%a0)+,(%a2)+ # save saved register
135 dbra %d0,copy_regs_loop
136 mov.l %a2,%a0 # now a2 is start of allocated space.
137 mov.l %a2,%d0 # return it in both a0 and d0 to play safe.
138 mov.l %d1,%a2 # restore a2.
139 subq.l &4,%sp # new top of stack
140 jmp (%a1) # far below normal return
141#else /* not MOTOROLA_DELTA */
142 mov.l (%sp)+,%a1 # pop return addr from top of stack
143 mov.l (%sp)+,%d0 # pop size in bytes from top of stack
144 add.l &R%1,%d0 # round size up to long word
145 and.l &-4,%d0 # mask out lower two bits of size
146 sub.l %d0,%sp # allocate by moving stack pointer
147 tst.b P%1(%sp) # stack probe to allocate pages
148 mov.l %sp,%a0 # return pointer as pointer
149 mov.l %sp,%d0 # return pointer as int to avoid disaster
150 add.l &-4,%sp # new top of stack
151 jmp (%a1) # not a normal return
152 set S%1,64 # safety factor for C compiler scratch
153 set R%1,3+S%1 # add to size for rounding
154 set P%1,-132 # probe this far below current top of stack
155#endif /* not MOTOROLA_DELTA */
156
157#else /* not m68k */
158
159#ifdef m68000
160
161#ifdef WICAT
162/*
163 * Registers are saved after the corresponding link so we have to explicitly
164 * move them to the top of the stack where they are expected to be.
165 * Since we do not know how many registers were saved in the calling function
166 * we must assume the maximum possible (d2-d7,a2-a5). Hence, we end up
167 * wasting some space on the stack.
168 *
169 * The large probe (tst.b) attempts to make up for the fact that we have
170 * potentially used up the space that the caller probed for its own needs.
171 */
172 .procss m0
173 .config "68000 1"
174 .module _alloca
175MAXREG: .const 10
176 .sect text
177 .global _alloca
178_alloca:
179 move.l (sp)+,a1 ; pop return address
180 move.l (sp)+,d0 ; pop allocation size
181 move.l sp,d1 ; get current SP value
182 sub.l d0,d1 ; adjust to reflect required size...
183 sub.l #MAXREG*4,d1 ; ...and space needed for registers
184 and.l #-4,d1 ; backup to longword boundary
185 move.l sp,a0 ; save old SP value for register copy
186 move.l d1,sp ; set the new SP value
187 tst.b -4096(sp) ; grab an extra page (to cover caller)
188 move.l a2,d1 ; save callers register
189 move.l sp,a2
190 move.w #MAXREG-1,d0 ; # of longwords to copy
191loop: move.l (a0)+,(a2)+ ; copy registers...
192 dbra d0,loop ; ...til there are no more
193 move.l a2,d0 ; end of register area is addr for new space
194 move.l d1,a2 ; restore saved a2.
195 addq.l #4,sp ; caller will increment sp by 4 after return.
196 move.l d0,a0 ; return value in both a0 and d0.
197 jmp (a1)
198 .end _alloca
199#else
200
201/* Some systems want the _, some do not. Win with both kinds. */
202.globl _alloca
203_alloca:
204.globl alloca
205alloca:
206 movl sp@+,a0
207 movl a7,d0
208 subl sp@,d0
209 andl #~3,d0
210 movl d0,sp
211 tstb sp@(0) /* Make stack pages exist */
212 /* Needed on certain systems
213 that lack true demand paging */
214 addql #4,d0
215 jmp a0@
216
217#endif /* not WICAT */
218#endif /* m68000 */
219#endif /* not m68k */
220#endif /* not hp9000s300 */
221
222#if defined (ns16000) || defined (ns32000)
223
224 .text
225 .align 2
226/* Some systems want the _, some do not. Win with both kinds. */
227.globl _alloca
228_alloca:
229.globl alloca
230alloca:
231
232/* Two different assembler syntaxes are used for the same code
233 on different systems. */
234
235#ifdef sequent
236#define IM
237#define REGISTER(x) x
238#else
239#ifdef NS5 /* ns SysV assembler */
240#define IM $
241#define REGISTER(x) x
242#else
243#define IM $
244#define REGISTER(x) 0(x)
245#endif
246#endif
247
248/*
249 * The ns16000 is a little more difficult, need to copy regs.
250 * Also the code assumes direct linkage call sequence (no mod table crap).
251 * We have to copy registers, and therefore waste 32 bytes.
252 *
253 * Stack layout:
254 * new sp -> junk
255 * registers (copy)
256 * r0 -> new data
257 * | (orig retval)
258 * | (orig arg)
259 * old sp -> regs (orig)
260 * local data
261 * fp -> old fp
262 */
263
264 movd tos,r1 /* pop return addr */
265 negd tos,r0 /* pop amount to allocate */
266 sprd sp,r2
267 addd r2,r0
268 bicb IM/**/3,r0 /* 4-byte align */
269 lprd sp,r0
270 adjspb IM/**/36 /* space for regs, +4 for caller to pop */
271 movmd 0(r2),4(sp),IM/**/4 /* copy regs */
272 movmd 0x10(r2),0x14(sp),IM/**/4
273 jump REGISTER(r1) /* funky return */
274#endif /* ns16000 or ns32000 */
275
276#ifdef pyramid
277
278.globl _alloca
279
280_alloca: addw $3,pr0 # add 3 (dec) to first argument
281 bicw $3,pr0 # then clear its last 2 bits
282 subw pr0,sp # subtract from SP the val in PR0
283 andw $-32,sp # keep sp aligned on multiple of 32.
284 movw sp,pr0 # ret. current SP
285 ret
286
287#ifdef PYRAMID_OLD /* This isn't needed in system version 4. */
288.globl __longjmp
289.globl _longjmp
290.globl __setjmp
291.globl _setjmp
292
293__longjmp: jump _longjmp
294__setjmp: jump _setjmp
295#endif
296
297#endif /* pyramid */
298
299#ifdef ATT3B5
300
301 .align 4
302 .globl alloca
303
304alloca:
305 movw %ap, %r8
306 subw2 $9*4, %r8
307 movw 0(%r8), %r1 /* pc */
308 movw 4(%r8), %fp
309 movw 8(%r8), %sp
310 addw2 %r0, %sp /* make room */
311 movw %sp, %r0 /* return value */
312 jmp (%r1) /* continue... */
313
314#endif /* ATT3B5 */
315
316#ifdef XENIX
317
318.386
319
320_TEXT segment dword use32 public 'CODE'
321assume cs:_TEXT
322
323;-------------------------------------------------------------------------
324
325public _alloca
326_alloca proc near
327
328 pop ecx ; return address
329 pop eax ; amount to alloc
330 add eax,3 ; round it to 32-bit boundary
331 and al,11111100B ;
332 mov edx,esp ; current sp in edx
333 sub edx,eax ; lower the stack
334 xchg esp,edx ; start of allocation in esp, old sp in edx
335 mov eax,esp ; return ptr to base in eax
336 push [edx+8] ; save poss. stored reg. values (esi,edi,ebx)
337 push [edx+4] ; on lowered stack
338 push [edx] ;
339 sub esp,4 ; allow for 'add esp, 4'
340 jmp ecx ; jump to return address
341
342_alloca endp
343
344_TEXT ends
345
346end
347
348#endif /* XENIX */
349
350#endif /* not HAVE_ALLOCA */
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-12 07:06:34 +0000