From 4ca81955be9b7fed99f1300f8a96102b3b2b5dc5 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Wed, 3 Mar 2004 23:50:41 +0000 Subject: [PATCH] (obj): Include bidi.o. (bidi.o): New target. (xdisp.o): Depend on bidi.h. --- INSTALL-CVS | 44 + lisp/emacs-lisp/testcover-ses.el | 711 ++++++ lisp/emacs-lisp/testcover-unsafep.el | 139 ++ lisp/gdb-ui.el | 2461 +++++++++++++++++++ lisp/toolbar/gud-display.pbm | Bin 0 -> 81 bytes lisp/toolbar/gud-display.xpm | 29 + lisp/toolbar/gud-next.pbm | Bin 0 -> 81 bytes lisp/toolbar/gud-next.xpm | 34 + lisp/toolbar/gud-nexti.pbm | Bin 0 -> 81 bytes lisp/toolbar/gud-nexti.xpm | 33 + lisp/toolbar/gud-step.pbm | Bin 0 -> 81 bytes lisp/toolbar/gud-step.xpm | 33 + lisp/toolbar/gud-stepi.pbm | Bin 0 -> 81 bytes lisp/toolbar/gud-stepi.xpm | 32 + lispref/index.perm | 38 + lispref/index.unperm | 29 + lispref/permute-index | 124 + mac/Emacs.app/Contents/Resources/Emacs.rsrc | Bin 0 -> 6058 bytes man/kmacro.texi | 522 ---- nt/envadd.bat | 48 - nt/multi-install-info.bat | 45 - src/.gdbinit-union | 400 +++ src/Makefile.in | 2 + src/alloca.s | 350 +++ 24 files changed, 4459 insertions(+), 615 deletions(-) create mode 100755 INSTALL-CVS create mode 100644 lisp/emacs-lisp/testcover-ses.el create mode 100644 lisp/emacs-lisp/testcover-unsafep.el create mode 100644 lisp/gdb-ui.el create mode 100644 lisp/toolbar/gud-display.pbm create mode 100644 lisp/toolbar/gud-display.xpm create mode 100644 lisp/toolbar/gud-next.pbm create mode 100644 lisp/toolbar/gud-next.xpm create mode 100644 lisp/toolbar/gud-nexti.pbm create mode 100644 lisp/toolbar/gud-nexti.xpm create mode 100644 lisp/toolbar/gud-step.pbm create mode 100644 lisp/toolbar/gud-step.xpm create mode 100644 lisp/toolbar/gud-stepi.pbm create mode 100644 lisp/toolbar/gud-stepi.xpm create mode 100644 lispref/index.perm create mode 100644 lispref/index.unperm create mode 100644 lispref/permute-index create mode 100644 mac/Emacs.app/Contents/Resources/Emacs.rsrc delete mode 100644 man/kmacro.texi delete mode 100644 nt/envadd.bat delete mode 100644 nt/multi-install-info.bat create mode 100644 src/.gdbinit-union create mode 100644 src/alloca.s diff --git a/INSTALL-CVS b/INSTALL-CVS new file mode 100755 index 00000000000..779262bfa63 --- /dev/null +++ b/INSTALL-CVS @@ -0,0 +1,44 @@ + Building and Installing Emacs from CVS + +Some of the files that are included in the Emacs tarball, such as +byte-compiled Lisp files, are not stored in the CVS repository. +Therefore, to build from CVS you must run "make bootstrap" +instead of just "make": + + $ ./configure + $ make bootstrap + +The bootstrap process makes sure all necessary files are rebuilt +before it builds the final Emacs binary. + +Normally, it is not necessary to use "make bootstrap" after every CVS +update. Unless there are problems, we suggest the following +procedure: + + $ ./configure + $ make + $ cd lisp + $ make recompile EMACS=../src/emacs + $ cd .. + $ make + +(If you want to install the Emacs binary, type "make install" instead +of "make" in the last command.) + +If the above procedure fails, try "make bootstrap". + +Users of non-Posix systems (MS-Windows etc.) should run the +platform-specific configuration scripts (nt/configure.bat, config.bat, +etc.) before "make bootstrap" or "make"; the rest of the procedure is +applicable to those systems as well. + +Note that "make bootstrap" overwrites some files that are under CVS +control, such as lisp/loaddefs.el. This could produce CVS conflicts +next time that you resync with the CVS. If you see such conflicts, +overwrite your local copy of the file with the clean version from the +CVS repository. For example: + + cvs update -C lisp/loaddefs.el + +Questions, requests, and bug reports about the CVS versions of Emacs +sould 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 @@ +;;;; testcover-ses.el -- Example use of `testcover' to test "SES" + +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Jonathan Yavner +;; Maintainer: Jonathan Yavner +;; Keywords: spreadsheet lisp utility + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(require 'testcover) + +;;;Here are some macros that exercise SES. Set `pause' to t if you want the +;;;macros to pause after each step. +(let* ((pause nil) + (x (if pause "q" "")) + (y "ses-test.ses\r<")) + ;;Fiddle with the existing spreadsheet + (fset 'ses-exercise-example + (concat "" data-directory "ses-example.ses\r<" + x "10" + x " " + x "" + x "pses-center\r" + x "p\r" + x "\t\t" + x "\r A9 B9\r" + x "" + x "\r 2\r" + x "" + x "50\r" + x "4" + x " " + x "" + x "(+ o\0" + x "-1o \r" + x "" + x)) + ;;Create a new spreadsheet + (fset 'ses-exercise-new + (concat y + x "\"%.8g\"\r" + x "2\r" + x "" + x "" + x "2" + x "\"Header\r" + x "(sqrt 1\r" + x "pses-center\r" + x "\t" + x "(+ A2 A3\r" + x "(* B2 A3\r" + x "2" + x "\rB3\r" + x "" + x)) + ;;Basic cell display + (fset 'ses-exercise-display + (concat y ":(revert-buffer t t)\r" + x "" + x "\"Very long\r" + x "w3\r" + x "w3\r" + x "(/ 1 0\r" + x "234567\r" + x "5w" + x "\t1\r" + x "" + x "234567\r" + x "\t" + x "" + x "345678\r" + x "3w" + x "\0>" + x "" + x "" + x "" + x "" + x "" + x "" + x "" + x "1\r" + x "" + x "" + x "\"1234567-1234567-1234567\r" + x "123\r" + x "2" + x "\"1234567-1234567-1234567\r" + x "123\r" + x "w8\r" + x "\"1234567\r" + x "w5\r" + x)) + ;;Cell formulas + (fset 'ses-exercise-formulas + (concat y ":(revert-buffer t t)\r" + x "\t\t" + x "\t" + x "(* B1 B2 D1\r" + x "(* B2 B3\r" + x "(apply '+ (ses-range B1 B3)\r" + x "(apply 'ses+ (ses-range B1 B3)\r" + x "(apply 'ses+ (ses-range A2 A3)\r" + x "(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r" + x "(apply 'concat (reverse (ses-range A3 D3))\r" + x "(* (+ A2 A3) (ses+ B2 B3)\r" + x "" + x "2" + x "5\t" + x "(apply 'ses+ (ses-range E1 E2)\r" + x "(apply 'ses+ (ses-range A5 B5)\r" + x "(apply 'ses+ (ses-range E1 F1)\r" + x "(apply 'ses+ (ses-range D1 E1)\r" + x "\t" + x "(ses-average (ses-range A2 A5)\r" + x "(apply 'ses+ (ses-range A5 A6)\r" + x "k" + x " " + x "" + x "2" + x "3 " + x "o" + x "2o" + x "3k" + x "(ses-average (ses-range B3 E3)\r" + x "k" + x "12345678\r" + x)) + ;;Recalculating and reconstructing + (fset 'ses-exercise-recalc + (concat y ":(revert-buffer t t)\r" + x " " + x "\t\t" + x "" + x "(/ 1 0\r" + x "" + x "\n" + x "" + x "\"%.6g\"\r" + x " " + x ">nw" + x "\0>xdelete-region\r" + x " " + x "8" + x "\0>xdelete-region\r" + x " " + x "" + x " k" + x " " + x "\"Very long\r" + x "" + x "\r\r" + x "" + x "o" + x "" + x "\"Very long2\r" + x "o" + x "" + x "\rC3\r" + x "\rC2\r" + x "\0" + x "\rC4\r" + x "\rC2\r" + x "\0" + x "" + x "xses-mode\r" + x "<" + x "2k" + x)) + ;;Header line + (fset 'ses-exercise-header-row + (concat y ":(revert-buffer t t)\r" + x "<" + x ">" + x "6<" + x ">" + x "7<" + x ">" + x "8<" + x "2<" + x ">" + x "3w" + x "10<" + x ">" + x "2 " + x)) + ;;Detecting unsafe formulas and printers + (fset 'ses-exercise-unsafe + (concat y ":(revert-buffer t t)\r" + x "p(lambda (x) (delete-file x))\rn" + x "p(lambda (x) (delete-file \"ses-nothing\"))\ry" + x "\0n" + x "(delete-file \"x\"\rn" + x "(delete-file \"ses-nothing\"\ry" + x "\0n" + x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry" + x "\0n" + x)) + ;;Inserting and deleting rows + (fset 'ses-exercise-rows + (concat y ":(revert-buffer t t)\r" + x "" + x "\"%s=\"\r" + x "20" + x "p\"%s+\"\r" + x "" + x "123456789\r" + x "\021" + x "" + x " " + x "(not B25\r" + x "k" + x "jA3\r" + x "19 " + x " " + x "100" ;Make this approx your CPU speed in MHz + x)) + ;;Inserting and deleting columns + (fset 'ses-exercise-columns + (concat y ":(revert-buffer t t)\r" + x "\"%s@\"\r" + x "o" + x "" + x "o" + x " " + x "k" + x "w8\r" + x "p\"%.7s*\"\r" + x "o" + x "" + x "2o" + x "3k" + x "\"%.6g\"\r" + x "26o" + x "\026\t" + x "26o" + x "0\r" + x "26\t" + x "400" + x "50k" + x "\0D" + x)) + (fset 'ses-exercise-editing + (concat y ":(revert-buffer t t)\r" + x "1\r" + x "('x\r" + x "" + x "" + x "\r\r" + x "w9\r" + x "\r.5\r" + x "\r 10\r" + x "w12\r" + x "\r'\r" + x "\r\r" + x "jA4\r" + x "(+ A2 100\r" + x "3\r" + x "jB1\r" + x "(not A1\r" + x "\"Very long\r" + x "" + x "h" + x "H" + x "" + x ">\t" + x "" + x "" + x "2" + x "" + x "o" + x "h" + x "\0" + x "\"Also very long\r" + x "H" + x "\0'\r" + x "'Trial\r" + x "'qwerty\r" + x "(concat o<\0" + x "-1o\r" + x "(apply '+ o<\0-1o\r" + x "2" + x "-2" + x "-2" + x "2" + x " " + x "H" + x "\0" + x "\"Another long one\r" + x "H" + x "" + x "<" + x "" + x ">" + x "\0" + x)) + ;;Sorting of columns + (fset 'ses-exercise-sort-column + (concat y ":(revert-buffer t t)\r" + x "\"Very long\r" + x "99\r" + x "o13\r" + x "(+ A3 B3\r" + x "7\r8\r(* A4 B4\r" + x "\0A\r" + x "\0B\r" + x "\0C\r" + x "o" + x "\0C\r" + x)) + ;;Simple cell printers + (fset 'ses-exercise-cell-printers + (concat y ":(revert-buffer t t)\r" + x "\"4\t76\r" + x "\"4\n7\r" + x "p\"{%S}\"\r" + x "p(\"[%s]\")\r" + x "p(\"<%s>\")\r" + x "\0" + x "p\r" + x "pnil\r" + x "pses-dashfill\r" + x "48\r" + x "\t" + x "\0p\r" + x "p\r" + x "pses-dashfill\r" + x "\0pnil\r" + x "5\r" + x "pses-center\r" + x "\"%s\"\r" + x "w8\r" + x "p\r" + x "p\"%.7g@\"\r" + x "\r" + x "\"%.6g#\"\r" + x "\"%.6g.\"\r" + x "\"%.6g.\"\r" + x "pidentity\r" + x "6\r" + x "\"UPCASE\r" + x "pdowncase\r" + x "(* 3 4\r" + x "p(lambda (x) '(\"Hi\"))\r" + x "p(lambda (x) '(\"Bye\"))\r" + x)) + ;;Spanning cell printers + (fset 'ses-exercise-spanning-printers + (concat y ":(revert-buffer t t)\r" + x "p\"%.6g*\"\r" + x "pses-dashfill-span\r" + x "5\r" + x "pses-tildefill-span\r" + x "\"4\r" + x "p\"$%s\"\r" + x "p(\"$%s\")\r" + x "8\r" + x "p(\"!%s!\")\r" + x "\t\"12345678\r" + x "pses-dashfill-span\r" + x "\"23456789\r" + x "\t" + x "(not t\r" + x "w6\r" + x "\"5\r" + x "o" + x "k" + x "k" + x "\t" + x "" + x "o" + x "2k" + x "k" + x)) + ;;Cut/copy/paste - within same buffer + (fset 'ses-exercise-paste-1buf + (concat y ":(revert-buffer t t)\r" + x "\0w" + x "" + x "o" + x "\"middle\r" + x "\0" + x "w" + x "\0" + x "w" + x "" + x "" + x "2y" + x "y" + x "y" + x ">" + x "y" + x ">y" + x "<" + x "p\"<%s>\"\r" + x "pses-dashfill\r" + x "\0" + x "" + x "" + x "y" + x "\r\0w" + x "\r" + x "3(+ G2 H1\r" + x "\0w" + x ">" + x "" + x "8(ses-average (ses-range G2 H2)\r" + x "\0k" + x "7" + x "" + x "(ses-average (ses-range E7 E9)\r" + x "\0 " + x "" + x "(ses-average (ses-range E7 F7)\r" + x "\0k" + x "" + x "(ses-average (ses-range D6 E6)\r" + x "\0k" + x "" + x "2" + x "\"Line A\r" + x "pses-tildefill-span\r" + x "\"Subline A(1)\r" + x "pses-dashfill-span\r" + x "\0w" + x "" + x "" + x "\0w" + x "" + x)) + ;;Cut/copy/paste - between two buffers + (fset 'ses-exercise-paste-2buf + (concat y ":(revert-buffer t t)\r" + x "o\"middle\r\0" + x "" + x "4bses-test.txt\r" + x " " + x "\"xxx\0" + x "wo" + x "" + x "" + x "o\"\0" + x "wo" + x "o123.45\0" + x "o" + x "o1 \0" + x "o" + x ">y" + x "o symb\0" + x "oy2y" + x "o1\t\0" + x "o" + x "w9\np\"<%s>\"\n" + x "o\n2\t\"3\nxxx\t5\n\0" + x "oy" + x)) + ;;Export text, import it back + (fset 'ses-exercise-import-export + (concat y ":(revert-buffer t t)\r" + x "\0xt" + x "4bses-test.txt\r" + x "\n-1o" + x "xTo-1o" + x "'crunch\r" + x "pses-center-span\r" + x "\0xT" + x "o\n-1o" + x "\0y" + x "\0xt" + x "\0y" + x "12345678\r" + x "'bunch\r" + x "\0xtxT" + x))) + +(defun ses-exercise-macros () + "Executes all SES coverage-test macros." + (dolist (x '(ses-exercise-example + ses-exercise-new + ses-exercise-display + ses-exercise-formulas + ses-exercise-recalc + ses-exercise-header-row + ses-exercise-unsafe + ses-exercise-rows + ses-exercise-columns + ses-exercise-editing + ses-exercise-sort-column + ses-exercise-cell-printers + ses-exercise-spanning-printers + ses-exercise-paste-1buf + ses-exercise-paste-2buf + ses-exercise-import-export)) + (message "" x) + (execute-kbd-macro x))) + +(defun ses-exercise-signals () + "Exercise code paths that lead to error signals, other than those for +spreadsheet files with invalid formatting." + (message "") + (switch-to-buffer "ses-test.ses") + (deactivate-mark) + (ses-jump 'A1) + (ses-set-curcell) + (dolist (x '((ses-column-widths 14) + (ses-column-printers "%s") + (ses-column-printers ["%s" "%s" "%s"]) ;Should be two + (ses-column-widths [14]) + (ses-delete-column -99) + (ses-delete-column 2) + (ses-delete-row -1) + (ses-goto-data 'hogwash) + (ses-header-row -56) + (ses-header-row 99) + (ses-insert-column -14) + (ses-insert-row 0) + (ses-jump 'B8) ;Covered by preceding cell + (ses-printer-validate '("%s" t)) + (ses-printer-validate '([47])) + (ses-read-header-row -1) + (ses-read-header-row 32767) + (ses-relocate-all 0 0 -1 1) + (ses-relocate-all 0 0 1 -1) + (ses-select (ses-range A1 A2) 'x (ses-range B1 B1)) + (ses-set-cell 0 0 'hogwash nil) + (ses-set-column-width 0 0) + (ses-yank-cells #("a\nb" + 0 1 (ses (A1 nil nil)) + 2 3 (ses (A3 nil nil))) + nil) + (ses-yank-cells #("ab" + 0 1 (ses (A1 nil nil)) + 1 2 (ses (A2 nil nil))) + nil) + (ses-yank-pop nil) + (ses-yank-tsf "1\t2\n3" nil) + (let ((curcell nil)) (ses-check-curcell)) + (let ((curcell 'A1)) (ses-check-curcell 'needrange)) + (let ((curcell '(A1 . A2))) (ses-check-curcell 'end)) + (let ((curcell '(A1 . A2))) (ses-sort-column "B")) + (let ((curcell '(C1 . D2))) (ses-sort-column "B")) + (execute-kbd-macro "jB10\n2") + (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut]) + (progn (kill-new "x") (execute-kbd-macro ">n")) + (execute-kbd-macro "\0w"))) + (condition-case nil + (progn + (eval x) + (signal 'singularity-error nil)) ;Shouldn't get here + (singularity-error (error "No error from %s?" x)) + (error nil))) + ;;Test quit-handling in ses-update-cells. Cant' use `eval' here. + (let ((inhibit-quit t)) + (setq quit-flag t) + (condition-case nil + (progn + (ses-update-cells '(A1)) + (signal 'singularity-error nil)) + (singularity-error (error "Quit failure in ses-update-cells")) + (error nil)) + (setq quit-flag nil))) + +(defun ses-exercise-invalid-spreadsheets () + "Execute code paths that detect invalid spreadsheet files." + ;;Detect invalid spreadsheets + (let ((p&d "\n\n \n(ses-cell A1 nil nil nil nil)\n\n") + (cw "(ses-column-widths [7])\n") + (cp "(ses-column-printers [ses-center])\n") + (dp "(ses-default-printer \"%.7g\")\n") + (hr "(ses-header-row 0)\n") + (p11 "(2 1 1)") + (igp ses-initial-global-parameters)) + (dolist (x (list "(1)" + "(x 2 3)" + "(1 x 3)" + "(1 -1 0)" + "(1 2 x)" + "(1 2 -1)" + "(3 1 1)" + "\n\n (2 1 1)" + "\n\n \n(ses-cell)(2 1 1)" + "\n\n \n(x)\n(2 1 1)" + "\n\n\n \n(ses-cell A2)\n(2 2 2)" + "\n\n\n \n(ses-cell B1)\n(2 2 2)" + "\n\n \n(ses-cell A1 nil nil nil nil)\n(2 1 1)" + (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11) + (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11) + (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)") + (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11) + (concat p&d cw cp "(x)\n(x)\n" p11) + (concat p&d cw cp "(ses-default-printer)(x)\n" p11) + (concat p&d cw cp dp "(x)\n" p11) + (concat p&d cw cp dp "(ses-header-row)" p11) + (concat p&d cw cp dp hr p11) + (concat p&d cw cp dp "\n" hr igp))) + (condition-case nil + (with-temp-buffer + (insert x) + (ses-load) + (signal 'singularity-error nil)) ;Shouldn't get here + (singularity-error (error "%S is an invalid spreadsheet!" x)) + (error nil))))) + +(defun ses-exercise-startup () + "Prepare for coverage tests" + ;;Clean up from any previous runs + (condition-case nil (kill-buffer "ses-example.ses") (error nil)) + (condition-case nil (kill-buffer "ses-test.ses") (error nil)) + (condition-case nil (delete-file "ses-test.ses") (file-error nil)) + (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing + (setq ses-mode-map nil) ;Force rebuild + (testcover-unmark-all "ses.el") + ;;Enable + (let ((testcover-1value-functions + ;;forward-line always returns 0, for us. + ;;remove-text-properties always returns t for us. + ;;ses-recalculate-cell returns the same " " any time curcell is a cons + ;;Macros ses-dorange and ses-dotimes-msg generate code that always + ;; returns nil + (append '(forward-line remove-text-properties ses-recalculate-cell + ses-dorange ses-dotimes-msg) + testcover-1value-functions)) + (testcover-constants + ;;These maps get initialized, then never changed again + (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map) + testcover-constants))) + (testcover-start "ses.el" t)) + (require 'unsafep)) ;In case user has safe-functions = t! + + +;;;######################################################################### +(defun ses-exercise () + "Executes all SES coverage tests and displays the results." + (interactive) + (ses-exercise-startup) + ;;Run the keyboard-macro tests + (let ((safe-functions nil) + (ses-initial-size '(1 . 1)) + (ses-initial-column-width 7) + (ses-initial-default-printer "%.7g") + (ses-after-entry-functions '(forward-char)) + (ses-mode-hook nil)) + (ses-exercise-macros) + (ses-exercise-signals) + (ses-exercise-invalid-spreadsheets) + ;;Upgrade of old-style spreadsheet + (with-temp-buffer + (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") + (ses-load)) + ;;ses-vector-delete is always called from buffer-undo-list with the same + ;;symbol as argument. We'll give it a different one here. + (let ((x [1 2 3])) + (ses-vector-delete 'x 0 0)) + ;;ses-create-header-string behaves differently in a non-window environment + ;;but we always test under windows. + (let ((window-system (not window-system))) + (scroll-left 7) + (ses-create-header-string)) + ;;Test for nonstandard after-entry functions + (let ((ses-after-entry-functions '(forward-line)) + ses-mode-hook) + (ses-read-cell 0 0 1) + (ses-read-symbol 0 0 t))) + ;;Tests with unsafep disabled + (let ((safe-functions t) + ses-mode-hook) + (message "") + (kill-buffer "ses-example.ses") + (find-file "ses-example.ses")) + ;;Checks for nonstandard default values for new spreadsheets + (let (ses-mode-hook) + (dolist (x '(("%.6g" 8 (2 . 2)) + ("%.8g" 6 (3 . 3)))) + (let ((ses-initial-size (nth 2 x)) + (ses-initial-column-width (nth 1 x)) + (ses-initial-default-printer (nth 0 x))) + (with-temp-buffer + (set-buffer-modified-p t) + (ses-mode))))) + ;;Test error-handling in command hook, outside a macro. + ;;This will ring the bell. + (let (curcell-overlay) + (ses-command-hook)) + ;;Due to use of run-with-timer, ses-command-hook sometimes gets called + ;;after we switch to another buffer. + (switch-to-buffer "*scratch*") + (ses-command-hook) + ;;Print results + (message "") + (testcover-mark-all "ses.el") + (testcover-next-mark) + ;;Cleanup + (delete-other-windows) + (kill-buffer "ses-test.txt") + ;;Could do this here: (testcover-end "ses.el") + (message "Done")) + +;; 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 @@ +;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage + +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; Author: Jonathan Yavner +;; Maintainer: Jonathan Yavner +;; Keywords: safety lisp utility + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(require 'testcover) + +;;;These forms are all considered safe +(defconst testcover-unsafep-safe + '(((lambda (x) (* x 2)) 14) + (apply 'cdr (mapcar '(lambda (x) (car x)) y)) + (cond ((= x 4) 5) (t 27)) + (condition-case x (car y) (error (car x))) + (dolist (x y) (message "here: %s" x)) + (dotimes (x 14 (* x 2)) (message "here: %d" x)) + (let (x) (dolist (y '(1 2 3) (1+ y)) (push y x))) + (let (x) (apply '(lambda (x) (* x 2)) 14)) + (let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2)) + (let ((x 1) (y 2)) (setq x (+ x y))) + (let ((x 1)) (let ((y (+ x 3))) (* x y))) + (let* nil (current-time)) + (let* ((x 1) (y (+ x 3))) (* x y)) + (mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3)) + (mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ") + (setq buffer-display-count 14 mark-active t) + ;;This is not safe if you insert it into a buffer! + (propertize "x" 'display '(height (progn (delete-file "x") 1)))) + "List of forms that `unsafep' should decide are safe.") + +;;;These forms are considered unsafe +(defconst testcover-unsafep-unsafe + '(( (add-to-list x y) + . (unquoted x)) + ( (add-to-list y x) + . (unquoted y)) + ( (add-to-list 'y x) + . (global-variable y)) + ( (not (delete-file "unsafep.el")) + . (function delete-file)) + ( (cond (t (aset local-abbrev-table 0 0))) + . (function aset)) + ( (cond (t (setq unsafep-vars ""))) + . (risky-local-variable unsafep-vars)) + ( (condition-case format-alist 1) + . (risky-local-variable format-alist)) + ( (condition-case x 1 (error (setq format-alist ""))) + . (risky-local-variable format-alist)) + ( (dolist (x (sort globalvar 'car)) (princ x)) + . (function sort)) + ( (dotimes (x 14) (delete-file "x")) + . (function delete-file)) + ( (let ((post-command-hook "/tmp/")) 1) + . (risky-local-variable post-command-hook)) + ( (let ((x (delete-file "x"))) 2) + . (function delete-file)) + ( (let (x) (add-to-list 'x (delete-file "x"))) + . (function delete-file)) + ( (let (x) (condition-case y (setq x 1 z 2))) + . (global-variable z)) + ( (let (x) (condition-case z 1 (error (delete-file "x")))) + . (function delete-file)) + ( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4)))) + . (function setcar)) + ( (let (y) (push (delete-file "x") y)) + . (function delete-file)) + ( (let* ((x 1)) (setq y 14)) + . (global-variable y)) + ( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el"))) + . (function kill-buffer)) + ( (mapcar x y) + . (unquoted x)) + ( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el")) + . (function rename-file)) + ( (mapconcat x1 x2 " ") + . (unquoted x1)) + ( (pop format-alist) + . (risky-local-variable format-alist)) + ( (push 1 format-alist) + . (risky-local-variable format-alist)) + ( (setq buffer-display-count (delete-file "x")) + . (function delete-file)) + ;;These are actualy safe (they signal errors) + ( (apply '(x) '(1 2 3)) + . (function (x))) + ( (let (((x))) 1) + . (variable (x))) + ( (let (1) 2) + . (variable 1)) + ) + "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.") + + +;;;######################################################################### +(defun testcover-unsafep () + "Executes all unsafep tests and displays the coverage results." + (interactive) + (testcover-unmark-all "unsafep.el") + (testcover-start "unsafep.el") + (let (save-functions) + (dolist (x testcover-unsafep-safe) + (if (unsafep x) + (error "%S should be safe" x))) + (dolist (x testcover-unsafep-unsafe) + (if (not (equal (unsafep (car x)) (cdr x))) + (error "%S should be unsafe: %s" (car x) (cdr x)))) + (setq safe-functions t) + (if (or (unsafep '(delete-file "x")) + (unsafep-function 'delete-file)) + (error "safe-functions=t should allow delete-file")) + (setq safe-functions '(setcar)) + (if (unsafep '(setcar x 1)) + (error "safe-functions=(setcar) should allow setcar")) + (if (not (unsafep '(setcdr x 1))) + (error "safe-functions=(setcar) should not allow setcdr"))) + (testcover-mark-all "unsafep.el") + (testcover-end "unsafep.el") + (message "Done")) + +;; 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 @@ +;;; gdb-ui.el --- User Interface for running GDB + +;; Author: Nick Roberts +;; Maintainer: FSF +;; Keywords: unix, tools + +;; Copyright (C) 2002 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This mode acts as a graphical user interface to GDB. You can interact with +;; GDB through the GUD buffer in the usual way, but there are also further +;; buffers which control the execution and describe the state of your program. +;; It separates the input/output of your program from that of GDB and displays +;; expressions and their current values in their own buffers. It also uses +;; features of Emacs 21 such as the display margin for breakpoints, and the +;; toolbar (see the GDB Graphical Interface section in the Emacs info manual). + +;; Start the debugger with M-x gdba. + +;; This file is based on gdba.el from GDB 5.0 written by Tom Lord and Jim +;; Kingdon and uses GDB's annotation interface. You don't need to know about +;; annotations to use this mode as a debugger, but if you are interested +;; developing the mode itself, then see the Annotations section in the GDB +;; info manual. +;; +;; Known Bugs: +;; Does not auto-display arrays of structures or structures containing arrays. +;; On MS Windows, Gdb 5.1.1 from MinGW 2.0 does not flush the output from the +;; inferior. + +;;; Code: + +(require 'gud) + +(defcustom gdb-window-height 20 + "Number of lines in a frame for a displayed expression in GDB-UI." + :type 'integer + :group 'gud) + +(defcustom gdb-window-width 30 + "Width of a frame for a displayed expression in GDB-UI." + :type 'integer + :group 'gud) + +(defvar gdb-current-address "main" "Initialisation for Assembler buffer.") +(defvar gdb-previous-address nil) +(defvar gdb-previous-frame nil) +(defvar gdb-current-frame "main") +(defvar gdb-display-in-progress nil) +(defvar gdb-dive nil) +(defvar gdb-view-source t "Non-nil means that source code can be viewed") +(defvar gdb-selected-view 'source "Code type that user wishes to view") +(defvar gdb-buffer-type nil) +(defvar gdb-variables '() + "A list of variables that are local to the GUD buffer.") + + +;;;###autoload +(defun gdba (command-line) + "Run gdb on program FILE in buffer *gud-FILE*. +The directory containing FILE becomes the initial working directory +and source-file directory for your debugger. + +If `gdb-many-windows' is nil (the default value) then gdb starts with +just two windows : the GUD and the source buffer. If it is t the +following layout will appear (keybindings given in relevant buffer) : + +--------------------------------------------------------------------- + GDB Toolbar +--------------------------------------------------------------------- +GUD buffer (I/O of GDB) | Locals buffer + | + | + | +--------------------------------------------------------------------- +Source buffer | Input/Output (of debuggee) buffer + | (comint-mode) + | + | + | + | + | + | +--------------------------------------------------------------------- +Stack buffer | Breakpoints buffer + RET gdb-frames-select | SPC gdb-toggle-breakpoint + | RET gdb-goto-breakpoint + | d gdb-delete-breakpoint +--------------------------------------------------------------------- + +All the buffers share the toolbar and source should always display in the same +window e.g after typing g on a breakpoint in the breakpoints buffer. Breakpoint +icons are displayed both by setting a break with gud-break and by typing break +in the GUD buffer. + +This works best (depending on the size of your monitor) using most of the +screen. + +Displayed expressions appear in separate frames. Arrays may be displayed +as slices and visualised using the graph program from plotutils if installed. +Pointers in structures may be followed in a tree-like fashion. + +The following interactive lisp functions help control operation : + +`gdb-many-windows' - Toggle the number of windows gdb uses. +`gdb-restore-windows' - To restore the window layout. +`gdb-quit' - To delete (most) of the buffers used by GDB-UI and + reset variables." + ;; + (interactive (list (gud-query-cmdline 'gdba))) + ;; + ;; Let's start with a basic gud-gdb buffer and then modify it a bit. + (gdb command-line) + ;; + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter) + ;; + (gud-def gud-break (if (not (string-equal mode-name "Assembler")) + (gud-call "break %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "break *%a" arg))) + "\C-b" "Set breakpoint at current line or address.") + ;; + (gud-def gud-remove (if (not (string-equal mode-name "Assembler")) + (gud-call "clear %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "clear *%a" arg))) + "\C-d" "Remove breakpoint at current line or address.") + ;; + (gud-def gud-until (if (not (string-equal mode-name "Assembler")) + (gud-call "until %f:%l" arg) + (save-excursion + (beginning-of-line) + (forward-char 2) + (gud-call "until *%a" arg))) + "\C-u" "Continue to current line or address.") + + (setq comint-input-sender 'gdb-send) + ;; + ;; (re-)initialise + (setq gdb-current-address "main") + (setq gdb-previous-address nil) + (setq gdb-previous-frame nil) + (setq gdb-current-frame "main") + (setq gdb-display-in-progress nil) + (setq gdb-dive nil) + (setq gdb-view-source t) + (setq gdb-selected-view 'source) + ;; + (mapc 'make-local-variable gdb-variables) + (setq gdb-buffer-type 'gdba) + ;; + (gdb-clear-inferior-io) + ;; + (if (eq window-system 'w32) + (gdb-enqueue-input (list "set new-console off\n" 'ignore))) + (gdb-enqueue-input (list "set height 0\n" 'ignore)) + ;; find source file and compilation directory here + (gdb-enqueue-input (list "server list main\n" 'ignore)) ; C program + (gdb-enqueue-input (list "server list MAIN__\n" 'ignore)) ; Fortran program + (gdb-enqueue-input (list "server info source\n" 'gdb-source-info)) + ;; + (run-hooks 'gdba-mode-hook)) + +(defun gud-display () + "Auto-display (possibly dereferenced) C expression at point." + (interactive) + (save-excursion + (let ((expr (gud-find-c-expr))) + (gdb-enqueue-input + (list (concat "server ptype " expr "\n") + `(lambda () (gud-display1 ,expr))))))) + +(defun gud-display1 (expr) + (goto-char (point-min)) + (if (looking-at "No symbol") + (progn + (gdb-set-output-sink 'user) + (gud-call (concat "server ptype " expr))) + (goto-char (- (point-max) 1)) + (if (equal (char-before) (string-to-char "\*")) + (gdb-enqueue-input + (list (concat "display* " expr "\n") 'ignore)) + (gdb-enqueue-input + (list (concat "display " expr "\n") 'ignore))))) + +; this would messy because these bindings don't work with M-x gdb +; (define-key global-map "\C-x\C-a\C-a" 'gud-display) +; (define-key gud-minor-mode-map "\C-c\C-a" 'gud-display) + + + +;; ====================================================================== +;; +;; In this world, there are gdb variables (of unspecified +;; representation) and buffers associated with those objects. +;; The list of variables is built up by the expansions of +;; def-gdb-variable + +(defmacro def-gdb-var (root-symbol &optional default doc) + (let* ((root (symbol-name root-symbol)) + (accessor (intern (concat "gdb-get-" root))) + (setter (intern (concat "gdb-set-" root))) + (name (intern (concat "gdb-" root)))) + `(progn + (defvar ,name ,default ,doc) + (if (not (memq ',name gdb-variables)) + (push ',name gdb-variables)) + (defun ,accessor () + (buffer-local-value ',name gud-comint-buffer)) + (defun ,setter (val) + (with-current-buffer gud-comint-buffer + (setq ,name val)))))) + +(def-gdb-var buffer-type nil + "One of the symbols bound in gdb-buffer-rules") + +(def-gdb-var burst "" + "A string of characters from gdb that have not yet been processed.") + +(def-gdb-var input-queue () + "A list of high priority gdb command objects.") + +(def-gdb-var idle-input-queue () + "A list of low priority gdb command objects.") + +(def-gdb-var prompting nil + "True when gdb is idle with no pending input.") + +(def-gdb-var output-sink 'user + "The disposition of the output of the current gdb command. +Possible values are these symbols: + + user -- gdb output should be copied to the GUD buffer + for the user to see. + + inferior -- gdb output should be copied to the inferior-io buffer + + pre-emacs -- output should be ignored util the post-prompt + annotation is received. Then the output-sink + becomes:... + emacs -- output should be collected in the partial-output-buffer + for subsequent processing by a command. This is the + disposition of output generated by commands that + gdb mode sends to gdb on its own behalf. + post-emacs -- ignore input until the prompt annotation is + received, then go to USER disposition. +") + +(def-gdb-var current-item nil + "The most recent command item sent to gdb.") + +(def-gdb-var pending-triggers '() + "A list of trigger functions that have run later than their output +handlers.") + +;; end of gdb variables + +(defun gdb-get-target-string () + (with-current-buffer gud-comint-buffer + gud-target-name)) + + +;; +;; gdb buffers. +;; +;; Each buffer has a TYPE -- a symbol that identifies the function +;; of that particular buffer. +;; +;; The usual gdb interaction buffer is given the type `gdba' and +;; is constructed specially. +;; +;; Others are constructed by gdb-get-create-buffer and +;; named according to the rules set forth in the gdb-buffer-rules-assoc + +(defvar gdb-buffer-rules-assoc '()) + +(defun gdb-get-buffer (key) + "Return the gdb buffer tagged with type KEY. +The key should be one of the cars in `gdb-buffer-rules-assoc'." + (save-excursion + (gdb-look-for-tagged-buffer key (buffer-list)))) + +(defun gdb-get-create-buffer (key) + "Create a new gdb buffer of the type specified by KEY. +The key should be one of the cars in `gdb-buffer-rules-assoc'." + (or (gdb-get-buffer key) + (let* ((rules (assoc key gdb-buffer-rules-assoc)) + (name (funcall (gdb-rules-name-maker rules))) + (new (get-buffer-create name))) + (with-current-buffer new + ;; FIXME: This should be set after calling the function, since the + ;; function should run kill-all-local-variables. + (set (make-local-variable 'gdb-buffer-type) key) + (if (cdr (cdr rules)) + (funcall (car (cdr (cdr rules))))) + (set (make-local-variable 'gud-comint-buffer) gud-comint-buffer) + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + new)))) + +(defun gdb-rules-name-maker (rules) (car (cdr rules))) + +(defun gdb-look-for-tagged-buffer (key bufs) + (let ((retval nil)) + (while (and (not retval) bufs) + (set-buffer (car bufs)) + (if (eq gdb-buffer-type key) + (setq retval (car bufs))) + (setq bufs (cdr bufs))) + retval)) + +;; +;; This assoc maps buffer type symbols to rules. Each rule is a list of +;; at least one and possible more functions. The functions have these +;; roles in defining a buffer type: +;; +;; NAME - Return a name for this buffer type. +;; +;; The remaining function(s) are optional: +;; +;; MODE - called in a new buffer with no arguments, should establish +;; the proper mode for the buffer. +;; + +(defun gdb-set-buffer-rules (buffer-type &rest rules) + (let ((binding (assoc buffer-type gdb-buffer-rules-assoc))) + (if binding + (setcdr binding rules) + (push (cons buffer-type rules) + gdb-buffer-rules-assoc)))) + +;; GUD buffers are an exception to the rules +(gdb-set-buffer-rules 'gdba 'error) + +;; +;; Partial-output buffer : This accumulates output from a command executed on +;; behalf of emacs (rather than the user). +;; +(gdb-set-buffer-rules 'gdb-partial-output-buffer + 'gdb-partial-output-name) + +(defun gdb-partial-output-name () + (concat "*partial-output-" + (gdb-get-target-string) + "*")) + + +(gdb-set-buffer-rules 'gdb-inferior-io + 'gdb-inferior-io-name + 'gdb-inferior-io-mode) + +(defun gdb-inferior-io-name () + (concat "*input/output of " + (gdb-get-target-string) + "*")) + +(defvar gdb-inferior-io-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'gdb-inferior-io-interrupt) + (define-key map "\C-c\C-z" 'gdb-inferior-io-stop) + (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit) + (define-key map "\C-c\C-d" 'gdb-inferior-io-eof) + map)) + +(define-derived-mode gdb-inferior-io-mode comint-mode "Debuggee I/O" + "Major mode for gdb inferior-io." + :syntax-table nil :abbrev-table nil + ;; We want to use comint because it has various nifty and familiar + ;; features. We don't need a process, but comint wants one, so create + ;; a dummy one. + (make-comint-in-buffer + (substring (buffer-name) 1 (- (length (buffer-name)) 1)) + (current-buffer) "hexl") + (setq comint-input-sender 'gdb-inferior-io-sender)) + +(defun gdb-inferior-io-sender (proc string) + ;; PROC is the pseudo-process created to satisfy comint. + (with-current-buffer (process-buffer proc) + (setq proc (get-buffer-process gud-comint-buffer)) + (process-send-string proc string) + (process-send-string proc "\n"))) + +(defun gdb-inferior-io-interrupt () + "Interrupt the program being debugged." + (interactive) + (interrupt-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-quit () + "Send quit signal to the program being debugged." + (interactive) + (quit-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-stop () + "Stop the program being debugged." + (interactive) + (stop-process + (get-buffer-process gud-comint-buffer) comint-ptyp)) + +(defun gdb-inferior-io-eof () + "Send end-of-file to the program being debugged." + (interactive) + (process-send-eof + (get-buffer-process gud-comint-buffer))) + + +;; +;; gdb communications +;; + +;; INPUT: things sent to gdb +;; +;; There is a high and low priority input queue. Low priority input is sent +;; only when the high priority queue is idle. +;; +;; The queues are lists. Each element is either a string (indicating user or +;; user-like input) or a list of the form: +;; +;; (INPUT-STRING HANDLER-FN) +;; +;; The handler function will be called from the partial-output buffer when the +;; command completes. This is the way to write commands which invoke gdb +;; commands autonomously. +;; +;; These lists are consumed tail first. +;; + +(defun gdb-send (proc string) + "A comint send filter for gdb. +This filter may simply queue output for a later time." + (gdb-enqueue-input (concat string "\n"))) + +;; Note: Stuff enqueued here will be sent to the next prompt, even if it +;; is a query, or other non-top-level prompt. To guarantee stuff will get +;; sent to the top-level prompt, currently it must be put in the idle queue. +;; ^^^^^^^^^ +;; [This should encourage gdb extensions that invoke gdb commands to let +;; the user go first; it is not a bug. -t] +;; + +(defun gdb-enqueue-input (item) + (if (gdb-get-prompting) + (progn + (gdb-send-item item) + (gdb-set-prompting nil)) + (gdb-set-input-queue + (cons item (gdb-get-input-queue))))) + +(defun gdb-dequeue-input () + (let ((queue (gdb-get-input-queue))) + (and queue + (if (not (cdr queue)) + (let ((answer (car queue))) + (gdb-set-input-queue '()) + answer) + (gdb-take-last-elt queue))))) + +(defun gdb-enqueue-idle-input (item) + (if (and (gdb-get-prompting) + (not (gdb-get-input-queue))) + (progn + (gdb-send-item item) + (gdb-set-prompting nil)) + (gdb-set-idle-input-queue + (cons item (gdb-get-idle-input-queue))))) + +(defun gdb-dequeue-idle-input () + (let ((queue (gdb-get-idle-input-queue))) + (and queue + (if (not (cdr queue)) + (let ((answer (car queue))) + (gdb-set-idle-input-queue '()) + answer) + (gdb-take-last-elt queue))))) + +;; Don't use this in general. +(defun gdb-take-last-elt (l) + (if (cdr (cdr l)) + (gdb-take-last-elt (cdr l)) + (let ((answer (car (cdr l)))) + (setcdr l '()) + answer))) + + +;; +;; output -- things gdb prints to emacs +;; +;; GDB output is a stream interrupted by annotations. +;; Annotations can be recognized by their beginning +;; with \C-j\C-z\C-z\C-j +;; +;; The tag is a string obeying symbol syntax. +;; +;; The optional part `' can be either the empty string +;; or a space followed by more data relating to the annotation. +;; For example, the SOURCE annotation is followed by a filename, +;; line number and various useless goo. This data must not include +;; any newlines. +;; + +(defcustom gud-gdba-command-name "gdb -annotate=2 -noasync" + "Default command to execute an executable under the GDB-UI debugger." + :type 'string + :group 'gud) + +(defvar gdb-annotation-rules + '(("pre-prompt" gdb-pre-prompt) + ("prompt" gdb-prompt) + ("commands" gdb-subprompt) + ("overload-choice" gdb-subprompt) + ("query" gdb-subprompt) + ("prompt-for-continue" gdb-subprompt) + ("post-prompt" gdb-post-prompt) + ("source" gdb-source) + ("starting" gdb-starting) + ("exited" gdb-stopping) + ("signalled" gdb-stopping) + ("signal" gdb-stopping) + ("breakpoint" gdb-stopping) + ("watchpoint" gdb-stopping) + ("frame-begin" gdb-frame-begin) + ("stopped" gdb-stopped) + ("display-begin" gdb-display-begin) + ("display-end" gdb-display-end) +; GDB commands info stack, info locals and frame generate an error-begin +; annotation at start when there is no stack but this is a quirk/bug in +; annotations. +; ("error-begin" gdb-error-begin) + ("display-number-end" gdb-display-number-end) + ("array-section-begin" gdb-array-section-begin) + ("array-section-end" gdb-array-section-end) + ;; ("elt" gdb-elt) + ("field-begin" gdb-field-begin) + ("field-end" gdb-field-end) + ) "An assoc mapping annotation tags to functions which process them.") + +(defconst gdb-source-spec-regexp + "\\(.*\\):\\([0-9]*\\):[0-9]*:[a-z]*:\\(0x[a-f0-9]*\\)") + +;; Do not use this except as an annotation handler. +(defun gdb-source (args) + (string-match gdb-source-spec-regexp args) + ;; Extract the frame position from the marker. + (setq gud-last-frame + (cons + (match-string 1 args) + (string-to-int (match-string 2 args)))) + (setq gdb-current-address (match-string 3 args)) + (setq gdb-view-source t) + ;;update with new frame for machine code if necessary + (gdb-invalidate-assembler)) + +(defun gdb-send-item (item) + (gdb-set-current-item item) + (if (stringp item) + (progn + (gdb-set-output-sink 'user) + (process-send-string (get-buffer-process gud-comint-buffer) item)) + (progn + (gdb-clear-partial-output) + (gdb-set-output-sink 'pre-emacs) + (process-send-string (get-buffer-process gud-comint-buffer) + (car item))))) + +(defun gdb-pre-prompt (ignored) + "An annotation handler for `pre-prompt'. This terminates the collection of +output from a previous command if that happens to be in effect." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'emacs) + (gdb-set-output-sink 'post-emacs) + (let ((handler + (car (cdr (gdb-get-current-item))))) + (save-excursion + (set-buffer (gdb-get-create-buffer + 'gdb-partial-output-buffer)) + (funcall handler)))) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-pre-prompt (got %s)" sink))))) + +(defun gdb-prompt (ignored) + "An annotation handler for `prompt'. +This sends the next command (if any) to gdb." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'post-emacs) + (gdb-set-output-sink 'user)) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-prompt (got %s)" sink)))) + (let ((highest (gdb-dequeue-input))) + (if highest + (gdb-send-item highest) + (let ((lowest (gdb-dequeue-idle-input))) + (if lowest + (gdb-send-item lowest) + (progn + (gdb-set-prompting t) + (gud-display-frame))))))) + +(defun gdb-subprompt (ignored) + "An annotation handler for non-top-level prompts." + (let ((highest (gdb-dequeue-input))) + (if highest + (gdb-send-item highest) + (gdb-set-prompting t)))) + +(defun gdb-starting (ignored) + "An annotation handler for `starting'. This says that I/O for the +subprocess is now the program being debugged, not GDB." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) + (progn + (setq gud-running t) + (gdb-set-output-sink 'inferior))) + (t (error "Unexpected `starting' annotation"))))) + +(defun gdb-stopping (ignored) + "An annotation handler for `exited' and other annotations which say that I/O +for the subprocess is now GDB, not the program being debugged." + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + (t (error "Unexpected stopping annotation"))))) + +(defun gdb-frame-begin (ignored) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + ((eq sink 'user) t) + ((eq sink 'emacs) t) + (t (error "Unexpected frame-begin annotation (%S)" sink))))) + +(defun gdb-stopped (ignored) + "An annotation handler for `stopped'. It is just like gdb-stopping, except +that if we already set the output sink to 'user in gdb-stopping, that is fine." + (setq gud-running nil) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'inferior) + (gdb-set-output-sink 'user)) + ((eq sink 'user) t) + (t (error "Unexpected stopped annotation"))))) + +(defun gdb-post-prompt (ignored) + "An annotation handler for `post-prompt'. This begins the collection of +output from the current command if that happens to be appropriate." + (if (not (gdb-get-pending-triggers)) + (progn + (gdb-get-current-frame) + (gdb-invalidate-frames) + (gdb-invalidate-breakpoints) + (gdb-invalidate-assembler) + (gdb-invalidate-registers) + (gdb-invalidate-locals) + (gdb-invalidate-display) + (gdb-invalidate-threads))) + (let ((sink (gdb-get-output-sink))) + (cond + ((eq sink 'user) t) + ((eq sink 'pre-emacs) + (gdb-set-output-sink 'emacs)) + (t + (gdb-set-output-sink 'user) + (error "Phase error in gdb-post-prompt (got %s)" sink))))) + +;; If we get an error whilst evaluating one of the expressions +;; we won't get the display-end annotation. Set the sink back to +;; user to make sure that the error message is seen. +;; NOT USED: see annotation-rules for reason. +;(defun gdb-error-begin (ignored) +; (gdb-set-output-sink 'user)) + +(defun gdb-display-begin (ignored) + (gdb-set-output-sink 'emacs) + (gdb-clear-partial-output) + (setq gdb-display-in-progress t)) + +(defvar gdb-expression-buffer-name nil) +(defvar gdb-display-number nil) +(defvar gdb-dive-display-number nil) + +(defun gdb-display-number-end (ignored) + (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) + (setq gdb-display-number (buffer-string)) + (setq gdb-expression-buffer-name + (concat "*display " gdb-display-number "*")) + (save-excursion + (if (progn + (set-buffer (window-buffer)) + gdb-dive) + (progn + (let ((number gdb-display-number)) + (switch-to-buffer + (set-buffer (get-buffer-create gdb-expression-buffer-name))) + (gdb-expressions-mode) + (setq gdb-dive-display-number number))) + (set-buffer (get-buffer-create gdb-expression-buffer-name)) + (if (display-graphic-p) + (catch 'frame-exists + (dolist (frame (frame-list)) + (if (string-equal (frame-parameter frame 'name) + gdb-expression-buffer-name) + (throw 'frame-exists nil))) + (gdb-expressions-mode) + (make-frame `((height . ,gdb-window-height) + (width . ,gdb-window-width) + (tool-bar-lines . nil) + (menu-bar-lines . nil) + (minibuffer . nil)))) + (gdb-expressions-mode) + (gdb-display-buffer (get-buffer gdb-expression-buffer-name))))) + (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) + (setq gdb-dive nil)) + +(defvar gdb-nesting-level nil) +(defvar gdb-expression nil) +(defvar gdb-point nil) +(defvar gdb-annotation-arg nil) + +(defun gdb-delete-line () + "Delete the current line." + (delete-region (line-beginning-position) (line-beginning-position 2))) + +(defun gdb-display-end (ignored) + (set-buffer (gdb-get-buffer 'gdb-partial-output-buffer)) + (goto-char (point-min)) + (search-forward ": ") + (looking-at "\\(.*?\\) =") + (let ((char "") + (gdb-temp-value (match-string 1))) + ;;move * to front of expression if necessary + (if (looking-at ".*\\*") + (progn + (setq char "*") + (setq gdb-temp-value (substring gdb-temp-value 1 nil)))) + (with-current-buffer gdb-expression-buffer-name + (setq gdb-expression gdb-temp-value) + (if (not (string-match "::" gdb-expression)) + (setq gdb-expression (concat char gdb-current-frame + "::" gdb-expression)) + ;;else put * back on if necessary + (setq gdb-expression (concat char gdb-expression))) + (if (not header-line-format) + (setq header-line-format (concat "-- " gdb-expression " %-"))))) + ;; + ;;-if scalar/string + (if (not (re-search-forward "##" nil t)) + (progn + (with-current-buffer gdb-expression-buffer-name + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring + (gdb-get-buffer 'gdb-partial-output-buffer))))) + ;; display expression name... + (goto-char (point-min)) + (let ((start (progn (point))) + (end (progn (end-of-line) (point)))) + (with-current-buffer gdb-expression-buffer-name + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring (gdb-get-buffer + 'gdb-partial-output-buffer) + start end) + (insert "\n")))) + (goto-char (point-min)) + (re-search-forward "##" nil t) + (setq gdb-nesting-level 0) + (if (looking-at "array-section-begin") + (progn + (gdb-delete-line) + (setq gdb-point (point)) + (gdb-array-format))) + (if (looking-at "field-begin \\(.\\)") + (progn + (setq gdb-annotation-arg (match-string 1)) + (gdb-field-format-begin)))) + (with-current-buffer gdb-expression-buffer-name + (if gdb-dive-display-number + (progn + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (insert "\n") + (insert-text-button "[back]" 'type 'gdb-display-back))))) + (gdb-clear-partial-output) + (gdb-set-output-sink 'user) + (setq gdb-display-in-progress nil)) + +(define-button-type 'gdb-display-back + 'help-echo (purecopy "mouse-2, RET: go back to previous display buffer") + 'action (lambda (button) (gdb-display-go-back))) + +(defun gdb-display-go-back () + ;; delete display so they don't accumulate and delete buffer + (let ((number gdb-display-number)) + (gdb-enqueue-input + (list (concat "server delete display " number "\n") 'ignore)) + (switch-to-buffer (concat "*display " gdb-dive-display-number "*")) + (kill-buffer (get-buffer (concat "*display " number "*"))))) + +;; prefix annotations with ## and process whole output in one chunk +;; in gdb-partial-output-buffer (to allow recursion). + +;; array-section flags are just removed again but after counting. They +;; might also be useful for arrays of structures and structures with arrays. +(defun gdb-array-section-begin (args) + (if gdb-display-in-progress + (progn + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert (concat "\n##array-section-begin " args "\n")))))) + +(defun gdb-array-section-end (ignored) + (if gdb-display-in-progress + (progn + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert "\n##array-section-end\n"))))) + +(defun gdb-field-begin (args) + (if gdb-display-in-progress + (progn + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert (concat "\n##field-begin " args "\n")))))) + +(defun gdb-field-end (ignored) + (if gdb-display-in-progress + (progn + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert "\n##field-end\n"))))) + +(defun gdb-elt (ignored) + (if gdb-display-in-progress + (progn + (goto-char (point-max)) + (insert "\n##elt\n")))) + +(defun gdb-field-format-begin () + ;; get rid of ##field-begin + (gdb-delete-line) + (gdb-insert-field) + (setq gdb-nesting-level (+ gdb-nesting-level 1)) + (while (re-search-forward "##" nil t) + ;; keep making recursive calls... + (if (looking-at "field-begin \\(.\\)") + (progn + (setq gdb-annotation-arg (match-string 1)) + (gdb-field-format-begin))) + ;; until field-end. + (if (looking-at "field-end") (gdb-field-format-end)))) + +(defun gdb-field-format-end () + ;; get rid of ##field-end and `,' or `}' + (gdb-delete-line) + (gdb-delete-line) + (setq gdb-nesting-level (- gdb-nesting-level 1))) + +(defvar gdb-dive-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'gdb-dive) + (define-key map [S-mouse-2] 'gdb-dive-new-frame) + map)) + +(defun gdb-dive (event) + "Dive into structure." + (interactive "e") + (setq gdb-dive t) + (gdb-dive-new-frame event)) + +(defun gdb-dive-new-frame (event) + "Dive into structure and display in a new frame." + (interactive "e") + (save-excursion + (mouse-set-point event) + (let ((point (point)) (gdb-full-expression gdb-expression) + (end (progn (end-of-line) (point))) + (gdb-part-expression "") (gdb-last-field nil) (gdb-display-char nil)) + (beginning-of-line) + (if (looking-at "\*") (setq gdb-display-char "*")) + (re-search-forward "\\(\\S-+\\) = " end t) + (setq gdb-last-field (match-string-no-properties 1)) + (goto-char (match-beginning 1)) + (let ((last-column (current-column))) + (while (re-search-backward "\\s-\\(\\S-+\\) = {" nil t) + (goto-char (match-beginning 1)) + (if (and (< (current-column) last-column) + (> (count-lines 1 (point)) 1)) + (progn + (setq gdb-part-expression + (concat "." (match-string-no-properties 1) + gdb-part-expression)) + (setq last-column (current-column)))))) + ;; * not needed for components of a pointer to a structure in gdb + (if (string-equal "*" (substring gdb-full-expression 0 1)) + (setq gdb-full-expression (substring gdb-full-expression 1 nil))) + (setq gdb-full-expression + (concat gdb-full-expression gdb-part-expression "." gdb-last-field)) + (gdb-enqueue-input + (list (concat "server display" gdb-display-char + " " gdb-full-expression "\n") + 'ignore))))) + +(defun gdb-insert-field () + (let ((start (progn (point))) + (end (progn (next-line) (point))) + (num 0)) + (with-current-buffer gdb-expression-buffer-name + (let ((buffer-read-only nil)) + (if (string-equal gdb-annotation-arg "\*") (insert "\*")) + (while (<= num gdb-nesting-level) + (insert "\t") + (setq num (+ num 1))) + (insert-buffer-substring (gdb-get-buffer + 'gdb-partial-output-buffer) + start end) + (put-text-property (- (point) (- end start)) (- (point) 1) + 'mouse-face 'highlight) + (put-text-property (- (point) (- end start)) (- (point) 1) + 'local-map gdb-dive-map))) + (delete-region start end))) + +(defvar gdb-values nil) + +(defun gdb-array-format () + (while (re-search-forward "##" nil t) + ;; keep making recursive calls... + (if (looking-at "array-section-begin") + (progn + ;;get rid of ##array-section-begin + (gdb-delete-line) + (setq gdb-nesting-level (+ gdb-nesting-level 1)) + (gdb-array-format))) + ;;until *matching* array-section-end is found + (if (looking-at "array-section-end") + (if (eq gdb-nesting-level 0) + (progn + (let ((values (buffer-substring gdb-point (- (point) 2)))) + (with-current-buffer gdb-expression-buffer-name + (setq gdb-values + (concat "{" (replace-regexp-in-string "\n" "" values) + "}")) + (gdb-array-format1)))) + ;;else get rid of ##array-section-end etc + (gdb-delete-line) + (setq gdb-nesting-level (- gdb-nesting-level 1)) + (gdb-array-format))))) + +(defvar gdb-array-start nil) +(defvar gdb-array-stop nil) + +(defvar gdb-array-slice-map + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'gdb-array-slice) + (define-key map [mouse-2] 'gdb-mouse-array-slice) + map)) + +(defun gdb-mouse-array-slice (event) + "Select an array slice to display." + (interactive "e") + (mouse-set-point event) + (gdb-array-slice)) + +(defun gdb-array-slice () + (interactive) + (save-excursion + (let ((n -1) (stop 0) (start 0) (point (point))) + (beginning-of-line) + (while (search-forward "[" point t) + (setq n (+ n 1))) + (setq start (string-to-int (read-string "Start index: "))) + (aset gdb-array-start n start) + (setq stop (string-to-int (read-string "Stop index: "))) + (aset gdb-array-stop n stop))) + (gdb-array-format1)) + +(defvar gdb-display-string nil) +(defvar gdb-array-size nil) + +(defun gdb-array-format1 () + (setq gdb-display-string "") + (let ((buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (let ((gdb-value-list (split-string gdb-values ", "))) + (string-match "\\({+\\)" (car gdb-value-list)) + (let* ((depth (- (match-end 1) (match-beginning 1))) + (indices (make-vector depth '0)) + (index 0) (num 0) (array-start "") + (array-stop "") (array-slice "") (array-range nil) + (flag t) (indices-string "")) + (dolist (gdb-value gdb-value-list) + (string-match "{*\\([^}]*\\)\\(}*\\)" gdb-value) + (setq num 0) + (while (< num depth) + (setq indices-string + (concat indices-string + "[" (int-to-string (aref indices num)) "]")) + (if (not (= (aref gdb-array-start num) -1)) + (if (or (< (aref indices num) (aref gdb-array-start num)) + (> (aref indices num) (aref gdb-array-stop num))) + (setq flag nil)) + (aset gdb-array-size num (aref indices num))) + (setq num (+ num 1))) + (if flag + (let ((gdb-display-value (match-string 1 gdb-value))) + (setq gdb-display-string (concat gdb-display-string " " + gdb-display-value)) + (insert + (concat indices-string "\t" gdb-display-value "\n")))) + (setq indices-string "") + (setq flag t) + ;; 0<= index < depth, start at right : (- depth 1) + (setq index (- (- depth 1) + (- (match-end 2) (match-beginning 2)))) + ;;don't set for very last brackets + (when (>= index 0) + (aset indices index (+ 1 (aref indices index))) + (setq num (+ 1 index)) + (while (< num depth) + (aset indices num 0) + (setq num (+ num 1))))) + (setq num 0) + (while (< num depth) + (if (= (aref gdb-array-start num) -1) + (progn + (aset gdb-array-start num 0) + (aset gdb-array-stop num (aref indices num)))) + (setq array-start (int-to-string (aref gdb-array-start num))) + (setq array-stop (int-to-string (aref gdb-array-stop num))) + (setq array-range (concat "[" array-start + ":" array-stop "]")) + (put-text-property 1 (+ (length array-start) + (length array-stop) 2) + 'mouse-face 'highlight array-range) + (put-text-property 1 (+ (length array-start) + (length array-stop) 2) + 'local-map gdb-array-slice-map array-range) + (goto-char (point-min)) + (setq array-slice (concat array-slice array-range)) + (setq num (+ num 1))) + (goto-char (point-min)) + (insert "Array Size : ") + (setq num 0) + (while (< num depth) + (insert + (concat "[" + (int-to-string (+ (aref gdb-array-size num) 1)) "]")) + (setq num (+ num 1))) + (insert + (concat "\n Slice : " array-slice "\n\nIndex\tValues\n\n")))))) + +(defun gud-gdba-marker-filter (string) + "A gud marker filter for gdb. Handle a burst of output from GDB." + (let ( + ;; Recall the left over burst from last time + (burst (concat (gdb-get-burst) string)) + ;; Start accumulating output for the GUD buffer + (output "")) + ;; + ;; Process all the complete markers in this chunk. + (while (string-match "\n\032\032\\(.*\\)\n" burst) + (let ((annotation (match-string 1 burst))) + ;; + ;; Stuff prior to the match is just ordinary output. + ;; It is either concatenated to OUTPUT or directed + ;; elsewhere. + (setq output + (gdb-concat-output + output + (substring burst 0 (match-beginning 0)))) + + ;; Take that stuff off the burst. + (setq burst (substring burst (match-end 0))) + + ;; Parse the tag from the annotation, and maybe its arguments. + (string-match "\\(\\S-*\\) ?\\(.*\\)" annotation) + (let* ((annotation-type (match-string 1 annotation)) + (annotation-arguments (match-string 2 annotation)) + (annotation-rule (assoc annotation-type + gdb-annotation-rules))) + ;; Call the handler for this annotation. + (if annotation-rule + (funcall (car (cdr annotation-rule)) + annotation-arguments) + ;; Else the annotation is not recognized. Ignore it silently, + ;; so that GDB can add new annotations without causing + ;; us to blow up. + )))) + ;; + ;; Does the remaining text end in a partial line? + ;; If it does, then keep part of the burst until we get more. + (if (string-match "\n\\'\\|\n\032\\'\\|\n\032\032.*\\'" + burst) + (progn + ;; Everything before the potential marker start can be output. + (setq output + (gdb-concat-output output + (substring burst 0 (match-beginning 0)))) + ;; + ;; Everything after, we save, to combine with later input. + (setq burst (substring burst (match-beginning 0)))) + ;; + ;; In case we know the burst contains no partial annotations: + (progn + (setq output (gdb-concat-output output burst)) + (setq burst ""))) + ;; + ;; Save the remaining burst for the next call to this function. + (gdb-set-burst burst) + output)) + +(defun gdb-concat-output (so-far new) + (let ((sink (gdb-get-output-sink ))) + (cond + ((eq sink 'user) (concat so-far new)) + ((or (eq sink 'pre-emacs) (eq sink 'post-emacs)) so-far) + ((eq sink 'emacs) + (gdb-append-to-partial-output new) + so-far) + ((eq sink 'inferior) + (gdb-append-to-inferior-io new) + so-far) + (t (error "Bogon output sink %S" sink))))) + +(defun gdb-append-to-partial-output (string) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-max)) + (insert string))) + +(defun gdb-clear-partial-output () + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (delete-region (point-min) (point-max)))) + +(defun gdb-append-to-inferior-io (string) + (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) + (goto-char (point-max)) + (insert-before-markers string)) + (if (not (string-equal string "")) + (gdb-display-buffer (gdb-get-create-buffer 'gdb-inferior-io)))) + +(defun gdb-clear-inferior-io () + (with-current-buffer (gdb-get-create-buffer 'gdb-inferior-io) + (delete-region (point-min) (point-max)))) + + +;; One trick is to have a command who's output is always available in a buffer +;; of it's own, and is always up to date. We build several buffers of this +;; type. +;; +;; There are two aspects to this: gdb has to tell us when the output for that +;; command might have changed, and we have to be able to run the command +;; behind the user's back. +;; +;; The idle input queue and the output phasing associated with the variable +;; gdb-output-sink help us to run commands behind the user's back. +;; +;; Below is the code for specificly managing buffers of output from one +;; command. +;; + +;; The trigger function is suitable for use in the assoc GDB-ANNOTATION-RULES +;; It adds an idle input for the command we are tracking. It should be the +;; annotation rule binding of whatever gdb sends to tell us this command +;; might have changed it's output. +;; +;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. +;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the +;; input in the input queue (see comment about ``gdb communications'' above). + +(defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command + output-handler) + `(defun ,name (&optional ignored) + (if (and (,demand-predicate) + (not (member ',name + (gdb-get-pending-triggers)))) + (progn + (gdb-enqueue-idle-input + (list ,gdb-command ',output-handler)) + (gdb-set-pending-triggers + (cons ',name + (gdb-get-pending-triggers))))))) + +(defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun) + `(defun ,name () + (gdb-set-pending-triggers + (delq ',trigger + (gdb-get-pending-triggers))) + (let ((buf (gdb-get-buffer ',buf-key))) + (and buf + (with-current-buffer buf + (let ((p (point)) + (buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring (gdb-get-create-buffer + 'gdb-partial-output-buffer)) + (goto-char p))))) + ;; put customisation here + (,custom-defun))) + +(defmacro def-gdb-auto-updated-buffer (buffer-key trigger-name gdb-command + output-handler-name custom-defun) + `(progn + (def-gdb-auto-update-trigger ,trigger-name + ;; The demand predicate: + (lambda () (gdb-get-buffer ',buffer-key)) + ,gdb-command + ,output-handler-name) + (def-gdb-auto-update-handler ,output-handler-name + ,trigger-name ,buffer-key ,custom-defun))) + + +;; +;; Breakpoint buffer : This displays the output of `info breakpoints'. +;; +(gdb-set-buffer-rules 'gdb-breakpoints-buffer + 'gdb-breakpoints-buffer-name + 'gdb-breakpoints-mode) + +(def-gdb-auto-updated-buffer gdb-breakpoints-buffer + ;; This defines the auto update rule for buffers of type + ;; `gdb-breakpoints-buffer'. + ;; + ;; It defines a function to serve as the annotation handler that + ;; handles the `foo-invalidated' message. That function is called: + gdb-invalidate-breakpoints + ;; + ;; To update the buffer, this command is sent to gdb. + "server info breakpoints\n" + ;; + ;; This also defines a function to be the handler for the output + ;; from the command above. That function will copy the output into + ;; the appropriately typed buffer. That function will be called: + gdb-info-breakpoints-handler + ;; buffer specific functions + gdb-info-breakpoints-custom) + +(defvar gdb-cdir nil "Compilation directory.") + +(defconst breakpoint-xpm-data "/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +\"12 12 2 1\", +\" c red\", +\"+ c None\", +/* pixels */ +\"++++++++++++\", +\"+++ +++\", +\"++ ++\", +\"+ +\", +\"+ +\", +\"+ +\", +\"+ +\", +\"+ +\", +\"+ +\", +\"++ ++\", +\"+++ +++\", +\"++++++++++++\" +};" + "XPM data used for breakpoint icon.") + +(defconst breakpoint-enabled-pbm-data +"P1 +12 12\", +0 0 0 0 0 0 0 0 0 0 0 0 +0 0 0 1 1 1 1 1 1 0 0 0 +0 0 1 1 1 1 1 1 1 1 0 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 1 1 1 1 1 1 1 1 1 1 0 +0 0 1 1 1 1 1 1 1 1 0 0 +0 0 0 1 1 1 1 1 1 0 0 0 +0 0 0 0 0 0 0 0 0 0 0 0" + "PBM data used for enabled breakpoint icon.") + +(defconst breakpoint-disabled-pbm-data +"P1 +12 12\", +0 0 0 0 0 0 0 0 0 0 0 0 +0 0 0 1 0 1 0 1 0 0 0 0 +0 0 1 0 1 0 1 0 1 0 0 0 +0 1 0 1 0 1 0 1 0 1 0 0 +0 0 1 0 1 0 1 0 1 0 1 0 +0 1 0 1 0 1 0 1 0 1 0 0 +0 0 1 0 1 0 1 0 1 0 1 0 +0 1 0 1 0 1 0 1 0 1 0 0 +0 0 1 0 1 0 1 0 1 0 1 0 +0 0 0 1 0 1 0 1 0 1 0 0 +0 0 0 0 1 0 1 0 1 0 0 0 +0 0 0 0 0 0 0 0 0 0 0 0" + "PBM data used for disabled breakpoint icon.") + +(defvar breakpoint-enabled-icon + (find-image `((:type xpm :data ,breakpoint-xpm-data) + (:type pbm :data ,breakpoint-enabled-pbm-data))) + "Icon for enabled breakpoint in display margin") + +(defvar breakpoint-disabled-icon + (find-image `((:type xpm :data ,breakpoint-xpm-data :conversion disabled) + (:type pbm :data ,breakpoint-disabled-pbm-data))) + "Icon for disabled breakpoint in display margin") + +;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) +(defun gdb-info-breakpoints-custom () + (let ((flag)(address)) + ;; + ;; remove all breakpoint-icons in source buffers but not assembler buffer + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (if (and (eq gud-minor-mode 'gdba) + (not (string-match "^\*" (buffer-name)))) + (if (eq window-system 'x) + (remove-images (point-min) (point-max)) + (gdb-remove-strings (point-min) (point-max)))))) + (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) + (save-excursion + (goto-char (point-min)) + (while (< (point) (- (point-max) 1)) + (forward-line 1) + (if (looking-at "[^\t].*breakpoint") + (progn + (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)") + (setq flag (char-after (match-beginning 1))) + (beginning-of-line) + (if (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) + (progn + (looking-at "\\(\\S-*\\):\\([0-9]+\\)") + (let ((line (match-string 2)) (buffer-read-only nil) + (file (match-string 1))) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'mouse-face 'highlight) + (with-current-buffer + (find-file-noselect + (if (file-exists-p file) file + (expand-file-name file gdb-cdir))) + (save-current-buffer + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'tool-bar-map) + gud-tool-bar-map) + (setq left-margin-width 2) + (if (get-buffer-window (current-buffer)) + (set-window-margins (get-buffer-window + (current-buffer)) + left-margin-width + right-margin-width))) + ;; only want one breakpoint icon at each location + (save-excursion + (goto-line (string-to-number line)) + (let ((start (progn (beginning-of-line) + (- (point) 1))) + (end (progn (end-of-line) (+ (point) 1)))) + (if (eq window-system 'x) + (progn + (remove-images start end) + (if (eq ?y flag) + (put-image breakpoint-enabled-icon + (+ start 1) + "breakpoint icon enabled" + 'left-margin) + (put-image breakpoint-disabled-icon + (+ start 1) + "breakpoint icon disabled" + 'left-margin))) + (gdb-remove-strings start end) + (if (eq ?y flag) + (gdb-put-string "B" (+ start 1)) + (gdb-put-string "b" (+ start 1)))))))))))) + (end-of-line)))))) + +(defun gdb-breakpoints-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*breakpoints of " (gdb-get-target-string) "*"))) + +(defun gdb-display-breakpoints-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-breakpoints-buffer))) + +(defun gdb-frame-breakpoints-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-breakpoints-buffer))) + +(defvar gdb-breakpoints-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "Breakpoints"))) + (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint)) + (define-key menu [delete] '("Delete" . gdb-delete-breakpoint)) + (define-key menu [goto] '("Goto" . gdb-goto-breakpoint)) + + (suppress-keymap map) + (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) + (define-key map " " 'gdb-toggle-breakpoint) + (define-key map "d" 'gdb-delete-breakpoint) + (define-key map "\r" 'gdb-goto-breakpoint) + (define-key map [mouse-2] 'gdb-mouse-goto-breakpoint) + map)) + +(defun gdb-breakpoints-mode () + "Major mode for gdb breakpoints. + +\\{gdb-breakpoints-mode-map}" + (setq major-mode 'gdb-breakpoints-mode) + (setq mode-name "Breakpoints") + (use-local-map gdb-breakpoints-mode-map) + (setq buffer-read-only t) + (gdb-invalidate-breakpoints)) + +(defun gdb-toggle-breakpoint () + "Enable/disable the breakpoint at current line." + (interactive) + (save-excursion + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) + (error "Not recognized as break/watchpoint line") + (gdb-enqueue-input + (list + (concat + (if (eq ?y (char-after (match-beginning 2))) + "server disable " + "server enable ") + (match-string 1) "\n") + 'ignore))))) + +(defun gdb-delete-breakpoint () + "Delete the breakpoint at current line." + (interactive) + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\).*point\\s-*\\S-*\\s-*\\(.\\)")) + (error "Not recognized as break/watchpoint line") + (gdb-enqueue-input + (list (concat "server delete " (match-string 1) "\n") 'ignore)))) + +(defvar gdb-source-window nil) + +(defun gdb-goto-breakpoint () + "Display the file in the source buffer at the breakpoint specified on the +current line." + (interactive) + (save-excursion + (beginning-of-line 1) + (re-search-forward "in\\s-+\\S-+\\s-+at\\s-+" nil t) + (looking-at "\\(\\S-*\\):\\([0-9]+\\)")) + (if (match-string 2) + (let ((line (match-string 2)) + (file (match-string 1))) + (save-selected-window + (select-window gdb-source-window) + (switch-to-buffer (find-file-noselect + (if (file-exists-p file) + file + (expand-file-name file gdb-cdir)))) + (goto-line (string-to-number line)))))) +;; I'll get this to work one day! +;; (defun gdb-goto-breakpoint () +;; "Display the file in the source buffer at the breakpoint specified on the +;; current line." +;; (interactive) +;; (save-excursion +;; (let ((eol (progn (end-of-line) (point)))) +;; (beginning-of-line 1) +;; (if (re-search-forward "\\(\\S-*\\):\\([0-9]+\\)" eol t) +;; (let ((line (match-string 2)) +;; (file (match-string 1))) +;; (save-selected-window +;; (select-window gdb-source-window) +;; (switch-to-buffer (find-file-noselect +;; (if (file-exists-p file) +;; file +;; (expand-file-name file gdb-cdir)))) +;; (goto-line (string-to-number line)))))) +;; (let ((eol (progn (end-of-line) (point)))) +;; (beginning-of-line 1) +;; (if (re-search-forward "<\\(\\S-*?\\)\\(\\+*[0-9]*\\)>" eol t) +;; (save-selected-window +;; (select-window gdb-source-window) +;; (gdb-get-create-buffer 'gdb-assembler-buffer) +;; (gdb-enqueue-input +;; (list (concat "server disassemble " (match-string 1) "\n") +;; 'gdb-assembler-handler)) +;; (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) +;; (re-search-forward +;; (concat (match-string 1) (match-string 2))))))))) + +(defun gdb-mouse-goto-breakpoint (event) + "Display the file in the source buffer at the selected breakpoint." + (interactive "e") + (mouse-set-point event) + (gdb-goto-breakpoint)) + +;; +;; Frames buffer. This displays a perpetually correct bactracktrace +;; (from the command `where'). +;; +;; Alas, if your stack is deep, it is costly. +;; +(gdb-set-buffer-rules 'gdb-stack-buffer + 'gdb-stack-buffer-name + 'gdb-frames-mode) + +(def-gdb-auto-updated-buffer gdb-stack-buffer + gdb-invalidate-frames + "server where\n" + gdb-info-frames-handler + gdb-info-frames-custom) + +(defun gdb-info-frames-custom () + (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'mouse-face 'highlight) + (beginning-of-line) + (if (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") + (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) + (if (equal (match-string 1) gdb-current-frame) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'face + `(:background ,(face-attribute 'default :foreground) + :foreground ,(face-attribute 'default :background))))) + (forward-line 1)))))) + +(defun gdb-stack-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*stack frames of " (gdb-get-target-string) "*"))) + +(defun gdb-display-stack-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-stack-buffer))) + +(defun gdb-frame-stack-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-stack-buffer))) + +(defvar gdb-frames-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-frames-select) + (define-key map [mouse-2] 'gdb-frames-mouse-select) + map)) + +(defun gdb-frames-mode () + "Major mode for gdb frames. + +\\{gdb-frames-mode-map}" + (setq major-mode 'gdb-frames-mode) + (setq mode-name "Frames") + (setq buffer-read-only t) + (use-local-map gdb-frames-mode-map) + (font-lock-mode -1) + (gdb-invalidate-frames)) + +(defun gdb-get-frame-number () + (save-excursion + (let* ((pos (re-search-backward "^#\\([0-9]*\\)" nil t)) + (n (or (and pos (match-string-no-properties 1)) "0"))) + n))) + +(defun gdb-frames-select () + "Make the frame on the current line become the current frame and display the +source in the source buffer." + (interactive) + (gdb-enqueue-input + (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) + (gud-display-frame)) + +(defun gdb-frames-mouse-select (event) + "Make the selected frame become the current frame and display the source in +the source buffer." + (interactive "e") + (mouse-set-point event) + (gdb-frames-select)) + +;; +;; Threads buffer. This displays a selectable thread list. +;; +(gdb-set-buffer-rules 'gdb-threads-buffer + 'gdb-threads-buffer-name + 'gdb-threads-mode) + +(def-gdb-auto-updated-buffer gdb-threads-buffer + gdb-invalidate-threads + "info threads\n" + gdb-info-threads-handler + gdb-info-threads-custom) + +(defun gdb-info-threads-custom () + (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (< (point) (point-max)) + (put-text-property (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) + 'mouse-face 'highlight) + (forward-line 1))))) + +(defun gdb-threads-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*threads of " (gdb-get-target-string) "*"))) + +(defun gdb-display-threads-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-threads-buffer))) + +(defun gdb-frame-threads-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-threads-buffer))) + +(defvar gdb-threads-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-threads-select) + (define-key map [mouse-2] 'gdb-threads-mouse-select) + map)) + +(defun gdb-threads-mode () + "Major mode for gdb frames. + +\\{gdb-frames-mode-map}" + (setq major-mode 'gdb-threads-mode) + (setq mode-name "Threads") + (setq buffer-read-only t) + (use-local-map gdb-threads-mode-map) + (gdb-invalidate-threads)) + +(defun gdb-get-thread-number () + (save-excursion + (re-search-backward "^\\s-*\\([0-9]*\\)" nil t) + (match-string-no-properties 1))) + + +(defun gdb-threads-select () + "Make the thread on the current line become the current thread and display the +source in the source buffer." + (interactive) + (gdb-enqueue-input + (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) + (gud-display-frame)) + +(defun gdb-threads-mouse-select (event) + "Make the selected frame become the current frame and display the source in +the source buffer." + (interactive "e") + (mouse-set-point event) + (gdb-threads-select)) + +;; +;; Registers buffer. +;; +(gdb-set-buffer-rules 'gdb-registers-buffer + 'gdb-registers-buffer-name + 'gdb-registers-mode) + +(def-gdb-auto-updated-buffer gdb-registers-buffer + gdb-invalidate-registers + "server info registers\n" + gdb-info-registers-handler + gdb-info-registers-custom) + +(defun gdb-info-registers-custom ()) + +(defvar gdb-registers-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-registers-mode () + "Major mode for gdb registers. + +\\{gdb-registers-mode-map}" + (setq major-mode 'gdb-registers-mode) + (setq mode-name "Registers") + (setq buffer-read-only t) + (use-local-map gdb-registers-mode-map) + (gdb-invalidate-registers)) + +(defun gdb-registers-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*registers of " (gdb-get-target-string) "*"))) + +(defun gdb-display-registers-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-registers-buffer))) + +(defun gdb-frame-registers-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-registers-buffer))) + +;; +;; Locals buffer. +;; +(gdb-set-buffer-rules 'gdb-locals-buffer + 'gdb-locals-buffer-name + 'gdb-locals-mode) + +(def-gdb-auto-updated-buffer gdb-locals-buffer + gdb-invalidate-locals + "server info locals\n" + gdb-info-locals-handler + gdb-info-locals-custom) + +;; Abbreviate for arrays and structures. +;; These can be expanded using gud-display. +(defun gdb-info-locals-handler nil + (gdb-set-pending-triggers (delq 'gdb-invalidate-locals + (gdb-get-pending-triggers))) + (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward "^ .*\n" nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (while (re-search-forward "{[-0-9, {}\]*\n" nil t) + (replace-match "(array);\n" nil nil)) + (goto-char (point-min)) + (while (re-search-forward "{.*=.*\n" nil t) + (replace-match "(structure);\n" nil nil)))) + (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) + (and buf (with-current-buffer buf + (let ((p (point)) + (buffer-read-only nil)) + (delete-region (point-min) (point-max)) + (insert-buffer-substring (gdb-get-create-buffer + 'gdb-partial-output-buffer)) + (goto-char p))))) + (run-hooks 'gdb-info-locals-hook)) + +(defun gdb-info-locals-custom () + nil) + +(defvar gdb-locals-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-locals-mode () + "Major mode for gdb locals. + +\\{gdb-locals-mode-map}" + (setq major-mode 'gdb-locals-mode) + (setq mode-name "Locals") + (setq buffer-read-only t) + (use-local-map gdb-locals-mode-map) + (gdb-invalidate-locals)) + +(defun gdb-locals-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*locals of " (gdb-get-target-string) "*"))) + +(defun gdb-display-locals-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-locals-buffer))) + +(defun gdb-frame-locals-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-locals-buffer))) + +;; +;; Display expression buffer. +;; +(gdb-set-buffer-rules 'gdb-display-buffer + 'gdb-display-buffer-name + 'gdb-display-mode) + +(def-gdb-auto-updated-buffer gdb-display-buffer + ;; `gdb-display-buffer'. + gdb-invalidate-display + "server info display\n" + gdb-info-display-handler + gdb-info-display-custom) + +(defun gdb-info-display-custom () + (let ((display-list nil)) + (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) + (goto-char (point-min)) + (while (< (point) (- (point-max) 1)) + (forward-line 1) + (if (looking-at "\\([0-9]+\\): \\([ny]\\)") + (setq display-list + (cons (string-to-int (match-string 1)) display-list))) + (end-of-line))) + (if (not (display-graphic-p)) + (progn + (dolist (buffer (buffer-list)) + (if (string-match "\\*display \\([0-9]+\\)\\*" (buffer-name buffer)) + (progn + (let ((number + (match-string 1 (buffer-name buffer)))) + (if (not (memq (string-to-int number) display-list)) + (kill-buffer + (get-buffer (concat "*display " number "*"))))))))) + (gdb-delete-frames display-list)))) + +(defun gdb-delete-frames (display-list) + (dolist (frame (frame-list)) + (let ((frame-name (frame-parameter frame 'name))) + (if (string-match "\\*display \\([0-9]+\\)\\*" frame-name) + (progn + (let ((number (match-string 1 frame-name))) + (if (not (memq (string-to-int number) display-list)) + (progn (kill-buffer + (get-buffer (concat "*display " number "*"))) + (delete-frame frame))))))))) + +(defvar gdb-display-mode-map + (let ((map (make-sparse-keymap)) + (menu (make-sparse-keymap "Display"))) + (define-key menu [toggle] '("Toggle" . gdb-toggle-display)) + (define-key menu [delete] '("Delete" . gdb-delete-display)) + + (suppress-keymap map) + (define-key map [menu-bar display] (cons "Display" menu)) + (define-key map " " 'gdb-toggle-display) + (define-key map "d" 'gdb-delete-display) + map)) + +(defun gdb-display-mode () + "Major mode for gdb display. + +\\{gdb-display-mode-map}" + (setq major-mode 'gdb-display-mode) + (setq mode-name "Display") + (setq buffer-read-only t) + (use-local-map gdb-display-mode-map) + (gdb-invalidate-display)) + +(defun gdb-display-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*Displayed expressions of " (gdb-get-target-string) "*"))) + +(defun gdb-display-display-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-display-buffer))) + +(defun gdb-frame-display-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-display-buffer))) + +(defun gdb-toggle-display () + "Enable/disable the displayed expression at current line." + (interactive) + (save-excursion + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) + (error "No expression on this line") + (gdb-enqueue-input + (list + (concat + (if (eq ?y (char-after (match-beginning 2))) + "server disable display " + "server enable display ") + (match-string 1) "\n") + 'ignore))))) + +(defun gdb-delete-display () + "Delete the displayed expression at current line." + (interactive) + (with-current-buffer (gdb-get-buffer 'gdb-display-buffer) + (beginning-of-line 1) + (if (not (looking-at "\\([0-9]+\\): \\([ny]\\)")) + (error "No expression on this line") + (let ((number (match-string 1))) + (gdb-enqueue-input + (list (concat "server delete display " number "\n") 'ignore)))))) + +(defvar gdb-expressions-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "v" 'gdb-array-visualise) + (define-key map "q" 'gdb-delete-expression) + (define-key map [mouse-3] 'gdb-expressions-popup-menu) + map)) + +(defvar gdb-expressions-mode-menu + '("GDB Expressions Commands" + "----" + ["Visualise" gdb-array-visualise t] + ["Delete" gdb-delete-expression t]) + "Menu for `gdb-expressions-mode'.") + +(defun gdb-expressions-popup-menu (event) + "Explicit Popup menu as this buffer doesn't have a menubar." + (interactive "@e") + (mouse-set-point event) + (popup-menu gdb-expressions-mode-menu)) + +(defun gdb-expressions-mode () + "Major mode for display expressions. + +\\{gdb-expressions-mode-map}" + (setq major-mode 'gdb-expressions-mode) + (setq mode-name "Expressions") + (use-local-map gdb-expressions-mode-map) + (make-local-variable 'gdb-display-number) + (make-local-variable 'gdb-values) + (make-local-variable 'gdb-expression) + (set (make-local-variable 'gdb-display-string) nil) + (set (make-local-variable 'gdb-dive-display-number) nil) + (set (make-local-variable 'gud-minor-mode) 'gdba) + (set (make-local-variable 'gdb-array-start) (make-vector 16 '-1)) + (set (make-local-variable 'gdb-array-stop) (make-vector 16 '-1)) + (set (make-local-variable 'gdb-array-size) (make-vector 16 '-1)) + (setq buffer-read-only t)) + + +;;;; Window management + +;;; The way we abuse the dedicated-p flag is pretty gross, but seems +;;; to do the right thing. Seeing as there is no way for Lisp code to +;;; get at the use_time field of a window, I'm not sure there exists a +;;; more elegant solution without writing C code. + +(defun gdb-display-buffer (buf &optional size) + (let ((must-split nil) + (answer nil)) + (unwind-protect + (progn + (walk-windows + '(lambda (win) + (if (or (eq gud-comint-buffer (window-buffer win)) + (eq gdb-source-window win)) + (set-window-dedicated-p win t)))) + (setq answer (get-buffer-window buf)) + (if (not answer) + (let ((window (get-lru-window))) + (if window + (progn + (set-window-buffer window buf) + (setq answer window)) + (setq must-split t))))) + (walk-windows + '(lambda (win) + (if (or (eq gud-comint-buffer (window-buffer win)) + (eq gdb-source-window win)) + (set-window-dedicated-p win nil))))) + (if must-split + (let* ((largest (get-largest-window)) + (cur-size (window-height largest)) + (new-size (and size (< size cur-size) (- cur-size size)))) + (setq answer (split-window largest new-size)) + (set-window-buffer answer buf))) + answer)) + +(defun gdb-display-source-buffer (buffer) + (if (eq gdb-selected-view 'source) + (set-window-buffer gdb-source-window buffer) + (set-window-buffer gdb-source-window + (gdb-get-buffer 'gdb-assembler-buffer))) + gdb-source-window) + + +;;; Shared keymap initialization: + +(let ((menu (make-sparse-keymap "GDB-Frames"))) + (define-key gud-menu-map [frames] + `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) + (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) + (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) + (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) + (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) + (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) + (define-key menu [display] '("Display" . gdb-frame-display-buffer)) + (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) +; (define-key menu [assembler] '("Assembler" . gdb-frame-assembler-buffer)) +) + +(let ((menu (make-sparse-keymap "GDB-Windows"))) + (define-key gud-menu-map [displays] + `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) + (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) + (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) + (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) + (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) + (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) + (define-key menu [display] '("Display" . gdb-display-display-buffer)) + (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) +; (define-key menu [assembler] '("Assembler" . gdb-display-assembler-buffer)) +) + +(let ((menu (make-sparse-keymap "View"))) + (define-key gud-menu-map [view] + `(menu-item "View" ,menu :visible (eq gud-minor-mode 'gdba))) +; (define-key menu [both] '(menu-item "Both" gdb-view-both +; :help "Display both source and assembler" +; :button (:radio . (eq gdb-selected-view 'both)))) + (define-key menu [assembler] '(menu-item "Assembler" gdb-view-assembler + :help "Display assembler only" + :button (:radio . (eq gdb-selected-view 'assembler)))) + (define-key menu [source] '(menu-item "Source" gdb-view-source-function + :help "Display source only" + :button (:radio . (eq gdb-selected-view 'source))))) + +(let ((menu (make-sparse-keymap "GDB-UI"))) + (define-key gud-menu-map [ui] + `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba))) + (define-key menu [gdb-restore-windows] + '("Restore window layout" . gdb-restore-windows)) + (define-key menu [gdb-many-windows] + (menu-bar-make-toggle gdb-many-windows gdb-many-windows + "Display other windows" "Many Windows %s" + "Display locals, stack and breakpoint information"))) + +(defun gdb-frame-gdb-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdba))) + +(defun gdb-display-gdb-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdba))) + +(defvar gdb-main-file nil "Source file from which program execution begins.") + +(defun gdb-view-source-function () + (interactive) + (if gdb-view-source + (if gud-last-last-frame + (set-window-buffer gdb-source-window + (gud-find-file (car gud-last-last-frame))) + (set-window-buffer gdb-source-window (gud-find-file gdb-main-file)))) + (setq gdb-selected-view 'source)) + +(defun gdb-view-assembler() + (interactive) + (set-window-buffer gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + (setq gdb-selected-view 'assembler)) + +;(defun gdb-view-both() +;(interactive) +;(setq gdb-selected-view 'both)) + +;; layout for all the windows +(defun gdb-setup-windows () + (gdb-display-locals-buffer) + (gdb-display-stack-buffer) + (delete-other-windows) + (gdb-display-breakpoints-buffer) + (gdb-display-display-buffer) + (delete-other-windows) + (switch-to-buffer gud-comint-buffer) + (split-window nil ( / ( * (window-height) 3) 4)) + (split-window nil ( / (window-height) 3)) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-locals-buffer-name)) + (other-window 1) + (if (and gdb-view-source + (eq gdb-selected-view 'source)) + (switch-to-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-inferior-io-name)) + (other-window 1) + (switch-to-buffer (gdb-stack-buffer-name)) + (split-window-horizontally) + (other-window 1) + (switch-to-buffer (gdb-breakpoints-buffer-name)) + (other-window 1)) + +(defcustom gdb-many-windows nil + "Nil means that gdb starts with just two windows : the GUD and +the source buffer." + :type 'boolean + :group 'gud) + +(defun gdb-many-windows (arg) +"Toggle the number of windows in the basic arrangement." + (interactive "P") + (setq gdb-many-windows + (if (null arg) + (not gdb-many-windows) + (> (prefix-numeric-value arg) 0))) + (gdb-restore-windows)) + +(defun gdb-restore-windows () + "Restore the basic arrangement of windows used by gdba. +This arrangement depends on the value of `gdb-many-windows'." + (interactive) + (if gdb-many-windows + (progn + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (gdb-setup-windows)) + (switch-to-buffer gud-comint-buffer) + (delete-other-windows) + (split-window) + (other-window 1) + (if (and gdb-view-source + (eq gdb-selected-view 'source)) + (switch-to-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (other-window 1))) + +(defun gdb-reset () + "Exit a debugging session cleanly by killing the gdb buffers and resetting + the source buffers." + (gdb-delete-frames '()) + (dolist (buffer (buffer-list)) + (if (not (eq buffer gud-comint-buffer)) + (with-current-buffer buffer + (if (eq gud-minor-mode 'gdba) + (if (string-match "^\*.+*$" (buffer-name)) + (kill-buffer nil) + (if (eq window-system 'x) + (remove-images (point-min) (point-max)) + (gdb-remove-strings (point-min) (point-max))) + (setq left-margin-width 0) + (setq gud-minor-mode nil) + (kill-local-variable 'tool-bar-map) + (setq gud-running nil) + (if (get-buffer-window (current-buffer)) + (set-window-margins (get-buffer-window + (current-buffer)) + left-margin-width + right-margin-width)))))))) + +(defun gdb-source-info () + "Find the source file where the program starts and displays it with related +buffers." + (goto-char (point-min)) + (if (search-forward "directory is " nil t) + (progn + (if (looking-at "\\S-*:\\(\\S-*\\)") + (setq gdb-cdir (match-string 1)) + (looking-at "\\S-*") + (setq gdb-cdir (match-string 0))) + (search-forward "Located in ") + (looking-at "\\S-*") + (setq gdb-main-file (match-string 0))) + (setq gdb-view-source nil)) + (delete-other-windows) + (switch-to-buffer gud-comint-buffer) + (if gdb-many-windows + (gdb-setup-windows) + (gdb-display-breakpoints-buffer) + (gdb-display-display-buffer) + (delete-other-windows) + (split-window) + (other-window 1) + (if gdb-view-source + (switch-to-buffer + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)) + (gdb-invalidate-assembler)) + (setq gdb-source-window (get-buffer-window (current-buffer))) + (other-window 1))) + +;;from put-image +(defun gdb-put-string (putstring pos) + "Put string PUTSTRING in front of POS in the current buffer. +PUTSTRING is displayed by putting an overlay into the current buffer with a +`before-string' STRING that has a `display' property whose value is +PUTSTRING." + (setq string "x") + (let ((buffer (current-buffer))) + (setq string (copy-sequence string)) + (let ((overlay (make-overlay pos pos buffer)) + (prop (list (list 'margin 'left-margin) putstring))) + (put-text-property 0 (length string) 'display prop string) + (overlay-put overlay 'put-break t) + (overlay-put overlay 'before-string string)))) + +;;from remove-images +(defun gdb-remove-strings (start end &optional buffer) + "Remove strings between START and END in BUFFER. +Remove only strings that were put in BUFFER with calls to `put-string'. +BUFFER nil or omitted means use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + (let ((overlays (overlays-in start end))) + (while overlays + (let ((overlay (car overlays))) + (when (overlay-get overlay 'put-break) + (delete-overlay overlay))) + (setq overlays (cdr overlays))))) + +(defun gdb-put-arrow (putstring pos) + "Put arrow string PUTSTRING in the left margin in front of POS +in the current buffer. PUTSTRING is displayed by putting an +overlay into the current buffer with a `before-string' +\"gdb-arrow\" that has a `display' property whose value is +PUTSTRING. STRING is defaulted if you omit it. POS may be an +integer or marker." + (setq string "gdb-arrow") + (let ((buffer (current-buffer))) + (setq string (copy-sequence string)) + (let ((overlay (make-overlay pos pos buffer)) + (prop (list (list 'margin 'left-margin) putstring))) + (put-text-property 0 (length string) 'display prop string) + (overlay-put overlay 'put-arrow t) + (overlay-put overlay 'before-string string)))) + +(defun gdb-remove-arrow (&optional buffer) + "Remove arrow in BUFFER. +Remove only images that were put in BUFFER with calls to `put-arrow'. +BUFFER nil or omitted means use the current buffer." + (unless buffer + (setq buffer (current-buffer))) + (let ((overlays (overlays-in (point-min) (point-max)))) + (while overlays + (let ((overlay (car overlays))) + (when (overlay-get overlay 'put-arrow) + (delete-overlay overlay))) + (setq overlays (cdr overlays))))) + +(defun gdb-array-visualise () + "Visualise arrays and slices using graph program from plotutils." + (interactive) + (when (and (display-graphic-p) gdb-display-string) + (let ((n 0) m) + (catch 'multi-dimensional + (while (eq (aref gdb-array-start n) (aref gdb-array-stop n)) + (setq n (+ n 1))) + (setq m (+ n 1)) + (while (< m (length gdb-array-start)) + (if (not (eq (aref gdb-array-start m) (aref gdb-array-stop m))) + (progn + (x-popup-dialog + t `(,(concat "Only one dimensional data can be visualised.\n" + "Use an array slice to reduce the number of\n" + "dimensions") ("OK" t))) + (throw 'multi-dimensional nil)) + (setq m (+ m 1)))) + (shell-command (concat "echo" gdb-display-string " | graph -a 1 " + (int-to-string (aref gdb-array-start n)) + " -x " + (int-to-string (aref gdb-array-start n)) + " " + (int-to-string (aref gdb-array-stop n)) + " 1 -T X")))))) + +(defun gdb-delete-expression () + "Delete displayed expression and its frame." + (interactive) + (gdb-enqueue-input + (list (concat "server delete display " gdb-display-number "\n") + 'ignore))) + +;; +;; Assembler buffer. +;; +(gdb-set-buffer-rules 'gdb-assembler-buffer + 'gdb-assembler-buffer-name + 'gdb-assembler-mode) + +(def-gdb-auto-updated-buffer gdb-assembler-buffer + gdb-invalidate-assembler + (concat "server disassemble " gdb-current-address "\n") + gdb-assembler-handler + gdb-assembler-custom) + +(defun gdb-assembler-custom () + (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer)) + (gdb-arrow-position 1) (address) (flag)) + (with-current-buffer buffer + (if (not (equal gdb-current-address "main")) + (progn + (gdb-remove-arrow) + (goto-char (point-min)) + (if (re-search-forward gdb-current-address nil t) + (progn + (setq gdb-arrow-position (point)) + (gdb-put-arrow "=>" (point)))))) + ;; remove all breakpoint-icons in assembler buffer before updating. + (if (eq window-system 'x) + (remove-images (point-min) (point-max)) + (gdb-remove-strings (point-min) (point-max)))) + (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) + (goto-char (point-min)) + (while (< (point) (- (point-max) 1)) + (forward-line 1) + (if (looking-at "[^\t].*breakpoint") + (progn + (looking-at + "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*0x\\(\\S-*\\)") + (setq flag (char-after (match-beginning 1))) + (setq address (match-string 2)) + ;; remove leading 0s from output of info break. + (if (string-match "^0+\\(.*\\)" address) + (setq address (match-string 1 address))) + (with-current-buffer buffer + (goto-char (point-min)) + (if (re-search-forward address nil t) + (let ((start (progn (beginning-of-line) (- (point) 1))) + (end (progn (end-of-line) (+ (point) 1)))) + (if (eq window-system 'x) + (progn + (remove-images start end) + (if (eq ?y flag) + (put-image breakpoint-enabled-icon + (+ start 1) + "breakpoint icon enabled" + 'left-margin) + (put-image breakpoint-disabled-icon + (+ start 1) + "breakpoint icon disabled" + 'left-margin))) + (gdb-remove-strings start end) + (if (eq ?y flag) + (gdb-put-string "B" (+ start 1)) + (gdb-put-string "b" (+ start 1))))))))))) + (if (not (equal gdb-current-address "main")) + (set-window-point (get-buffer-window buffer) gdb-arrow-position)))) + +(defvar gdb-assembler-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + map)) + +(defun gdb-assembler-mode () + "Major mode for viewing code assembler. + +\\{gdb-assembler-mode-map}" + (setq major-mode 'gdb-assembler-mode) + (setq mode-name "Assembler") + (setq left-margin-width 2) + (setq fringes-outside-margins t) + (setq buffer-read-only t) + (use-local-map gdb-assembler-mode-map) + (gdb-invalidate-assembler) + (gdb-invalidate-breakpoints)) + +(defun gdb-assembler-buffer-name () + (with-current-buffer gud-comint-buffer + (concat "*Machine Code " (gdb-get-target-string) "*"))) + +(defun gdb-display-assembler-buffer () + (interactive) + (gdb-display-buffer + (gdb-get-create-buffer 'gdb-assembler-buffer))) + +(defun gdb-frame-assembler-buffer () + (interactive) + (switch-to-buffer-other-frame + (gdb-get-create-buffer 'gdb-assembler-buffer))) + +;; modified because if gdb-current-address has changed value a new command +;; must be enqueued to update the buffer with the new output +(defun gdb-invalidate-assembler (&optional ignored) + (if (gdb-get-buffer 'gdb-assembler-buffer) + (progn + (if (string-equal gdb-current-frame gdb-previous-frame) + (gdb-assembler-custom) + (if (or (not (member 'gdb-invalidate-assembler + (gdb-get-pending-triggers))) + (not (string-equal gdb-current-address + gdb-previous-address))) + (progn + ;; take previous disassemble command off the queue + (with-current-buffer gud-comint-buffer + (let ((queue (gdb-get-idle-input-queue)) (item)) + (dolist (item queue) + (if (equal (cdr item) '(gdb-assembler-handler)) + (gdb-set-idle-input-queue + (delete item (gdb-get-idle-input-queue))))))) + (gdb-enqueue-idle-input + (list (concat "server disassemble " gdb-current-address "\n") + 'gdb-assembler-handler)) + (gdb-set-pending-triggers + (cons 'gdb-invalidate-assembler + (gdb-get-pending-triggers))) + (setq gdb-previous-address gdb-current-address) + (setq gdb-previous-frame gdb-current-frame))))))) + +(defun gdb-get-current-frame () + (if (not (member 'gdb-get-current-frame (gdb-get-pending-triggers))) + (progn + (gdb-enqueue-idle-input + (list (concat "server info frame\n") 'gdb-frame-handler)) + (gdb-set-pending-triggers + (cons 'gdb-get-current-frame + (gdb-get-pending-triggers)))))) + +(defun gdb-frame-handler () + (gdb-set-pending-triggers + (delq 'gdb-get-current-frame (gdb-get-pending-triggers))) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (forward-line) + (if (looking-at ".*= 0x\\(\\S-*\\) in \\(\\S-*\\)") + (progn + (setq gdb-current-frame (match-string 2)) + (let ((address (match-string 1))) + ;; remove leading 0s from output of info frame command. + (if (string-match "^0+\\(.*\\)" address) + (setq gdb-current-address + (concat "0x" (match-string 1 address))) + (setq gdb-current-address (concat "0x" address)))) + (if (or (if (not (looking-at ".*(\\S-*:[0-9]*)")) + (progn (setq gdb-view-source nil) t)) + (eq gdb-selected-view 'assembler)) + (progn + (set-window-buffer + gdb-source-window + (gdb-get-create-buffer 'gdb-assembler-buffer)) + (gdb-invalidate-assembler))))))) + +(provide 'gdb-ui) + +;;; gdb-ui.el ends here diff --git a/lisp/toolbar/gud-display.pbm b/lisp/toolbar/gud-display.pbm new file mode 100644 index 0000000000000000000000000000000000000000..df2349619e73a18c0a79e6b70b8c3a1844bf077f GIT binary patch literal 81 ncmWGA;W9E&Ff!p{Kn8pa3~VrD$H0)rz;Fx|0Y&VQH6YjkF)Iel literal 0 HcmV?d00001 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 @@ +/* XPM */ +static char * display_xpm[] = { +"24 24 2 1", +" c #C0C0C0C0C0C0", +". c #000000000000", +" ", +" ", +" ", +" ", +" ... ", +" .. ", +" .. ", +" .. ", +" ..... ", +" .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" ...... ", +" ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/lisp/toolbar/gud-next.pbm b/lisp/toolbar/gud-next.pbm new file mode 100644 index 0000000000000000000000000000000000000000..dc2a15323e3846ddf4256f98ddbe99394cca924b GIT binary patch literal 81 zcmWGA;W9E&Ff!p{KmyGF8CVz^I2ar_XE<>4IB@d@F!MYBBL_A%2WB1yWW+cFNhbpX E0F<2wPyhe` literal 0 HcmV?d00001 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 @@ +/* XPM */ +static char * next_xpm[] = { +"24 24 7 1", +" c #c0c0c0", +". c #cc0033", +"X c #616161", +"o c #2a1f55", +"O c #adadad", +"+ c #d40000", +"@ c #cc9999", +" ", +" ", +" ", +" ", +" .......... ", +" . . ", +" . . ", +" . Xo oX . ", +" . XoO OoX . ", +" . oo oo +@.@+ ", +" oo oo @...@ ", +" oo oo ... ", +" oX Xo @.@ ", +" oo oo . ", +" oX Xo ", +" oo oo ", +" oo oo ", +" oo oo ", +" XoO OoX ", +" Xo oX ", +" ", +" ", +" ", +" "}; diff --git a/lisp/toolbar/gud-nexti.pbm b/lisp/toolbar/gud-nexti.pbm new file mode 100644 index 0000000000000000000000000000000000000000..ecad2965b0d01f7a7e2d2ea95e27a4b4401004ad GIT binary patch literal 81 zcmWGA;W9E&Ff!p{KmyGF8CVz^I2atDXkq~4j0em-57^ioc$k5RfsKuUnTLUK1_Q$c IByC_O0IKQpR4hbM)V=!Q5NMLL@z|hcu IqzTFd0FY1#A^-pY literal 0 HcmV?d00001 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 @@ +/* XPM */ +static char * gud_stepi_xpm[] = { +"24 24 5 1", +" c #C0C0C0C0C0C0", +". c #D4D400000000", +"X c #616161616161", +"o c #2A2A1F1F5555", +"O c #CCCC99999999", +" ", +" ", +" ", +" ", +" ..... ", +" . . ", +" . . ", +" . . ", +" . X . X ", +" . Xo .O.O. oX ", +" Xo O...O oX ", +" Xo ... oX ", +" Xo O.O oX ", +" oX . Xo ", +" oX Xo ", +" oX Xo ", +" oX Xo ", +" o o ", +" ", +" ", +" ", +" ", +" ", +" "}; 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 @@ +@setfilename ../info/index + +@c Indexing guidelines + +@c I assume that all indexes will be combinded. +@c Therefore, if a generated findex and permutations +@c cover the ways an index user would look up the entry, +@c then no cindex is added. +@c Concept index (cindex) entries will also be permuted. Therefore, they +@c have no commas and few irrelevant connectives in them. + +@c I tried to include words in a cindex that give the context of the entry, +@c particularly if there is more than one entry for the same concept. +@c For example, "nil in keymap" +@c Similarly for explicit findex and vindex entries, e.g., "print example". + +@c Error codes are given cindex entries, e.g., "end-of-file error". + +@c pindex is used for .el files and Unix programs + +@node Index, New Symbols, Standard Hooks, Top +@unnumbered Index + + +All variables, functions, keys, programs, files, and concepts are +in this one index. + +All names and concepts are permuted, so they appear several times, one +for each permutation of the parts of the name. For example, +@code{function-name} would appear as @b{function-name} and @b{name, +function-}. + + +@c Print the indices + +@printindex fn + + 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 @@ +@c -*-texinfo-*- +@setfilename ../info/index + +@c Indexing guidelines + +@c I assume that all indexes will be combinded. +@c Therefore, if a generated findex and permutations +@c cover the ways an index user would look up the entry, +@c then no cindex is added. +@c Concept index (cindex) entries will also be permuted. Therefore, they +@c have no commas and few irrelevant connectives in them. + +@c I tried to include words in a cindex that give the context of the entry, +@c particularly if there is more than one entry for the same concept. +@c For example, "nil in keymap" +@c Similarly for explicit findex and vindex entries, e.g. "print example". + +@c Error codes are given cindex entries, e.g. "end-of-file error". + +@c pindex is used for .el files and Unix programs + +@node Index, New Symbols, Standard Hooks, Top +@unnumbered Index + +@c Print the indices + +@printindex fn + + 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 @@ +#!/bin/sh +# Generate a permuted index of all names. +# The result is a file called index.fns. + +# Copyright (C) 2001 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs; see the file COPYING. If not, write to the +# Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +# You will need to modify this for your needs. + + +set TEXINDEX=texindex # path to texindex command +#set EMACS=gnuemacs # your emacs command +#set TEX=tex # your tex command + +set MANUAL=elisp # the base name of the manual + +# goto 3 + +1: +echo "Extract raw index from texinfo fn index." +# Let texindex combine duplicate entries, later. +# But it wants to protect non-alphanumerics thus confusing ptx. +# Also change `\ ' to just a ` ', since texindex will fail. This is produced +# by `@findex two words' in an example environment (no doubt among others). +# delete wrapper parens +# change dots {} to dots{} +# change {-} to char form, so ptx wont ignore it. +# delete leading \entry { +# change '\ ' to ' ' +# change lines with = < > since they mess up field extraction. +# separate into fields delimited by " +rm -f permuted.raw +cat ${MANUAL}.fn | \ + sed \ + -e 's/(\([^)]*\))/\1/' \ + -e 's/\\dots {}/(\\dots{})/' \ + -e "s/{-}/{{\\tt\\char'055}}/" \ + -e 's,^[^ ]* {,,' \ + -e 's, },},' \ + -e 's,\\ , ,g' \ + -e 's/{\\tt\\char61}/=/' \ + -e 's/{\\tt\\gtr}/>/' \ + -e 's/{\\tt\\less}/ permuted.raw + +2: +# Build break file for ptx. +cat < permuted.break +- +: +EOF +# Build the ignore file for ptx. +# We would like to ignore "and", "or", and "for", +# but ptx ignores ignore words even if they stand alone. +cat < permuted.ignore +the +in +to +as +a +an +of +on +them +how +from +by +EOF + +echo "Make troff permuted index." +rm -f permuted.t +ptx -i permuted.ignore -b permuted.break -f -r -w 144 \ + < permuted.raw > permuted.t + +3: +echo "Extract the desired fields." +rm -f permuted.fields +awk -F\" '{printf "%s\"%s\"%s\n", $4,$6,$9}' permuted.t > permuted.fields + +4: +echo "Format for texindex." +# delete lines that start with "and ", "for " +sed < permuted.fields \ + -e 's/=/{\\tt\\char61}/' \ + -e 's/>/{\\tt\\gtr}/' \ + -e 's/0 {if ($1=="") {\ + print "\entry {" $2 "}{" 0+$3 "}{" $2 "}" }\ + else {\ + print "\entry {" $2 ", " $1 "}{" 0+$3 "}{" $2 ", " $1 "}"} }'\ + > permuted.fn + +5: +echo "Sort with texindex." +${TEXINDEX} permuted.fn +#mv permuted.fns ${MANUAL}.fns + +# The resulting permuted.fns will be read when we run TeX +# on the manual the second time. Or you can use permuted.texinfo here. +#${TEX} permuted.texinfo + +6: +echo "Clean up." +rm -f permuted.fields permuted.t permuted.raw +rm -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 0000000000000000000000000000000000000000..1a017ac4fe47eb2f9264e422932d821cd9a36913 GIT binary patch literal 6058 zcmd^DOKcn06}>|#l9CQdK}{2*Fzg9jv}uSGa*(7d5mmAxIdLM{hAcB#1!76s7C@1L zKCuG?FzEtmPy}dq?V<>RqKmd*?XHS`Hq#GUG@w4{ve0i=w9tnsIvfr;b9gU}la%DkE1I?k=sE2wf2mWdK zlzk*_hz|e`UG$tVHqX#$@Kuo}zJjD)3C;-`%}{CE7QG%;qxjGz~o_ zH4N&b$w0b$;HZY|aEe&t85($?MhLMzP9JGsrQG=V(`|LFJC;<;(+&_yL=hDhD-0v#G5lJ;FmQF9rjZ4 z#c#Cd`?dCrgFiE#8yp-o&M&4?#+B@~<(qK?c|N<6NyeAwvKjQ}c~f%-0%VDLx5Kl2 zv-EvT+0&?feO~Ry%yTtV9Unb0@Q2Y86hOT*8qmiKIu$UwPmLMfI$9bt0(9rH_Ps~m zr-g2|(M{Bkr8ldYT{#+YW%Q$PnL}+B_P--$!$Oo!3sK<;T2|05*AcJY7NXH!A#Ze6 z;Gd~r9Gf9Lgg`jH2FS1|5uw48$StnR7SuY}aB#oqsRs7|fHys!wpg*W;j^GYx-FLZ za2v}^C(m7)1z;P$ZHATl+8*h}Vo{h>;_muRT{nq>s~%5ldmBVW!b9Rv*&zME46-$8 z57gSv_db>H)Q7#6z7EqwyKG;@zq&yO2S^4(CLK@+oJvmd2oF4ug`Y6^unFGJP^YlV zyczbU;$V*l8frRbyK!((ECSZ0IV4{!>N@GP#$B2vXx5vwBoHT7=>N9JwRgm%lv@0> zxG;ew)Kn8?6c3XMtYepb1z|Zg$F_aMYaQ2DPT0HRSu{F_u^-y#t)TWTY$F1W@{)C zZeXdgmSnt#k1^{3_u(v;u>s~G*755dyEwz-aog6);}yI-R-4DEcZ}jjBacsZ z#yVVNtI?+aoja;?2OYO#79EYvH~lkiQZ)YMR~R{R})D?Ch>$gvC9$DzSs@-H(}vJ-yES z+QzozfeV5IT|WeWcZ-Va7(rwZJQUR}Q!jEC=Jl$$y8-Y3EMZXf?S0(J8vEe*pAras z5Ofe%lP1Uthg&i;J)0gN%!6 zhlw^2xQ!+6ca!QK#|N=0Zqq<}&wRwk>k4lJYuvf1pd2)v0CRYMR;r$X`|%1en{f*c zqz_T&zJ6G;m&FPItCg~!fuBW_u^4w{%oR2xlt+(>TWHvkLL){Fo0AS4 ziQ^4MWdh_@(Iaow^2h~mLTI@HJtKK?^A*bHU5lzBk}tR}q%E9kly?gjRS;aI63L5# z!wy)%;r?)65d}n2aolQ*$}yRt?*MX}B2{+jHqfaq2T~f40dNLR70JT~V4OY$Wk3d? zGJs36^Ag3Q-r$k)R*@Wnm|L^#x{r%Op7FBaFeM%-U{v@NRHY_IO$8_&SQwrf2Zy~_ z=Nt&PKQL^@n}ezhuAYxYkcb3bHs8eUMxFaQKIox5L{hCBE8u>OYbDIOO;8$;IHtif zdmjkQk$J%Gk)B>hS2(zacbfG;ZshsjX|@fgYE|XZF8hr1C=F`GQ1?Pl4!>_tj}MIh z@xmvOPtN@1%&#@`6dM`T+^~DQA>{8i{&%y9AllWu*hurSV;V^zvL=w&JtnDrP?6|DA%M9NfQ-9i;N zcxYHQ;oeAAL-OG4m{p0`l&@PN0s~ZS*!4;^f)g-?b1)_%F)J3UR|s2ISY;dgpx`># zKQ$bIHi=4wS0%P1wDDI}o1hL;0s&YQ!J>C#yfm=n!Ixbe5a@xEg0~}Y5|05-yn`gd z3>Q9W9$HQY0@QzHW}3eqefP$-RXid<+oFdOW?n$zENqfsjpI6Y%Y<09{L%y_ztJNHI^KJ?>HUL3b>BD>xmWH)gU~V=}&YJr%liGm~00 M7E?>vmBmErzd1q**#H0l literal 0 HcmV?d00001 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 @@ -@c This is part of the Emacs manual. -@c Copyright (C) 1985,86,87,93,94,95,97,2000,2001,2002,2003 -@c Free Software Foundation, Inc. -@c See file emacs.texi for copying conditions. -@node Keyboard Macros, Files, Fixit, Top -@chapter Keyboard Macros -@cindex defining keyboard macros -@cindex keyboard macro - - In this chapter we describe how a sequence of editing commands can -be recorded and repeated multiple times. - - A @dfn{keyboard macro} is a command defined by the user to stand for -another sequence of keys. For example, if you discover that you are -about to type @kbd{C-n C-d} forty times, you can speed your work by -defining a keyboard macro to do @kbd{C-n C-d} and calling it with a -repeat count of forty. - - You define a keyboard macro while executing the commands which are the -definition. Put differently, as you define a keyboard macro, the -definition is being executed for the first time. This way, you can see -what the effects of your commands are, so that you don't have to figure -them out in your head. When you are finished, the keyboard macro is -defined and also has been, in effect, executed once. You can then do the -whole thing over again by invoking the macro. - - Keyboard macros differ from ordinary Emacs commands in that they are -written in the Emacs command language rather than in Lisp. This makes it -easier for the novice to write them, and makes them more convenient as -temporary hacks. However, the Emacs command language is not powerful -enough as a programming language to be useful for writing anything -intelligent or general. For such things, Lisp must be used. - -@menu -* Basic Keyboard Macro:: Defining and running keyboard macros. -* Keyboard Macro Ring:: Where previous keyboard macros are saved. -* Keyboard Macro Counter:: Inserting incrementing numbers in macros. -* Keyboard Macro Query:: Making keyboard macros do different things each time. -* Save Keyboard Macro:: Giving keyboard macros names; saving them in files. -* Edit Keyboard Macro:: Editing keyboard macros. -* Keyboard Macro Step-Edit:: Interactively executing and editing a keyboard macro. -@end menu - -@node Basic Keyboard Macro -@section Basic Use - -@table @kbd -@item C-x ( -Start defining a keyboard macro (@code{kmacro-start-macro}). -@item C-x ) -End the definition of a keyboard macro (@code{kmacro-end-macro}). -@item C-x e -Execute the most recent keyboard macro (@code{kmacro-end-and-call-macro}). -First end the definition of the keyboard macro, if currently defining it. -To immediately execute the keyboard macro again, just repeat the @kbd{e}. -@item C-u C-x ( -Re-execute last keyboard macro, then add more keys to its definition. -@item C-u C-u C-x ( -Add more keys to the last keyboard macro without re-executing it. -@item C-x q -When this point is reached during macro execution, ask for confirmation -(@code{kbd-macro-query}). -@item C-x C-k n -Give a command name (for the duration of the session) to the most -recently defined keyboard macro (@code{name-last-kbd-macro}). -@item C-x C-k b -Bind the most recently defined keyboard macro to a key sequence (for -the duration of the session) (@code{kmacro-bind-to-key}). -@item M-x insert-kbd-macro -Insert in the buffer a keyboard macro's definition, as Lisp code. -@item C-x C-k e -Edit a previously defined keyboard macro (@code{edit-kbd-macro}). -@item C-x C-k r -Run the last keyboard macro on each complete line in the region -(@code{apply-macro-to-region-lines}). -@end table - -@kindex C-x ( -@kindex C-x ) -@kindex C-x e -@findex kmacro-start-macro -@findex kmacro-end-macro -@findex kmacro-end-and-call-macro - To start defining a keyboard macro, type the @kbd{C-x (} command -(@code{kmacro-start-macro}). From then on, your keys continue to be -executed, but also become part of the definition of the macro. @samp{Def} -appears in the mode line to remind you of what is going on. When you are -finished, the @kbd{C-x )} command (@code{kmacro-end-macro}) terminates the -definition (without becoming part of it!). For example, - -@example -C-x ( M-f foo C-x ) -@end example - -@noindent -defines a macro to move forward a word and then insert @samp{foo}. - - The macro thus defined can be invoked again with the @kbd{C-x e} -command (@code{kmacro-end-and-call-macro}), which may be given a -repeat count as a numeric argument to execute the macro many times. -If you enter @kbd{C-x e} while defining a macro, the macro is -terminated and executed immediately. - - After executing the macro with @kbd{C-x e}, you can use @kbd{e} -repeatedly to immediately repeat the macro one or more times. For example, - -@example -C-x ( xyz C-x e e e -@end example - -@noindent -inserts @samp{xyzxyzxyzxyz} in the current buffer. - - @kbd{C-x )} can also be given a repeat count as an argument, in -which case it repeats the macro that many times right after defining -it, but defining the macro counts as the first repetition (since it is -executed as you define it). Therefore, giving @kbd{C-x )} an argument -of 4 executes the macro immediately 3 additional times. An argument -of zero to @kbd{C-x e} or @kbd{C-x )} means repeat the macro -indefinitely (until it gets an error or you type @kbd{C-g} or, on -MS-DOS, @kbd{C-@key{BREAK}}). - -@kindex C-x C-k C-s -@kindex C-x C-k C-k -Alternatively, you can use @kbd{C-x C-k C-s} to start a keyboard macro, -and @kbd{C-x C-k C-k...} to end and execute it. - - If you wish to repeat an operation at regularly spaced places in the -text, define a macro and include as part of the macro the commands to move -to the next place you want to use it. For example, if you want to change -each line, you should position point at the start of a line, and define a -macro to change that line and leave point at the start of the next line. -Then repeating the macro will operate on successive lines. - - When a command reads an argument with the minibuffer, your -minibuffer input becomes part of the macro along with the command. So -when you replay the macro, the command gets the same argument as -when you entered the macro. For example, - -@example -C-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 ) -@end example - -@noindent -defines a macro that copies the current line into the buffer -@samp{foo}, then returns to the original buffer. - - You can use function keys in a keyboard macro, just like keyboard -keys. You can even use mouse events, but be careful about that: when -the macro replays the mouse event, it uses the original mouse position -of that event, the position that the mouse had while you were defining -the macro. The effect of this may be hard to predict. (Using the -current mouse position would be even less predictable.) - - One thing that doesn't always work well in a keyboard macro is the -command @kbd{C-M-c} (@code{exit-recursive-edit}). When this command -exits a recursive edit that started within the macro, it works as you'd -expect. But if it exits a recursive edit that started before you -invoked the keyboard macro, it also necessarily exits the keyboard macro -as part of the process. - - After you have terminated the definition of a keyboard macro, you can add -to the end of its definition by typing @kbd{C-u C-x (}. This is equivalent -to plain @kbd{C-x (} followed by retyping the whole definition so far. As -a consequence it re-executes the macro as previously defined. - - You can also add to the end of the definition of the last keyboard -macro without re-execuing it by typing @kbd{C-u C-u C-x (}. - - The variable @code{kmacro-execute-before-append} specifies whether -a single @kbd{C-u} prefix causes the existing macro to be re-executed -before appending to it. - -@findex apply-macro-to-region-lines -@kindex C-x C-k r - The command @kbd{C-x C-k r} (@code{apply-macro-to-region-lines}) -repeats the last defined keyboard macro on each complete line within -the current region. It does this line by line, by moving point to the -beginning of the line and then executing the macro. - -@node Keyboard Macro Ring -@section Where previous keyboard macros are saved - - All defined keyboard macros are recorded in the ``keyboard macro ring'', -a list of sequences of keys. There is only one keyboard macro ring, -shared by all buffers. - - All commands which operates on the keyboard macro ring use the -same @kbd{C-x C-k} prefix. Most of these commands can be executed and -repeated immediately after each other without repeating the @kbd{C-x -C-k} prefix. For example, - -@example -C-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 -@end example - -@noindent -will rotate the keyboard macro ring to the ``second previous'' macro, -execute the resulting head macro three times, rotate back to the -original head macro, execute that once, rotate to the ``previous'' -macro, execute that, and finally delete it from the macro ring. - -@findex kmacro-end-or-call-macro-repeat -@kindex C-x C-k C-k - The command @kbd{C-x C-k C-k} (@code{kmacro-end-or-call-macro-repeat}) -executes the keyboard macro at the head of the macro ring. You can -repeat the macro immediately by typing another @kbd{C-k}, or you can -rotate the macro ring immediately by typing @kbd{C-n} or @kbd{C-p}. - -@findex kmacro-cycle-ring-next -@kindex C-x C-k C-n -@findex kmacro-cycle-ring-previous -@kindex C-x C-k C-p - The commands @kbd{C-x C-k C-n} (@code{kmacro-cycle-ring-next}) and -@kbd{C-x C-k C-p} (@code{kmacro-cycle-ring-previous}) rotates the -macro ring, bringing the next or previous keyboard macro to the head -of the macro ring. The definition of the new head macro is displayed -in the echo area. You can continue to rotate the macro ring -immediately by repeating just @kbd{C-n} and @kbd{C-p} until the -desired macro is at the head of the ring. To execute the new macro -ring head immediately, just type @kbd{C-k}. - -@findex kmacro-view-macro-repeat -@kindex C-x C-k C-v - - The commands @kbd{C-x C-k C-v} (@code{kmacro-view-macro-repeat}) -displays the last keyboard macro, or when repeated (with @kbd{C-v}), -it displays the previous macro on the macro ring, just like @kbd{C-x -C-k C-p}, but without actually rotating the macro ring. If you enter -@kbd{C-k} immediately after displaying a macro from the ring, that -macro is executed, but still without altering the macro ring. - - So while e.g. @kbd{C-x C-k C-p C-p C-k C-k} makes the 3rd previous -macro the current macro and executes it twice, @kbd{C-x C-k C-v C-v -C-v C-k C-k} will display and execute the 3rd previous macro once and -then the current macro once. - -@findex kmacro-delete-ring-head -@kindex C-x C-k C-d - - The commands @kbd{C-x C-k C-d} (@code{kmacro-delete-ring-head}) -removes and deletes the macro currently at the head of the macro -ring. You can use this to delete a macro that didn't work as -expected, or which you don't need anymore. - -@findex kmacro-swap-ring -@kindex C-x C-k C-t - - The commands @kbd{C-x C-k C-t} (@code{kmacro-swap-ring}) -interchanges the head of the macro ring with the previous element on -the macro ring. - -@findex kmacro-call-ring-2nd-repeat -@kindex C-x C-k C-l - - The commands @kbd{C-x C-k C-l} (@code{kmacro-call-ring-2nd-repeat}) -executes the previous (rather than the head) element on the macro ring. - -@node Keyboard Macro Counter -@section Inserting incrementing numbers in macros - - Each keyboard macro has an associated counter which is automatically -incremented on every repetition of the keyboard macro. Normally, the -macro counter is initialized to 0 when you start defining the macro, -and incremented by 1 after each insertion of the counter value; -that is, if you insert the macro counter twice while defining the -macro, it will be incremented by 2 time for each repetition of the -macro. - -@findex kmacro-insert-counter -@kindex C-x C-k C-i - The command @kbd{C-x C-k C-i} (@code{kmacro-insert-counter}) inserts -the current value of the keyboard macro counter and increments the -counter by 1. You can use a numeric prefix argument to specify a -different increment. If you specify a @kbd{C-u} prefix, the last -inserted counter value is repeated and the counter is not incremented. -For example, if you enter the following sequence while defining a macro - -@example -C-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 -@end example - -@noindent -the text @samp{0112} is inserted in the buffer, and for the first and -second execution of the macro @samp{3445} and @samp{6778} are -inserted. - -@findex kmacro-set-counter -@kindex C-x C-k C-c - The command @kbd{C-x C-k C-c} (@code{kmacro-set-counter}) prompts -for the initial value of the keyboard macro counter if you use it -before you define a keyboard macro. If you use it while defining a -keyboard macro, you set the macro counter to the same (initial) value -on each repetition of the macro. If you specify a @kbd{C-u} prefix, -the counter is reset to the value it had prior to the current -repetition of the macro (undoing any increments so far in this -repetition). - -@findex kmacro-add-counter -@kindex C-x C-k C-a - The command @kbd{C-x C-k C-a} (@code{kmacro-add-counter}) prompts -for a value to add to the macro counter. - -@findex kmacro-set-format -@kindex C-x C-k C-f - The command @kbd{C-x C-k C-f} (@code{kmacro-set-format}) prompts -for the format to use when inserting the macro counter. The default -format is @samp{%d}. If you set the counter format before you define a -macro, that format is restored before each repetition of the macro. -Consequently, any changes you make to the macro counter format while -defining a macro are only active for the rest of the macro. - -@node Keyboard Macro Query -@section Executing Macros with Variations - -@kindex C-x q -@findex kbd-macro-query - Using @kbd{C-x q} (@code{kbd-macro-query}), you can get an effect -similar to that of @code{query-replace}, where the macro asks you each -time around whether to make a change. While defining the macro, -type @kbd{C-x q} at the point where you want the query to occur. During -macro definition, the @kbd{C-x q} does nothing, but when you run the -macro later, @kbd{C-x q} asks you interactively whether to continue. - - The valid responses when @kbd{C-x q} asks are @key{SPC} (or @kbd{y}), -@key{DEL} (or @kbd{n}), @key{RET} (or @kbd{q}), @kbd{C-l} and @kbd{C-r}. -The answers are the same as in @code{query-replace}, though not all of -the @code{query-replace} options are meaningful. - - These responses include @key{SPC} to continue, and @key{DEL} to skip -the remainder of this repetition of the macro and start right away with -the next repetition. @key{RET} means to skip the remainder of this -repetition and cancel further repetitions. @kbd{C-l} redraws the screen -and asks you again for a character to say what to do. - - @kbd{C-r} enters a recursive editing level, in which you can perform -editing which is not part of the macro. When you exit the recursive -edit using @kbd{C-M-c}, you are asked again how to continue with the -keyboard macro. If you type a @key{SPC} at this time, the rest of the -macro definition is executed. It is up to you to leave point and the -text in a state such that the rest of the macro will do what you -want.@refill - - @kbd{C-u C-x q}, which is @kbd{C-x q} with a numeric argument, -performs a completely different function. It enters a recursive edit -reading input from the keyboard, both when you type it during the -definition of the macro, and when it is executed from the macro. During -definition, the editing you do inside the recursive edit does not become -part of the macro. During macro execution, the recursive edit gives you -a chance to do some particularized editing on each repetition. -@xref{Recursive Edit}. - - Another way to vary the behavior of a keyboard macro is to use a -register as a counter, incrementing it on each repetition of the macro. -@xref{RegNumbers}. - -@node Save Keyboard Macro -@section Naming and Saving Keyboard Macros - -@cindex saving keyboard macros -@findex name-last-kbd-macro -@kindex C-x C-k n - If you wish to save a keyboard macro for later use, you can give it -a name using @kbd{C-x C-k n} (@code{name-last-kbd-macro}). -This reads a name as an argument using the minibuffer and defines that name -to execute the macro. The macro name is a Lisp symbol, and defining it in -this way makes it a valid command name for calling with @kbd{M-x} or for -binding a key to with @code{global-set-key} (@pxref{Keymaps}). If you -specify a name that has a prior definition other than another keyboard -macro, an error message is shown and nothing is changed. - -@cindex binding keyboard macros -@findex kmacro-bind-to-key -@kindex C-x C-k b - Rather than giving a keyboard macro a name, you can bind it to a -key using @kbd{C-x C-k b} (@code{kmacro-bind-to-key}) followed by the -key sequence you want the keyboard macro to be bound to. You can -bind to any key sequence in the global keymap, but since most key -sequences already have other bindings, you should select the key -sequence carefylly. If you try to bind to a key sequence with an -existing binding (in any keymap), you will be asked if you really -want to replace the existing binding of that key. - -To avoid problems caused by overriding existing bindings, the key -sequences @kbd{C-x C-k 0} through @kbd{C-x C-k 9} and @kbd{C-x C-k A} -through @kbd{C-x C-k Z} are reserved for your own keyboard macro -bindings. In fact, to bind to one of these key sequences, you only -need to type the digit or letter rather than the whole key sequences. -For example, - -@example -C-x C-k b 4 -@end example - -@noindent -will bind the last keyboard macro to the key sequence @kbd{C-x C-k 4}. - -@findex insert-kbd-macro - Once a macro has a command name, you can save its definition in a file. -Then it can be used in another editing session. First, visit the file -you want to save the definition in. Then use this command: - -@example -M-x insert-kbd-macro @key{RET} @var{macroname} @key{RET} -@end example - -@noindent -This inserts some Lisp code that, when executed later, will define the -same macro with the same definition it has now. (You need not -understand Lisp code to do this, because @code{insert-kbd-macro} writes -the Lisp code for you.) Then save the file. You can load the file -later with @code{load-file} (@pxref{Lisp Libraries}). If the file you -save in is your init file @file{~/.emacs} (@pxref{Init File}) then the -macro will be defined each time you run Emacs. - - If you give @code{insert-kbd-macro} a numeric argument, it makes -additional Lisp code to record the keys (if any) that you have bound to the -keyboard macro, so that the macro will be reassigned the same keys when you -load the file. - -@node Edit Keyboard Macro -@section Interactively executing and editing a keyboard macro - -@findex kmacro-edit-macro -@kindex C-x C-k C-e -@kindex C-x C-k RET - You can edit the last keyboard macro by typing @kbd{C-x C-k C-e} or -@kbd{C-x C-k RET} (@code{kmacro-edit-macro}). This formats the macro -definition in a buffer and enters a specialized major mode for editing -it. Type @kbd{C-h m} once in that buffer to display details of how to -edit the macro. When you are finished editing, type @kbd{C-c C-c}. - -@findex edit-kbd-macro -@kindex C-x C-k e - You can edit a named keyboard macro or a macro bound to a key by typing -@kbd{C-x C-k e} (@code{edit-kbd-macro}). Follow that with the -keyboard input that you would use to invoke the macro---@kbd{C-x e} or -@kbd{M-x @var{name}} or some other key sequence. - -@findex kmacro-edit-lossage -@kindex C-x C-k l - You can edit the last 100 keystrokes as a macro by typing -@kbd{C-x C-k l} (@code{kmacro-edit-lossage}). - -@node Keyboard Macro Step-Edit -@section Interactively executing and editing a keyboard macro - -@findex kmacro-step-edit-macro -@kindex C-x C-k SPC - You can interactively and stepwise replay and edit the last keyboard -macro one command at a time by typing @kbd{C-x C-k SPC} -(@code{kmacro-step-edit-macro}). Unless you quit the macro using -@kbd{q} or @kbd{C-g}, the edited macro replaces the last macro on the -macro ring. - -This shows the last macro in the minibuffer together with the first -(or next) command to be executed, and prompts you for an action. -You can enter @kbd{?} to get a command summary. - -The following commands are available in the step-edit mode and relate -to the first (or current) command in the keyboard macro: - -@itemize @bullet{} -@item -@kbd{SPC} and @kbd{y} execute the current command, and advance to the -next command in the keyboard macro. -@item -@kbd{n}, @kbd{d}, and @kbd{DEL} skip and delete the current command. -@item -@kbd{f} skips the current command in this execution of the keyboard -macro, but doesn't delete it from the macro. -@item -@kbd{TAB} executes the current command, as well as all similar -commands immediately following the current command; for example, TAB -may be used to insert a sequence of characters (corresponding to a -sequence of @code{self-insert-command} commands). -@item -@kbd{c} continues execution (without further editing) until the end of -the keyboard macro. If execution terminates normally, the edited -macro replaces the original keyboard macro. -@item -@kbd{C-k} skips and deletes the rest of the keyboard macro, -terminates step-editing, and replaces the original keyboard macro -with the edited macro. -@item -@kbd{q} and @kbd{C-g} cancels the step-editing of the keyboard macro; -discarding any changes made to the keyboard macro. -@item -@kbd{i KEY... C-j} reads and executes a series of key sequences (not -including the final @kbd{C-j}), and inserts them before the current -command in the keyboard macro, without advancing over the current -command. -@item -@kbd{I KEY...} reads one key sequence, executes it, and inserts it -before the current command in the keyboard macro, without advancing -over the current command. -@item -@kbd{r KEY... C-j} reads and executes a series of key sequences (not -including the final @kbd{C-j}), and replaces the current command in -the keyboard macro with them, advancing over the inserted key -sequences. -@item -@kbd{R KEY...} reads one key sequence, executes it, and replaces the -current command in the keyboard macro with that key sequence, -advancing over the inserted key sequence. -@item -@kbd{a KEY... C-j} executes the current command, then reads and -executes a series of key sequences (not including the final -@kbd{C-j}), and inserts them after the current command in the keyboard -macro; it then advances over the current command and the inserted key -sequences. -@item -@kbd{A KEY... C-j} executes the rest of the commands in the keyboard -macro, then reads and executes a series of key sequences (not -including the final @kbd{C-j}), and appends them at the end of the -keyboard macro; it then terminates the step-editing and replaces the -original keyboard macro with the edited macro. -@end itemize - -@ignore - arch-tag: c1b0dd3b-3159-4c08-928f-52e763953e9c -@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 @@ -rem Hack to change/add environment variables in the makefiles for the -rem Windows platform. -rem -rem Copyright (c) 2003 Free Software Foundation, Inc. -rem -rem This file is part of GNU Emacs. -rem -rem GNU Emacs is free software; you can redistribute it and/or modify -rem it under the terms of the GNU General Public License as published by -rem the Free Software Foundation; either version 2, or (at your option) -rem any later version. -rem -rem GNU Emacs is distributed in the hope that it will be useful, -rem but WITHOUT ANY WARRANTY; without even the implied warranty of -rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -rem GNU General Public License for more details. -rem -rem You should have received a copy of the GNU General Public License -rem along with GNU Emacs; see the file COPYING. If not, write to -rem the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -rem Boston, MA 02111-1307, USA. -rem -rem -rem Usage: -rem envadd "ENV1=VAL1" "ENV2=VAL2" ... /C -rem -rem The "/C" switch marks the end of environment variables, and the -rem beginning of the command line. -rem -rem By Peter 'Luna' Runestig 2003 - -:Loop -if .%1% == ./C goto EndLoop -rem just to avoid an endless loop: -if .%1% == . goto EndLoop -set %1 -shift -goto Loop -:EndLoop - -rem Eat the "/C" -shift -rem Now, run the command line -%1 %2 %3 %4 %5 %6 %7 %8 %9 - -goto skipArchTag - arch-tag: 148c5181-dbce-43ae-bba6-1cc6e2a9ea75 -: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 @@ -@echo off - -rem Hack to run install-info with multiple info files on the command -rem line on the Windows platform. -rem -rem Copyright (c) 2003 Free Software Foundation, Inc. -rem -rem This file is part of GNU Emacs. -rem -rem GNU Emacs is free software; you can redistribute it and/or modify -rem it under the terms of the GNU General Public License as published by -rem the Free Software Foundation; either version 2, or (at your option) -rem any later version. -rem -rem GNU Emacs is distributed in the hope that it will be useful, -rem but WITHOUT ANY WARRANTY; without even the implied warranty of -rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -rem GNU General Public License for more details. -rem -rem You should have received a copy of the GNU General Public License -rem along with GNU Emacs; see the file COPYING. If not, write to -rem the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -rem Boston, MA 02111-1307, USA. -rem -rem -rem Usage: -rem multi-install-info FILE1 FILE2 ... -rem -rem By Peter 'Luna' Runestig 2003 - -set INSTALL_INFO=install-info -set II_SWITCH=%1=%2 -rem Eat the install-info switch: -shift - -:Loop -shift -if .%1% == . goto EndLoop -%INSTALL_INFO% %II_SWITCH% %1 -goto Loop -:EndLoop - -goto skipArchTag - arch-tag: 4f590862-8ead-497a-a71c-fb4b0e5d50db -: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 @@ +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001 +# Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs; see the file COPYING. If not, write to the +# Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +# Force loading of symbols, enough to give us gdb_valbits etc. +set main + +# Find lwlib source files too. +dir ../lwlib +#dir /gd/gnu/lesstif-0.89.9/lib/Xm + +# Don't enter GDB when user types C-g to quit. +# This has one unfortunate effect: you can't type C-c +# at the GDB to stop Emacs, when using X. +# However, C-z works just as well in that case. +handle 2 noprint pass + +# Don't pass SIGALRM to Emacs. This makes problems when +# debugging. +handle SIGALRM ignore + +# Set up a mask to use. +# This should be EMACS_INT, but in some cases that is a macro. +# long ought to work in all cases right now. +set $valmask = ((long)1 << gdb_valbits) - 1 +set $nonvalbits = gdb_emacs_intbits - gdb_valbits + +# Set up something to print out s-expressions. +define pr +set debug_print ($) +end +document pr +Print the emacs s-expression which is $. +Works only when an inferior emacs is executing. +end + +define xtype +output (enum Lisp_Type) (($.i >> gdb_valbits) & 0x7) +echo \n +output ((($.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) +echo \n +end +document xtype +Print the type of $, assuming it is an Emacs Lisp value. +If the first type printed is Lisp_Vector or Lisp_Misc, +the second line gives the more precise type. +Otherwise the second line doesn't mean anything. +end + +define xvectype + set $size = ((struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits))->size + output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) + echo \n +end +document xvectype + Print the vector subtype of $, assuming it is a vector or pseudovector. +end + +define xmisctype + output (enum Lisp_Misc_Type) (((struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits))->type) + echo \n +end +document xmisctype + Print the specific type of $, assuming it is some misc type. +end + +define xint + print (($.i & $valmask) << $nonvalbits) >> $nonvalbits +end +document xint + Print $, assuming it is an Emacs Lisp integer. This gets the sign right. +end + +define xptr + print (void *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xptr + Print the pointer portion of $, assuming it is an Emacs Lisp value. +end + +define xmarker + print (struct Lisp_Marker *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xmarker + Print $ as a marker pointer, assuming it is an Emacs Lisp marker value. +end + +define xoverlay + print (struct Lisp_Overlay *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xoverlay + Print $ as a overlay pointer, assuming it is an Emacs Lisp overlay value. +end + +define xmiscfree + print (struct Lisp_Free *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xmiscfree + Print $ as a misc free-cell pointer, assuming it is an Emacs Lisp Misc value. +end + +define xintfwd + print (struct Lisp_Intfwd *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xintfwd + Print $ as an integer forwarding pointer, assuming it is an Emacs Lisp Misc value. +end + +define xboolfwd + print (struct Lisp_Boolfwd *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xboolfwd + Print $ as a boolean forwarding pointer, assuming it is an Emacs Lisp Misc value. +end + +define xobjfwd + print (struct Lisp_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xobjfwd + Print $ as an object forwarding pointer, assuming it is an Emacs Lisp Misc value. +end + +define xbufobjfwd + print (struct Lisp_Buffer_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xbufobjfwd + Print $ as a buffer-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. +end + +define xkbobjfwd + print (struct Lisp_Kboard_Objfwd *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xkbobjfwd + Print $ as a kboard-local object forwarding pointer, assuming it is an Emacs Lisp Misc value. +end + +define xbuflocal + print (struct Lisp_Buffer_Local_Value *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xbuflocal + Print $ as a buffer-local-value pointer, assuming it is an Emacs Lisp Misc value. +end + +define xsymbol + print (struct Lisp_Symbol *) (($.i & $valmask) | gdb_data_seg_bits) + xprintsymptr $ +end +document xsymbol + Print the name and address of the symbol $. + This command assumes that $ is an Emacs Lisp symbol value. +end + +define xstring + print (struct Lisp_String *) (($.i & $valmask) | gdb_data_seg_bits) + output ($->size > 1000) ? 0 : ($->data[0])@($->size_byte < 0 ? $->size : $->size_byte) + echo \n +end +document xstring + Print the contents and address of the string $. + This command assumes that $ is an Emacs Lisp string value. +end + +define xvector + print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) + output ($->size > 50) ? 0 : ($->contents[0])@($->size) + echo \n +end +document xvector + Print the contents and address of the vector $. + This command assumes that $ is an Emacs Lisp vector value. +end + +define xprocess + print (struct Lisp_Process *) (($.i & $valmask) | gdb_data_seg_bits) + output *$ + echo \n +end +document xprocess + Print the address of the struct Lisp_process which the Lisp_Object $ points to. +end + +define xframe + print (struct frame *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xframe + Print $ as a frame pointer, assuming it is an Emacs Lisp frame value. +end + +define xcompiled + print (struct Lisp_Vector *) (($.i & $valmask) | gdb_data_seg_bits) + output ($->contents[0])@($->size & 0xff) +end +document xcompiled + Print $ as a compiled function pointer, assuming it is an Emacs Lisp compiled value. +end + +define xwindow + print (struct window *) (($.i & $valmask) | gdb_data_seg_bits) + printf "%dx%d+%d+%d\n", $->width, $->height, $->left, $->top +end +document xwindow + Print $ as a window pointer, assuming it is an Emacs Lisp window value. + Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". +end + +define xwinconfig + print (struct save_window_data *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xwinconfig + Print $ as a window configuration pointer, assuming it is an Emacs Lisp window configuration value. +end + +define xsubr + print (struct Lisp_Subr *) (($.i & $valmask) | gdb_data_seg_bits) + output *$ + echo \n +end +document xsubr + Print the address of the subr which the Lisp_Object $ points to. +end + +define xchartable + print (struct Lisp_Char_Table *) (($.i & $valmask) | gdb_data_seg_bits) + printf "Purpose: " + output (char*)&((struct Lisp_Symbol *) (($->purpose.i & $valmask) | gdb_data_seg_bits))->name->data + printf " %d extra slots", ($->size & 0x1ff) - 388 + echo \n +end +document xchartable + Print the address of the char-table $, and its purpose. + This command assumes that $ is an Emacs Lisp char-table value. +end + +define xboolvector + print (struct Lisp_Bool_Vector *) (($.i & $valmask) | gdb_data_seg_bits) + output ($->size > 256) ? 0 : ($->data[0])@(($->size + 7)/ 8) + echo \n +end +document xboolvector + Print the contents and address of the bool-vector $. + This command assumes that $ is an Emacs Lisp bool-vector value. +end + +define xbuffer + print (struct buffer *) (($.i & $valmask) | gdb_data_seg_bits) + output ((struct Lisp_String *) (($->name.i & $valmask) | gdb_data_seg_bits))->data + echo \n +end +document xbuffer + Set $ as a buffer pointer, assuming it is an Emacs Lisp buffer value. + Print the name of the buffer. +end + +define xhashtable + print (struct Lisp_Hash_Table *) (($.i & $valmask) | gdb_data_seg_bits) +end +document xhashtable + Set $ as a hash table pointer, assuming it is an Emacs Lisp hash table value. +end + +define xcons + print (struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits) + output/x *$ + echo \n +end +document xcons + Print the contents of $, assuming it is an Emacs Lisp cons. +end + +define nextcons + p $.cdr + xcons +end +document nextcons + Print the contents of the next cell in a list. + This assumes that the last thing you printed was a cons cell contents + (type struct Lisp_Cons) or a pointer to one. +end + +define xcar + print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->car : 0) +end +document xcar + Print the car of $, assuming it is an Emacs Lisp pair. +end + +define xcdr + print/x ((($.i >> gdb_valbits) & 0xf) == Lisp_Cons ? ((struct Lisp_Cons *) (($.i & $valmask) | gdb_data_seg_bits))->cdr : 0) +end +document xcdr + Print the cdr of $, assuming it is an Emacs Lisp pair. +end + +define xfloat + print ((struct Lisp_Float *) (($.i & $valmask) | gdb_data_seg_bits))->data +end +document xfloat + Print $ assuming it is a lisp floating-point number. +end + +define xscrollbar + print (struct scrollbar *) (($.i & $valmask) | gdb_data_seg_bits) + output *$ + echo \n +end +document xscrollbar + Print $ as a scrollbar pointer. +end + +define xprintsym + set $sym = ((struct Lisp_Symbol *) (($arg0.i & $valmask) | gdb_data_seg_bits)) + xprintsymptr $sym +end +document xprintsym + Print argument as a symbol. +end +define xprintsymptr + set $sym = $arg0 + set $sym_name = ((struct Lisp_String *)(($sym->xname.i & $valmask) | gdb_data_seg_bits)) + output ($sym_name->data[0])@($sym_name->size_byte < 0 ? $sym_name->size : $sym_name->size_byte) + echo \n +end + +define xbacktrace + set $bt = backtrace_list + while $bt + set $type = (enum Lisp_Type) (((*$bt->function).i >> gdb_valbits) & 0x7) + if $type == Lisp_Symbol + xprintsym (*$bt->function) + else + printf "0x%x ", (*$bt->function).i + if $type == Lisp_Vectorlike + set $size = ((struct Lisp_Vector *) (((*$bt->function).i & $valmask) | gdb_data_seg_bits))->size + output (enum pvec_type) (($size & PVEC_FLAG) ? $size & PVEC_TYPE_MASK : 0) + else + printf "Lisp type %d", $type + end + echo \n + end + set $bt = $bt->next + end +end +document xbacktrace + Print a backtrace of Lisp function calls from backtrace_list. + Set a breakpoint at Fsignal and call this to see from where + an error was signaled. +end + +define xreload + set $valmask = ((long)1 << gdb_valbits) - 1 + set $nonvalbits = gdb_emacs_intbits - gdb_valbits +end +document xreload + When starting Emacs a second time in the same gdb session under + FreeBSD 2.2.5, gdb 4.13, $valmask and $nonvalbits have lost + their values. (The same happens on current (2000) versions of GNU/Linux + with gdb 5.0.) + This function reloads them. +end + +define hook-run + xreload +end + +# Call xreload if a new Emacs executable is loaded. +define hookpost-run + xreload +end + +set print pretty on +set print sevenbit-strings + +# show environment DISPLAY +# show environment TERM +# set args -geometry 80x40+0+0 + +# Don't let abort actually run, as it will make +# stdio stop working and therefore the `pr' command above as well. +# break abort + +# If we are running in synchronous mode, we want a chance to look around +# before Emacs exits. Perhaps we should put the break somewhere else +# instead... +# 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 /* lastfile must follow all files whose initialized data areas should be dumped as pure by dump-emacs. */ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ + bidi.o \ charset.o coding.o category.o ccl.o character.o chartab.o \ cm.o term.o xfaces.o $(XOBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ @@ -1047,6 +1048,7 @@ alloca.o : alloca.s $(config_h) abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \ $(config_h) +bidi.o: bidi.c buffer.h character.h buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h character.h \ $(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 @@ +/* `alloca' standard 4.2 subroutine for 68000's and 16000's and others. + Also has _setjmp and _longjmp for pyramids. + Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 2, or (at your option) any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/* Both 68000 systems I have run this on have had broken versions of alloca. + Also, I am told that non-berkeley systems do not have it at all. + So replace whatever system-provided alloca there may be + on all 68000 systems. */ + +#define NOT_C_CODE +#ifdef emacs +#include +#else +#include "config.h" +#endif + +#ifndef HAVE_ALLOCA /* define this to use system's alloca */ + +#ifndef hp9000s300 +#ifndef m68k +#ifndef m68000 +#ifndef WICAT +#ifndef ns32000 +#ifndef ns16000 +#ifndef sequent +#ifndef pyramid +#ifndef ATT3B5 +#ifndef XENIX +you +lose!! +#endif /* XENIX */ +#endif /* ATT3B5 */ +#endif /* pyramid */ +#endif /* sequent */ +#endif /* ns16000 */ +#endif /* ns32000 */ +#endif /* WICAT */ +#endif /* m68000 */ +#endif /* m68k */ +#endif /* hp9000s300 */ + + +#ifdef hp9000s300 +#ifdef OLD_HP_ASSEMBLER + data + text + globl _alloca +_alloca + move.l (sp)+,a0 ; pop return addr from top of stack + move.l (sp)+,d0 ; pop size in bytes from top of stack + add.l #ROUND,d0 ; round size up to long word + and.l #MASK,d0 ; mask out lower two bits of size + sub.l d0,sp ; allocate by moving stack pointer + tst.b PROBE(sp) ; stack probe to allocate pages + move.l sp,d0 ; return pointer + add.l #-4,sp ; new top of stack + jmp (a0) ; not a normal return +MASK equ -4 ; Longword alignment +ROUND equ 3 ; ditto +PROBE equ -128 ; safety buffer for C compiler scratch + data +#else /* new hp assembler syntax */ +/* + The new compiler does "move.m (%sp)" to save registers, + so we must copy the saved registers when we mung the sp. + The old compiler did "move.m (%a6)", which + gave us no trouble + */ + text + set PROBE,-128 # safety for C frame temporaries + set MAXREG,22 # d2-d7, a2-a5, fp2-fp7 may have been saved + global _alloca +_alloca: + mov.l (%sp)+,%a0 # return address + mov.l (%sp)+,%d0 # number of bytes to allocate + mov.l %sp,%a1 # save old sp for register copy + mov.l %sp,%d1 # compute new sp + sub.l %d0,%d1 # space requested + and.l &-4,%d1 # round down to longword + sub.l &MAXREG*4,%d1 # space for saving registers + mov.l %d1,%sp # save new value of sp + tst.b PROBE(%sp) # create pages (sigh) + mov.l %a2,%d1 # save reg a2 + mov.l %sp,%a2 + move.w &MAXREG-1,%d0 +copy_regs_loop: /* save caller's saved registers */ + mov.l (%a1)+,(%a2)+ + dbra %d0,copy_regs_loop + mov.l %a2,%d0 # return value + mov.l %d1,%a2 # restore a2 + add.l &-4,%sp # adjust tos + jmp (%a0) # rts +#endif /* new hp assembler */ +#else +#ifdef m68k /* SGS assembler totally different */ + file "alloca.s" + global alloca +alloca: +#ifdef MOTOROLA_DELTA +/* slightly modified version of alloca to motorola sysV/68 pcc - based + compiler. + this compiler saves used registers relative to %sp instead of %fp. + alright, just make new copy of saved register set whenever we allocate + new space from stack.. + this is true at last until SVR3V7 . bug has reported to Motorola. */ + set MAXREG,10 # max no of registers to save (d2-d7, a2-a5) + mov.l (%sp)+,%a1 # pop return addr from top of stack + mov.l (%sp)+,%d0 # pop size in bytes from top of stack + mov.l %sp,%a0 # save stack pointer for register copy + addq.l &3,%d0 # round size up to long word + andi.l &-4,%d0 # mask out lower two bits of size + mov.l %sp,%d1 # compute new value of sp to d1 + sub.l %d0,%d1 # pseudo-allocate by moving stack pointer + sub.l &MAXREG*4,%d1 # allocate more space for saved regs. + mov.l %d1,%sp # actual allocation. + move.w &MAXREG-1,%d0 # d0 counts saved regs. + mov.l %a2,%d1 # preserve a2. + mov.l %sp,%a2 # make pointer to new reg save area. +copy_regs_loop: # copy stuff from old save area. + mov.l (%a0)+,(%a2)+ # save saved register + dbra %d0,copy_regs_loop + mov.l %a2,%a0 # now a2 is start of allocated space. + mov.l %a2,%d0 # return it in both a0 and d0 to play safe. + mov.l %d1,%a2 # restore a2. + subq.l &4,%sp # new top of stack + jmp (%a1) # far below normal return +#else /* not MOTOROLA_DELTA */ + mov.l (%sp)+,%a1 # pop return addr from top of stack + mov.l (%sp)+,%d0 # pop size in bytes from top of stack + add.l &R%1,%d0 # round size up to long word + and.l &-4,%d0 # mask out lower two bits of size + sub.l %d0,%sp # allocate by moving stack pointer + tst.b P%1(%sp) # stack probe to allocate pages + mov.l %sp,%a0 # return pointer as pointer + mov.l %sp,%d0 # return pointer as int to avoid disaster + add.l &-4,%sp # new top of stack + jmp (%a1) # not a normal return + set S%1,64 # safety factor for C compiler scratch + set R%1,3+S%1 # add to size for rounding + set P%1,-132 # probe this far below current top of stack +#endif /* not MOTOROLA_DELTA */ + +#else /* not m68k */ + +#ifdef m68000 + +#ifdef WICAT +/* + * Registers are saved after the corresponding link so we have to explicitly + * move them to the top of the stack where they are expected to be. + * Since we do not know how many registers were saved in the calling function + * we must assume the maximum possible (d2-d7,a2-a5). Hence, we end up + * wasting some space on the stack. + * + * The large probe (tst.b) attempts to make up for the fact that we have + * potentially used up the space that the caller probed for its own needs. + */ + .procss m0 + .config "68000 1" + .module _alloca +MAXREG: .const 10 + .sect text + .global _alloca +_alloca: + move.l (sp)+,a1 ; pop return address + move.l (sp)+,d0 ; pop allocation size + move.l sp,d1 ; get current SP value + sub.l d0,d1 ; adjust to reflect required size... + sub.l #MAXREG*4,d1 ; ...and space needed for registers + and.l #-4,d1 ; backup to longword boundary + move.l sp,a0 ; save old SP value for register copy + move.l d1,sp ; set the new SP value + tst.b -4096(sp) ; grab an extra page (to cover caller) + move.l a2,d1 ; save callers register + move.l sp,a2 + move.w #MAXREG-1,d0 ; # of longwords to copy +loop: move.l (a0)+,(a2)+ ; copy registers... + dbra d0,loop ; ...til there are no more + move.l a2,d0 ; end of register area is addr for new space + move.l d1,a2 ; restore saved a2. + addq.l #4,sp ; caller will increment sp by 4 after return. + move.l d0,a0 ; return value in both a0 and d0. + jmp (a1) + .end _alloca +#else + +/* Some systems want the _, some do not. Win with both kinds. */ +.globl _alloca +_alloca: +.globl alloca +alloca: + movl sp@+,a0 + movl a7,d0 + subl sp@,d0 + andl #~3,d0 + movl d0,sp + tstb sp@(0) /* Make stack pages exist */ + /* Needed on certain systems + that lack true demand paging */ + addql #4,d0 + jmp a0@ + +#endif /* not WICAT */ +#endif /* m68000 */ +#endif /* not m68k */ +#endif /* not hp9000s300 */ + +#if defined (ns16000) || defined (ns32000) + + .text + .align 2 +/* Some systems want the _, some do not. Win with both kinds. */ +.globl _alloca +_alloca: +.globl alloca +alloca: + +/* Two different assembler syntaxes are used for the same code + on different systems. */ + +#ifdef sequent +#define IM +#define REGISTER(x) x +#else +#ifdef NS5 /* ns SysV assembler */ +#define IM $ +#define REGISTER(x) x +#else +#define IM $ +#define REGISTER(x) 0(x) +#endif +#endif + +/* + * The ns16000 is a little more difficult, need to copy regs. + * Also the code assumes direct linkage call sequence (no mod table crap). + * We have to copy registers, and therefore waste 32 bytes. + * + * Stack layout: + * new sp -> junk + * registers (copy) + * r0 -> new data + * | (orig retval) + * | (orig arg) + * old sp -> regs (orig) + * local data + * fp -> old fp + */ + + movd tos,r1 /* pop return addr */ + negd tos,r0 /* pop amount to allocate */ + sprd sp,r2 + addd r2,r0 + bicb IM/**/3,r0 /* 4-byte align */ + lprd sp,r0 + adjspb IM/**/36 /* space for regs, +4 for caller to pop */ + movmd 0(r2),4(sp),IM/**/4 /* copy regs */ + movmd 0x10(r2),0x14(sp),IM/**/4 + jump REGISTER(r1) /* funky return */ +#endif /* ns16000 or ns32000 */ + +#ifdef pyramid + +.globl _alloca + +_alloca: addw $3,pr0 # add 3 (dec) to first argument + bicw $3,pr0 # then clear its last 2 bits + subw pr0,sp # subtract from SP the val in PR0 + andw $-32,sp # keep sp aligned on multiple of 32. + movw sp,pr0 # ret. current SP + ret + +#ifdef PYRAMID_OLD /* This isn't needed in system version 4. */ +.globl __longjmp +.globl _longjmp +.globl __setjmp +.globl _setjmp + +__longjmp: jump _longjmp +__setjmp: jump _setjmp +#endif + +#endif /* pyramid */ + +#ifdef ATT3B5 + + .align 4 + .globl alloca + +alloca: + movw %ap, %r8 + subw2 $9*4, %r8 + movw 0(%r8), %r1 /* pc */ + movw 4(%r8), %fp + movw 8(%r8), %sp + addw2 %r0, %sp /* make room */ + movw %sp, %r0 /* return value */ + jmp (%r1) /* continue... */ + +#endif /* ATT3B5 */ + +#ifdef XENIX + +.386 + +_TEXT segment dword use32 public 'CODE' +assume cs:_TEXT + +;------------------------------------------------------------------------- + +public _alloca +_alloca proc near + + pop ecx ; return address + pop eax ; amount to alloc + add eax,3 ; round it to 32-bit boundary + and al,11111100B ; + mov edx,esp ; current sp in edx + sub edx,eax ; lower the stack + xchg esp,edx ; start of allocation in esp, old sp in edx + mov eax,esp ; return ptr to base in eax + push [edx+8] ; save poss. stored reg. values (esi,edi,ebx) + push [edx+4] ; on lowered stack + push [edx] ; + sub esp,4 ; allow for 'add esp, 4' + jmp ecx ; jump to return address + +_alloca endp + +_TEXT ends + +end + +#endif /* XENIX */ + +#endif /* not HAVE_ALLOCA */ -- 2.39.5