From cc060e3b56a39e903ffa44d989eed94f667cc22b Mon Sep 17 00:00:00 2001 From: vdhoeven Date: Thu, 15 Jul 2010 13:09:52 +0000 Subject: [PATCH] Nicer menu with debugging options git-svn-id: svn://svn.savannah.gnu.org/texmacs/trunk@2999 64cb5145-927a-446d-8aed-2fb7b4773692 --- src/TeXmacs/progs/init-texmacs.scm | 4 ++ src/TeXmacs/progs/kernel/texmacs/tm-modes.scm | 1 + src/TeXmacs/progs/texmacs/menus/debug-menu.scm | 78 ++++++++++++++++++++++ src/TeXmacs/progs/texmacs/menus/main-menu.scm | 28 ++++---- .../progs/texmacs/menus/preferences-menu.scm | 15 +++-- src/TeXmacs/progs/texmacs/menus/tools-menu.scm | 33 ++------- src/TeXmacs/progs/texmacs/texmacs/tm-server.scm | 5 +- src/src/Guile/Glue/build-glue-basic.scm | 2 + src/src/Guile/Glue/glue_basic.cpp | 30 +++++++++ src/src/Kernel/Abstractions/basic.cpp | 39 ++++++++++- src/src/Kernel/Abstractions/basic.hpp | 3 + 11 files changed, 186 insertions(+), 52 deletions(-) create mode 100644 src/TeXmacs/progs/texmacs/menus/debug-menu.scm diff --git a/src/TeXmacs/progs/init-texmacs.scm b/src/TeXmacs/progs/init-texmacs.scm index ef1195d9..1f1474f2 100644 --- a/src/TeXmacs/progs/init-texmacs.scm +++ b/src/TeXmacs/progs/init-texmacs.scm @@ -193,6 +193,10 @@ (lazy-keyboard (version version-kbd) with-versioning-tool?) ;(display* "time: " (- (texmacs-time) boot-start) "\n") +;(display "Booting debugging facilities\n") +(lazy-menu (texmacs menus debug-menu) debug-menu) +;(display* "time: " (- (texmacs-time) boot-start) "\n") + ;(display "Booting plugins\n") (for-each lazy-plugin-initialize (plugin-list)) ;(display* "time: " (- (texmacs-time) boot-start) "\n") diff --git a/src/TeXmacs/progs/kernel/texmacs/tm-modes.scm b/src/TeXmacs/progs/kernel/texmacs/tm-modes.scm index fe021f81..19fbbb52 100644 --- a/src/TeXmacs/progs/kernel/texmacs/tm-modes.scm +++ b/src/TeXmacs/progs/kernel/texmacs/tm-modes.scm @@ -166,6 +166,7 @@ (like-macos% (== (get-preference "look and feel") "macos")) (simple-menus% (== (get-preference "detailed menus") "simple")) (detailed-menus% (== (get-preference "detailed menus") "detailed")) + (with-debugging-tool% (== (get-preference "debugging tool") "on")) (with-linking-tool% (== (get-preference "linking tool") "on")) (with-versioning-tool% (== (get-preference "versioning tool") "on")) (with-remote-connections% (== (get-preference "remote connections") "on")) diff --git a/src/TeXmacs/progs/texmacs/menus/debug-menu.scm b/src/TeXmacs/progs/texmacs/menus/debug-menu.scm new file mode 100644 index 00000000..e6725587 --- /dev/null +++ b/src/TeXmacs/progs/texmacs/menus/debug-menu.scm @@ -0,0 +1,78 @@ + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; MODULE : debug-menu.scm +;; DESCRIPTION : the debug menu +;; COPYRIGHT : (C) 1999 Joris van der Hoeven +;; +;; This software falls under the GNU general public license version 3 or later. +;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE +;; in the root directory or . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(texmacs-module (texmacs menus debug-menu)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Memory +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (show-memory-information s) + (string-append s "#[" (number->string (texmacs-memory)) "#bytes]")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Guile +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (debug-backtrace-errors?) (in? 'backtrace (debug-options))) +(tm-define (debug-toggle-backtrace-errors) + (:synopsis "Toggle scheme backtracing of errors.") + (:check-mark "v" debug-backtrace-errors?) + (if (debug-backtrace-errors?) + (debug-disable 'backtrace 'debug) + (debug-enable 'backtrace 'debug))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General debugging options +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(tm-define (debug-toggle s) + (:check-mark "v" debug-get) + (debug-set s (not (debug-get s)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Memory +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(menu-bind debug-menu + (-> "Guile" + ("Backtrace errors" (debug-toggle-backtrace-errors))) + (-> "Status" + ("Tree" (show-tree)) + ("Path" (show-path)) + ("Cursors" (show-cursor)) + ("Selection" (show-selection)) + ("Environment" (show-env)) + ("History" (show-history)) + ("Memory usage" (show-meminfo))) + (-> "Timings" + ("All" (bench-print-all))) + (-> "Memory" + ("Memory usage" (show-meminfo)) + ("Collect garbage" (gc)) + --- + (group "Permanent") + ("Show memory usage" (set! footer-hook show-memory-information)) + ("Garbage collection" (delayed (:idle 1000) (gc)))) + (-> "Miscellaneous" + ("Provoke error" (oops)) + ("Test routine" (edit-test))) + --- + ("auto" (debug-toggle "auto")) + ("verbose" (debug-toggle "verbose")) + ("events" (debug-toggle "events")) + ("std" (debug-toggle "std")) + ("io" (debug-toggle "io")) + ("bench" (debug-toggle "bench")) + ("history" (debug-toggle "history")) + ("qt" (debug-toggle "qt"))) diff --git a/src/TeXmacs/progs/texmacs/menus/main-menu.scm b/src/TeXmacs/progs/texmacs/menus/main-menu.scm index a6dd0368..a11c23cb 100644 --- a/src/TeXmacs/progs/texmacs/menus/main-menu.scm +++ b/src/TeXmacs/progs/texmacs/menus/main-menu.scm @@ -42,6 +42,8 @@ (if (in-session?) (=> "Session" (link session-menu))) (if (in-graphics?) (=> "Graphics" (link graphics-menu))) (if (in-table?) (link vertical-table-cell-menu)) + (if (with-linking-tool?) + (=> "Link" (link link-menu))) (link texmacs-extra-menu) (if (not (in-graphics?)) (=> "Format" (link format-menu))) (=> "Document" (link document-menu)) @@ -49,17 +51,20 @@ (== (get-init-tree "sectional-short-style") (tree 'macro "false"))) (=> "Part" (link document-part-menu))) (if (project-attached?) (=> "Project" (link project-menu))) - (if (with-remote-connections?) - (=> "Remote" (link remote-menu))) - (if (with-linking-tool?) - (=> "Link" (link link-menu))) - (if (with-versioning-tool?) - (=> "Version" (link version-menu))) (=> "View" (link view-menu)) (=> "Go" (link go-menu)) (if (detailed-menus?) (=> "Tools" (link tools-menu))) + (if (with-versioning-tool?) + (=> "Version" (link version-menu))) + (if (with-remote-connections?) + (=> "Remote" (link remote-menu))) + (if (with-debugging-tool?) + (=> "Debug" (link debug-menu))) + (if (nnull? (test-menu)) + (=> "Test" (link test-menu))) (=> "Help" (link help-menu))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The TeXmacs popup menu ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -74,20 +79,19 @@ (if (in-graphics?) (-> "Graphics" (link graphics-menu))) (if (in-session?) (-> "Session" (link session-menu))) (if (in-table?) (link horizontal-table-cell-menu)) + (if (with-linking-tool?) (-> "Link" (link link-menu))) (if (not (in-graphics?)) (-> "Format" (link format-menu))) (-> "Document" (link document-menu)) (if (== (get-init-tree "sectional-short-style") (tree 'macro "false")) (-> "Part" (link document-part-menu))) (if (project-attached?) (=> "Project" (link project-menu))) - (if (with-remote-connections?) - (-> "Remote" (link remote-menu))) - (if (with-linking-tool?) - (-> "Link" (link link-menu))) - (if (with-versioning-tool?) - (-> "Version" (link version-menu))) (-> "View" (link view-menu)) (-> "Go" (link go-menu)) (if (detailed-menus?) (-> "Tools" (link tools-menu))) + (if (with-versioning-tool?) (-> "Version" (link version-menu))) + (if (with-remote-connections?) (-> "Remote" (link remote-menu))) + (if (with-debugging-tool?) (=> "Debug" (link debug-menu))) + (if (nnull? (test-menu)) (=> "Test" (link test-menu))) --- (-> "Help" (link help-menu))) diff --git a/src/TeXmacs/progs/texmacs/menus/preferences-menu.scm b/src/TeXmacs/progs/texmacs/menus/preferences-menu.scm index 042bcd6e..99b7443e 100644 --- a/src/TeXmacs/progs/texmacs/menus/preferences-menu.scm +++ b/src/TeXmacs/progs/texmacs/menus/preferences-menu.scm @@ -188,14 +188,15 @@ (enum ("Encoding" "verbatim->texmacs:encoding") ("Iso-8859-1" "iso-8859-1") ("Utf-8" "utf-8")))) - (-> "Utilities" - (-> "Scripts" - ("None" (set-preference "scripting language" "none")) - --- - (link scripts-preferences-menu)) - (toggle ("Remote connections" "remote connections")) + (-> "Scripts" + ("None" (set-preference "scripting language" "none")) + --- + (link scripts-preferences-menu)) + (-> "Tools" + (toggle ("Debugging tool" "debugging tool")) (toggle ("Linking tool" "linking tool")) - (toggle ("Versioning tool" "versioning tool"))) + (toggle ("Versioning tool" "versioning tool")) + (toggle ("Remote connections" "remote connections"))) --- (enum ("Autosave" "autosave") ("5 s" "5") diff --git a/src/TeXmacs/progs/texmacs/menus/tools-menu.scm b/src/TeXmacs/progs/texmacs/menus/tools-menu.scm index 3b20e8e1..ce56510b 100644 --- a/src/TeXmacs/progs/texmacs/menus/tools-menu.scm +++ b/src/TeXmacs/progs/texmacs/menus/tools-menu.scm @@ -49,32 +49,7 @@ (link project-manage-menu)) (-> "Miscellaneous" ("Clear undo history" (clear-undo-history))) - (if (nnull? (test-menu)) - --- - (link test-menu))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Developer features -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (show-memory-information s) - (string-append s "#[" (number->string (texmacs-memory)) "#bytes]")) - -(menu-extend test-menu - (-> "Status" - ("Tree" (show-tree)) - ("Path" (show-path)) - ("Cursors" (show-cursor)) - ("Selection" (show-selection)) - ("Environment" (show-env)) - ("History" (show-history)) - ("Memory usage" (show-meminfo))) - (-> "Debugging" - ("Timings" (bench-print-all)) - ("Backtrace errors" (debug-enable 'backtrace 'debug)) - ("Memory information" (set! footer-hook show-memory-information)) - ("Collect garbage" (gc)) - ("Continuous gc" (delayed (:idle 1000) (gc)))) - (-> "Test" - ("Provoke error" (oops)) - ("Test routine" (edit-test)))) + --- + ("Debugging tool" (toggle-preference "debugging tool")) + ("Linking tool" (toggle-preference "linking tool")) + ("Versioning tool" (toggle-preference "versioning tool"))) diff --git a/src/TeXmacs/progs/texmacs/texmacs/tm-server.scm b/src/TeXmacs/progs/texmacs/texmacs/tm-server.scm index 995e1123..0c97a177 100644 --- a/src/TeXmacs/progs/texmacs/texmacs/tm-server.scm +++ b/src/TeXmacs/progs/texmacs/texmacs/tm-server.scm @@ -61,9 +61,10 @@ ("security" "prompt on scripts" notify-security) ("bibtex command" "bibtex" notify-bibtex-command) ("scripting language" "none" notify-scripting-language) - ("remote connections" "off" noop) + ("debugging tool" "off" noop) ("linking tool" "off" noop) - ("versioning tool" "off" noop)) + ("versioning tool" "off" noop) + ("remote connections" "off" noop)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Properties of some built-in routines diff --git a/src/src/Guile/Glue/build-glue-basic.scm b/src/src/Guile/Glue/build-glue-basic.scm index 32451380..3e738910 100644 --- a/src/src/Guile/Glue/build-glue-basic.scm +++ b/src/src/Guile/Glue/build-glue-basic.scm @@ -57,6 +57,8 @@ (new-author new_author (double)) (set-author set_author (void double)) (get-author get_author (double)) + (debug-set debug_set (void string bool)) + (debug-get debug_get (bool string)) ;; routines for images (image->psdoc image_to_psdoc (string url)) diff --git a/src/src/Guile/Glue/glue_basic.cpp b/src/src/Guile/Glue/glue_basic.cpp index b4e1b513..97cc09a4 100644 --- a/src/src/Guile/Glue/glue_basic.cpp +++ b/src/src/Guile/Glue/glue_basic.cpp @@ -472,6 +472,34 @@ tmg_get_author () { } SCM +tmg_debug_set (SCM arg1, SCM arg2) { + SCM_ASSERT_STRING (arg1, SCM_ARG1, "debug-set"); + SCM_ASSERT_BOOL (arg2, SCM_ARG2, "debug-set"); + + string in1= scm_to_string (arg1); + bool in2= scm_to_bool (arg2); + + // SCM_DEFER_INTS; + debug_set (in1, in2); + // SCM_ALLOW_INTS; + + return SCM_UNSPECIFIED; +} + +SCM +tmg_debug_get (SCM arg1) { + SCM_ASSERT_STRING (arg1, SCM_ARG1, "debug-get"); + + string in1= scm_to_string (arg1); + + // SCM_DEFER_INTS; + bool out= debug_get (in1); + // SCM_ALLOW_INTS; + + return bool_to_scm (out); +} + +SCM tmg_image_2psdoc (SCM arg1) { SCM_ASSERT_URL (arg1, SCM_ARG1, "image->psdoc"); @@ -3896,6 +3924,8 @@ initialize_glue_basic () { scm_new_procedure ("new-author", (FN) tmg_new_author, 0, 0, 0); scm_new_procedure ("set-author", (FN) tmg_set_author, 1, 0, 0); scm_new_procedure ("get-author", (FN) tmg_get_author, 0, 0, 0); + scm_new_procedure ("debug-set", (FN) tmg_debug_set, 2, 0, 0); + scm_new_procedure ("debug-get", (FN) tmg_debug_get, 1, 0, 0); scm_new_procedure ("image->psdoc", (FN) tmg_image_2psdoc, 1, 0, 0); scm_new_procedure ("tree->stree", (FN) tmg_tree_2stree, 1, 0, 0); scm_new_procedure ("stree->tree", (FN) tmg_stree_2tree, 1, 0, 0); diff --git a/src/src/Kernel/Abstractions/basic.cpp b/src/src/Kernel/Abstractions/basic.cpp index 61d8790b..e3a81cc5 100644 --- a/src/src/Kernel/Abstractions/basic.cpp +++ b/src/src/Kernel/Abstractions/basic.cpp @@ -9,8 +9,7 @@ * in the root directory or . ******************************************************************************/ -#include "fast_alloc.hpp" -#include "basic.hpp" +#include "string.hpp" int new_type_identifier () { @@ -42,6 +41,42 @@ debug_on (int status) { debug_status= status; } +static void +debug_set (int which, bool on) { + if (on) debug_status= debug_status | (1 << which); + else debug_status= debug_status & (~(1 << which)); +} + +void +debug_set (string s, bool on) { + if (s == "auto") debug_set (DEBUG_FLAG_AUTO, on); + else if (s == "verbose") debug_set (DEBUG_FLAG_VERBOSE, on); + else if (s == "events") debug_set (DEBUG_FLAG_EVENTS, on); + else if (s == "std") debug_set (DEBUG_FLAG_STD, on); + else if (s == "io") debug_set (DEBUG_FLAG_IO, on); + else if (s == "bench") debug_set (DEBUG_FLAG_BENCH, on); + else if (s == "history") debug_set (DEBUG_FLAG_HISTORY, on); + else if (s == "qt") debug_set (DEBUG_FLAG_QT, on); +} + +static bool +debug_get (int which) { + return (debug_status & (1 << which)) != 0; +} + +bool +debug_get (string s) { + if (s == "auto") return debug_get (DEBUG_FLAG_AUTO); + else if (s == "verbose") return debug_get (DEBUG_FLAG_VERBOSE); + else if (s == "events") return debug_get (DEBUG_FLAG_EVENTS); + else if (s == "std") return debug_get (DEBUG_FLAG_STD); + else if (s == "io") return debug_get (DEBUG_FLAG_IO); + else if (s == "bench") return debug_get (DEBUG_FLAG_BENCH); + else if (s == "history") return debug_get (DEBUG_FLAG_HISTORY); + else if (s == "qt") return debug_get (DEBUG_FLAG_QT); + else return false; +} + static int current_indent= 0; tm_ostream& diff --git a/src/src/Kernel/Abstractions/basic.hpp b/src/src/Kernel/Abstractions/basic.hpp index 8fa9ce90..cb554434 100644 --- a/src/src/Kernel/Abstractions/basic.hpp +++ b/src/src/Kernel/Abstractions/basic.hpp @@ -58,6 +58,9 @@ enum { DEBUG_FLAG_AUTO, DEBUG_FLAG_VERBOSE, DEBUG_FLAG_EVENTS, bool debug (int which, bool write_flag= false); int debug_off (); void debug_on (int status); +class string; +void debug_set (string s, bool flag); +bool debug_get (string s); #define DEBUG_AUTO (debug (DEBUG_FLAG_AUTO)) #define DEBUG_VERBOSE (debug (DEBUG_FLAG_VERBOSE)) #define DEBUG_EVENTS (debug (DEBUG_FLAG_EVENTS)) -- 2.11.4.GIT