diff mbox

[RFC] Guile info/enable/disable command trio support

Message ID m3y4mcicvn.fsf@sspiff.org
State New
Headers show

Commit Message

Doug Evans April 1, 2015, 6:25 a.m. UTC
Hi.

This patch adds support for defining the info/enable/disable
command trio that is common among things like pretty-printers, etc.

In Python we replicate the support for each object kind
(pretty-printer, xmethods, et.al.).
I'd like to collapse all the infrastructure under a common roof.
This patch is an experiment to see how doable that is for Guile.

There is one unsolved problem which is that one pretty-printer
can support many "subprinters", and this infrastructure
doesn't support that.  I'm leaving that to another pass.

There's no docs yet, this is just an initial pass.
I'll write some docs and send in a formal patch soon.

Comments

Andy Wingo April 9, 2015, 9:27 a.m. UTC | #1
Hi Doug!

A bunch of nits, for you to address or not as you choose :)

On Wed 01 Apr 2015 08:25, Doug Evans <xdje42@gmail.com> writes:

> diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
> index 4abf5c5..5975472 100644
> --- a/gdb/guile/guile.c
> +++ b/gdb/guile/guile.c
> @@ -704,6 +705,15 @@ call_initialize_gdb_module (void *data)
>       performed within the desired module.  */
>    scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
>  
> +  /* Now that the (gdb) module is defined we can do the rest of Scheme
> +     initialization.  */
> +  {
> +    SCM finish_init = scm_c_public_lookup (gdbscm_init_module_name,
> +					   finish_init_func_name);
> +
> +    scm_call_0 (scm_variable_ref (finish_init));
> +  }
> +
>  #if HAVE_GUILE_MANUAL_FINALIZATION
>    scm_run_finalizers ();
>  #endif

Here you can use scm_c_public_ref.  "scm_c_public_ref (X, Y)" is the
same as "scm_variable_ref (scm_c_public_lookup (X, Y))".

> diff --git a/gdb/guile/lib/gdb/command-trio.scm b/gdb/guile/lib/gdb/command-trio.scm
> new file mode 100644
> index 0000000..5621121
> --- /dev/null
> +++ b/gdb/guile/lib/gdb/command-trio.scm
> @@ -0,0 +1,230 @@
> +(define-module (gdb command-trio)
> +  #:use-module ((gdb) #:select (throw-user-error
> +				string->argv

Side note: are we using tabs consciously?  If not, the usual thing is to
use spaces, as it makes it easier to copy-paste definitions into a
console without causing tab completion to happen.  If that's a possible
change, it's probably worth adding a .dir-locals.el addition.

> +(define-public (register-guile-command-trio!
> +		cmd-name cmd-class
> +		global-iterator progspace-iterator objfile-iterator
> +		get-name-func get-enabled-func set-enabled-func
> +		info-doc enable-doc disable-doc)

WDYT about changing these the "-func" names to get-name, get-enabled,
and set-enabled! ?  That way their uses are clearer; something like:

  (get-name-func x)

makes me think that the result is a name-func.

I also think that the iterators are not really idiomatic.  As they are,
they should probably be named "for-each/global", "for-each/progspace"
etc because really they do a for-each on the lists; but it would be
better to express them as folds so that you can return a value if
needed.  More comments below.

> +  "Register info/enable/disable commands for CMD-NAME.
> +
> +INFO-DOC, ENABLE-DOC, DISABLE-DOC are the first sentence of the doc string
> +for their commands.
> +
> +Note: CMD-NAME must not be the plural form.  We compute the plural form
> +in verbose output."
> +
> +  (define (do-one doer name-re object arg count)
> +    (if (re-match? name-re (get-name-func object))
> +	(begin
> +	  (doer object arg)
> +	  (set-car! count (+ (car count) 1)))))

Single-arm "if" statements are usually better written with "when" or
"unless", especially if the body has a "begin".  In this case:

  (when (re-match? name-re (get-name-func object))
    (doer object arg)
    (set-car! count (+ (car count) 1)))

Incidentally "doer" is not a great name ;-)  As a generic name "proc" is
better but not by much.

> +  (define (do-locus iterator locus print-title name-re doer arg)
> +    (let ((count (cons 0 0)))
> +      (iterator locus name-re count-matching arg count)
> +      (if (> (car count) 0)
> +	  (begin
> +	    (print-title)
> +	    (set! count (cons 0 0))
> +	    (iterator locus name-re doer arg count)))))

Regarding folds; how about:

  (define (fold-matching-objects fold-objects locus name-re f seed)
    (define (fold-matching object seed)
      (if (re-match? name-re (get-name object))
          (f object seed)
          seed))
    (fold-objects locus fold-matching seed))

  (define (for-each-object fold-objects locus print-title name-re proc arg)
    (match (fold-matching-objects fold-objects locus name-re cons '())
      (() 
       ;; No matching objects found.
       *unspecified*)
      (reversed-objects
       (print-title)
       (for-each (lambda (obj) (proc obj arg))
                 (reverse reversed-objects)))))

> +  (define (print-info object name-re port count)
> +    (do-one (lambda (object port)
> +	      (format port "  ~a" (get-name-func object))
> +	      (if (not (get-enabled-func object))
> +		  (display " [disabled]" port))
> +	      (newline port))
> +	    name-re object port count))

See later use, but this can be simplified to:

  (define (print-info object port)
    (format port "  ~a" (get-name object))
    (unless (get-enabled object)
      (display " [disabled]" port))
    (newline port))

> +
> +  (define (set-enabled! object name-re flag count)
> +    (do-one set-enabled-func name-re object flag count))
> +
> +  (define (count-matching object name-re ignore count)
> +    (do-one (lambda (object arg) #f) name-re object ignore count))
> +
> +  (define (re-match? regexp name)
> +    (if regexp
> +	(regexp-exec regexp name)
> +	#t))
> +
> +  (define (parse-args args)
> +    (let loop ((argv (string->argv args))
> +	       (flags '()))
> +      (cond ((eq? argv '())
> +	     (values flags #f #f))
> +	    ((string=? (string-take (car argv) 1) "-")
> +	     (loop (cdr argv) (cons (car argv) flags)))
> +	    ((> (length argv) 2)
> +	     (throw-user-error "too many args: ~a" args))
> +	    ((= (length argv) 2)
> +	     (values flags (car argv) (cadr argv)))
> +	    (else
> +	     (values flags (car argv) #f)))))

Better to use pattern matching to avoid meaningless cdaddring.  You'd
have to import (ice-9 match).

  (define (parse-args args)
    (define (flag? str)
      (string-prefix? "-" str))
    (let loop ((argv (string->argv args)) (flags '()))
      (match argv
        (() (values flags #f #f))
        (((? flag? flag) . argv)
         (loop argv (cons flag flags)))
        ((locus)
         (values flags locus #f))
        ((locus name)
         (values flags locus name))
        (_ (throw-user-error "too many args: ~a" args)))))
        
> +  (define (print-all-info args)
> +    (define-values (flags locus name) (parse-args args))
> +    (let ((locus-re (and locus (make-regexp locus)))
> +	  (name-re (and name (make-regexp name)))
> +	  (port (current-output-port)))
> +      (if (not (eq? flags '()))
> +	  (throw-user-error "unrecognized flag: ~a" (car flags)))
> +      (if (re-match? locus-re "global")
> +	  (do-locus global-iterator #f
> +		    (lambda () (display "Global:\n"))
> +		    name-re print-info port))

          (for-each-object fold-objects/global #f
                           (lambda () (display "Global:\n"))
                           name-re print-info port)

> +      (if (re-match? locus-re "progspace")
> +	  (do-locus progspace-iterator (current-progspace)
> +		    (lambda ()
> +		      (format port "Progspace ~a:\n"
> +			      (progspace-filename (current-progspace))))
> +		    name-re print-info port))
> +      (for-each (lambda (objfile)
> +		  (if (re-match? locus-re (objfile-filename objfile))
> +		      (do-locus objfile-iterator objfile
> +				(lambda ()
> +				  (format port "Objfile ~a:\n"
> +					  (objfile-filename objfile)))
> +				name-re print-info port)))
> +		(objfiles))
> +      *unspecified*))
> +
> +  (define (count-enabled! object name-re ignore count)
> +    (if (get-enabled-func object)
> +	(set-car! count (+ (car count) 1)))
> +    (set-cdr! count (+ (cdr count) 1)))
> +
> +  (define (count-all-enabled)
> +    (let ((count (cons 0 0)))
> +      (global-iterator #f #f count-enabled! #f count)
> +      (progspace-iterator (current-progspace) #f count-enabled! #f count)
> +      (for-each (lambda (objfile)
> +		  (objfile-iterator objfile #f count-enabled! #f count))
> +		(objfiles))
> +      count))

Really here we want a two-valued fold; oh well.

     (define (count-all-enabled)
       (define (add-count object count)
         (match count
           ((enabled . total)
            (cons (+ enabled (if (get-enabled object) 1 0))
                  (+ total 1)))))
       (define (visit-locus folder locus count)
         (folder locus add-count count))
       (let* ((count (cons 0 0))
              (count (visit-locus fold-objects/global #f count))
              (count (visit-locus fold-objects/progspace (current-progspace) count)))
         ;; SRFI-1 fold has its arguments reversed, oddly.
         (fold (lambda (objfile count)
                 (visit-locus fold-objects/objfile objfile count))
               count
               (objfiles))))

Why are there three iterators?  Is it not sufficient to have the
iterator test whether the argument is #f, a progspace, or an objfile?
If that were the case this could simplify to:

     (define (count-all-enabled)
       (define (add-count object count)
         (match count
           ((enabled . total)
            (cons (+ enabled (if (get-enabled object) 1 0))
                  (+ total 1)))))
       (fold (lambda (locus count)
               (fold-objects locus add-count count))
             (cons 0 0)
             (cons #f (current-progspace) (objfiles))))

> +  (define (pluralize word count)
> +    (if (= count 1)
> +	word
> +	(string-append word "s")))

Hmmmm :)  I guess since the set of names is restricted this is fine.
We might as well use the facilities of "format" though:

  (format #f "Disable filter~p" 3) => "Disable filters"

> +  (define (summarize-enabled port setting orig-count new-count)
> +    (let* ((change (- (car new-count) (car orig-count)))

Using "match" instead of cdaddring allows you to give a name to these
ad-hoc fields.

> diff --git a/gdb/guile/lib/gdb/command/pretty-printer.scm b/gdb/guile/lib/gdb/command/pretty-printer.scm
> new file mode 100644
> index 0000000..dff333c
> --- /dev/null
> +++ b/gdb/guile/lib/gdb/command/pretty-printer.scm
> @@ -0,0 +1,65 @@
> +;; Pretty-printer commands.
> +;;
> +;; Copyright (C) 2015 Free Software Foundation, Inc.
> +;;
> +;; This file is part of GDB.
> +;;
> +;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (gdb command pretty-printer)
> +  #:use-module ((gdb) #:select (COMMAND_DATA
> +				pretty-printers
> +				objfile-pretty-printers
> +				progspace-pretty-printers
> +				pretty-printer-name
> +				pretty-printer-enabled?
> +				set-pretty-printer-enabled!))
> +  #:use-module (gdb command-trio))
> +
> +(define (global-iterator locus name-re doer arg count)
> +  (for-each (lambda (printer)
> +	      (doer printer name-re arg count))
> +	    (pretty-printers))
> +  *unspecified*)
> +
> +(define (progspace-iterator pspace name-re doer arg count)
> +  (for-each (lambda (printer)
> +	      (doer printer name-re arg count))
> +	    (progspace-pretty-printers pspace))
> +  *unspecified*)
> +
> +(define (objfile-iterator objfile name-re doer arg count)
> +  (for-each (lambda (printer)
> +	      (doer printer name-re arg count))
> +	    (objfile-pretty-printers objfile))
> +  *unspecified*)

  (use-modules ((srfi srfi-1) #:select (fold)))

  (define (fold-pretty-printers locus proc seed)
    (match locus
     (#f ; Global.
      (fold proc seed (pretty-printers)))
     ((? progspace?)
      (fold proc seed (progspace-pretty-printers locus)))
     ((? objfile?)
      (fold proc seed (objfile-pretty-printers locus)))))

> +
> +(define (get-name-func printer)
> +  (pretty-printer-name printer))
> +
> +(define (get-enabled-func printer)
> +  (pretty-printer-enabled? printer))
> +
> +(define (set-enabled-func printer flag)
> +  (set-pretty-printer-enabled! printer flag))

I would just pass pretty-printer-name, etc as values to
register-guile-command-trio!.

> +
> +(define-public (%install-pretty-printer-commands!)
> +  (register-guile-command-trio!
> +   "pretty-printer" COMMAND_DATA
> +   global-iterator progspace-iterator objfile-iterator
> +   get-name-func get-enabled-func set-enabled-func
> +   "List all registered Guile pretty-printers."
> +   "Enable the specified Guile pretty-printers."
> +   "Disable the specified Guile pretty-printers.")
> +  *unspecified*)
> diff --git a/gdb/guile/lib/gdb/init-gdb.scm b/gdb/guile/lib/gdb/init-gdb.scm

I only got up to here, but figured this might be useful to you.  Happy
hacking!

Andy
diff mbox

Patch

diff --git a/gdb/data-directory/Makefile.in b/gdb/data-directory/Makefile.in
index c01b86d..c1408fc 100644
--- a/gdb/data-directory/Makefile.in
+++ b/gdb/data-directory/Makefile.in
@@ -86,20 +86,26 @@  GUILE_INSTALL_DIR = $(DESTDIR)$(GDB_DATADIR)/$(GUILE_DIR)
 GUILE_SOURCE_FILES = \
 	./gdb.scm \
 	gdb/boot.scm \
+	gdb/command-trio.scm \
 	gdb/experimental.scm \
+	gdb/init-gdb.scm \
 	gdb/init.scm \
 	gdb/iterator.scm \
 	gdb/printing.scm \
 	gdb/support.scm \
-	gdb/types.scm
+	gdb/types.scm \
+	gdb/command/pretty-printer.scm
 
 GUILE_COMPILED_FILES = \
 	./gdb.go \
+	gdb/command-trio.go \
 	gdb/experimental.go \
+	gdb/init.go \
 	gdb/iterator.go \
 	gdb/printing.go \
 	gdb/support.go \
-	gdb/types.go
+	gdb/types.go \
+	gdb/command/pretty-printer.go
 
 @HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_SOURCE_FILES) $(GUILE_COMPILED_FILES)
 @HAVE_GUILE_FALSE@GUILE_FILES =
diff --git a/gdb/guile/guile-internal.h b/gdb/guile/guile-internal.h
index 509120b..fc2428b 100644
--- a/gdb/guile/guile-internal.h
+++ b/gdb/guile/guile-internal.h
@@ -117,7 +117,6 @@  scm_new_smob (scm_t_bits tc, scm_t_bits data)
 #define FUNC_NAME __func__
 
 extern const char gdbscm_module_name[];
-extern const char gdbscm_init_module_name[];
 
 extern int gdb_scheme_initialized;
 
diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
index 4abf5c5..5975472 100644
--- a/gdb/guile/guile.c
+++ b/gdb/guile/guile.c
@@ -117,10 +117,13 @@  static SCM to_string_keyword;
 
 /* The name of the various modules (without the surrounding parens).  */
 const char gdbscm_module_name[] = "gdb";
-const char gdbscm_init_module_name[] = "gdb";
+static const char gdbscm_init_module_name[] = "gdb init";
 
 /* The name of the bootstrap file.  */
-static const char boot_scm_filename[] = "boot.scm";
+static const char boot_scm_file_name[] = "boot.scm";
+
+/* The name of the function that finished Scheme-side initialization.  */
+static const char finish_init_func_name[] = "%finish-init!";
 
 /* The interface between gdb proper and loading of python scripts.  */
 
@@ -630,7 +633,7 @@  initialize_scheme_side (void)
 
   guile_datadir = concat (gdb_datadir, SLASH_STRING, "guile", NULL);
   boot_scm_path = concat (guile_datadir, SLASH_STRING, "gdb",
-			  SLASH_STRING, boot_scm_filename, NULL);
+			  SLASH_STRING, boot_scm_file_name, NULL);
 
   scm_c_catch (SCM_BOOL_T, boot_guile_support, boot_scm_path,
 	       handle_boot_error, boot_scm_path, NULL, NULL);
@@ -639,7 +642,6 @@  initialize_scheme_side (void)
 }
 
 /* Install the gdb scheme module.
-   The result is a boolean indicating success.
    If initializing the gdb module fails an error message is printed.
    Note: This function runs in the context of the gdb module.  */
 
@@ -693,8 +695,7 @@  initialize_gdb_module (void *data)
   gdb_scheme_initialized = 1;
 }
 
-/* Utility to call scm_c_define_module+initialize_gdb_module from
-   within scm_with_guile.  */
+/* Utility to initialize GDB+Guile from within scm_with_guile.  */
 
 static void *
 call_initialize_gdb_module (void *data)
@@ -704,6 +705,15 @@  call_initialize_gdb_module (void *data)
      performed within the desired module.  */
   scm_c_define_module (gdbscm_module_name, initialize_gdb_module, NULL);
 
+  /* Now that the (gdb) module is defined we can do the rest of Scheme
+     initialization.  */
+  {
+    SCM finish_init = scm_c_public_lookup (gdbscm_init_module_name,
+					   finish_init_func_name);
+
+    scm_call_0 (scm_variable_ref (finish_init));
+  }
+
 #if HAVE_GUILE_MANUAL_FINALIZATION
   scm_run_finalizers ();
 #endif
diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
index 8f238be..ea5fadb 100644
--- a/gdb/guile/lib/gdb.scm
+++ b/gdb/guile/lib/gdb.scm
@@ -316,6 +316,7 @@ 
 
  make-pretty-printer
  pretty-printer?
+ pretty-printer-name
  pretty-printer-enabled?
  set-pretty-printer-enabled!
  make-pretty-printer-worker
@@ -495,7 +496,7 @@ 
 
 ;; Load the rest of the Scheme side.
 
-(include "gdb/init.scm")
+(include "gdb/init-gdb.scm")
 
 ;; These come from other files, but they're really part of this module.
 
diff --git a/gdb/guile/lib/gdb/command-trio.scm b/gdb/guile/lib/gdb/command-trio.scm
new file mode 100644
index 0000000..5621121
--- /dev/null
+++ b/gdb/guile/lib/gdb/command-trio.scm
@@ -0,0 +1,230 @@ 
+;; Utilities for the standard info/enable/disable command trio.
+;;
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;
+;; This file is part of GDB.
+;;
+;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+;; This module exports one function: register-guile-command-trio!
+;; See its doc string for details.
+
+(define-module (gdb command-trio)
+  #:use-module ((gdb) #:select (throw-user-error
+				string->argv
+				current-progspace
+				progspace-filename
+				objfiles
+				objfile-filename
+				make-command
+				register-command!)))
+
+(define-public (register-guile-command-trio!
+		cmd-name cmd-class
+		global-iterator progspace-iterator objfile-iterator
+		get-name-func get-enabled-func set-enabled-func
+		info-doc enable-doc disable-doc)
+  "Register info/enable/disable commands for CMD-NAME.
+
+INFO-DOC, ENABLE-DOC, DISABLE-DOC are the first sentence of the doc string
+for their commands.
+
+Note: CMD-NAME must not be the plural form.  We compute the plural form
+in verbose output."
+
+  (define (do-one doer name-re object arg count)
+    (if (re-match? name-re (get-name-func object))
+	(begin
+	  (doer object arg)
+	  (set-car! count (+ (car count) 1)))))
+
+  (define (do-locus iterator locus print-title name-re doer arg)
+    (let ((count (cons 0 0)))
+      (iterator locus name-re count-matching arg count)
+      (if (> (car count) 0)
+	  (begin
+	    (print-title)
+	    (set! count (cons 0 0))
+	    (iterator locus name-re doer arg count)))))
+
+  (define (print-info object name-re port count)
+    (do-one (lambda (object port)
+	      (format port "  ~a" (get-name-func object))
+	      (if (not (get-enabled-func object))
+		  (display " [disabled]" port))
+	      (newline port))
+	    name-re object port count))
+
+  (define (set-enabled! object name-re flag count)
+    (do-one set-enabled-func name-re object flag count))
+
+  (define (count-matching object name-re ignore count)
+    (do-one (lambda (object arg) #f) name-re object ignore count))
+
+  (define (re-match? regexp name)
+    (if regexp
+	(regexp-exec regexp name)
+	#t))
+
+  (define (parse-args args)
+    (let loop ((argv (string->argv args))
+	       (flags '()))
+      (cond ((eq? argv '())
+	     (values flags #f #f))
+	    ((string=? (string-take (car argv) 1) "-")
+	     (loop (cdr argv) (cons (car argv) flags)))
+	    ((> (length argv) 2)
+	     (throw-user-error "too many args: ~a" args))
+	    ((= (length argv) 2)
+	     (values flags (car argv) (cadr argv)))
+	    (else
+	     (values flags (car argv) #f)))))
+
+  (define (print-all-info args)
+    (define-values (flags locus name) (parse-args args))
+    (let ((locus-re (and locus (make-regexp locus)))
+	  (name-re (and name (make-regexp name)))
+	  (port (current-output-port)))
+      (if (not (eq? flags '()))
+	  (throw-user-error "unrecognized flag: ~a" (car flags)))
+      (if (re-match? locus-re "global")
+	  (do-locus global-iterator #f
+		    (lambda () (display "Global:\n"))
+		    name-re print-info port))
+      (if (re-match? locus-re "progspace")
+	  (do-locus progspace-iterator (current-progspace)
+		    (lambda ()
+		      (format port "Progspace ~a:\n"
+			      (progspace-filename (current-progspace))))
+		    name-re print-info port))
+      (for-each (lambda (objfile)
+		  (if (re-match? locus-re (objfile-filename objfile))
+		      (do-locus objfile-iterator objfile
+				(lambda ()
+				  (format port "Objfile ~a:\n"
+					  (objfile-filename objfile)))
+				name-re print-info port)))
+		(objfiles))
+      *unspecified*))
+
+  (define (count-enabled! object name-re ignore count)
+    (if (get-enabled-func object)
+	(set-car! count (+ (car count) 1)))
+    (set-cdr! count (+ (cdr count) 1)))
+
+  (define (count-all-enabled)
+    (let ((count (cons 0 0)))
+      (global-iterator #f #f count-enabled! #f count)
+      (progspace-iterator (current-progspace) #f count-enabled! #f count)
+      (for-each (lambda (objfile)
+		  (objfile-iterator objfile #f count-enabled! #f count))
+		(objfiles))
+      count))
+
+  (define (pluralize word count)
+    (if (= count 1)
+	word
+	(string-append word "s")))
+
+  (define (summarize-enabled port setting orig-count new-count)
+    (let* ((change (- (car new-count) (car orig-count)))
+	   (abs-change (if setting change (- change))))
+      (format port "~a ~a ~a\n"
+	      abs-change
+	      (pluralize cmd-name abs-change)
+	      (if setting "enabled" "disabled"))
+      (format port "~a of ~a ~a enabled\n"
+	      (car new-count) (cdr new-count)
+	      (pluralize cmd-name (cdr new-count)))))
+
+  (define (set-all-enabled! args setting)
+    (define-values (flags locus name) (parse-args args))
+    (let ((locus-re (and locus (make-regexp locus)))
+	  (name-re (and name (make-regexp name)))
+	  (port (current-output-port))
+	  (verbose #f))
+      (for-each (lambda (flag)
+		  (cond ((string=? flag "-v")
+			 (set! verbose #t))
+			(else
+			 (throw-user-error "unrecognized flag: ~a" flags))))
+		flags)
+      (let ((orig-count (count-all-enabled)))
+	(if (re-match? locus-re "global")
+	    (do-locus global-iterator #f (lambda () #f)
+		      name-re set-enabled! setting))
+	(if (re-match? locus-re "progspace")
+	    (do-locus progspace-iterator (current-progspace) (lambda () #f)
+		      name-re set-enabled! setting))
+	(for-each (lambda (objfile)
+		    (if (re-match? locus-re (objfile-filename objfile))
+			(do-locus objfile-iterator objfile (lambda () #f)
+				  name-re set-enabled! setting)))
+		  (objfiles))
+	(if verbose
+	    (summarize-enabled port setting orig-count (count-all-enabled)))))
+    *unspecified*)
+
+  ;; End of internal utilities.
+
+  (register-command!
+   (make-command (string-append "info guile " cmd-name)
+		 #:command-class cmd-class
+		 #:invoke (lambda (self arg from-tty)
+			    (print-all-info arg))
+		 #:doc (string-append info-doc "
+
+    Usage: info guile " cmd-name " [object-regexp [name-regexp]]
+
+    OBJECT-REGEXP is a regular expression matching the objects to list.
+    Objects are \"global\", \"progspace\", and the objfiles within
+    that program space.
+
+    NAME-REGEXP matches the name of the " cmd-name ".")))
+
+  (register-command!
+   (make-command (string-append "enable guile " cmd-name)
+		 #:command-class cmd-class
+		 #:invoke (lambda (self arg from-tty)
+			    (set-all-enabled! arg #t))
+		 #:doc (string-append enable-doc "
+
+    Usage: enable guile " cmd-name " [-v] [object-regexp [name-regexp]]
+
+    -v: Be verbose.
+
+    OBJECT-REGEXP is a regular expression matching the objects to examine.
+    Objects are \"global\", \"progspace\", and the objfiles within
+    that program space.
+
+    NAME-REGEXP matches the name of the " cmd-name ".")))
+
+  (register-command!
+   (make-command (string-append "disable guile " cmd-name)
+		 #:command-class cmd-class
+		 #:invoke (lambda (self arg from-tty)
+			    (set-all-enabled! arg #f))
+		 #:doc (string-append disable-doc "
+
+    Usage: disable guile " cmd-name " [-v] [object-regexp [name-regexp]]
+
+    -v: Be verbose.
+
+    OBJECT-REGEXP is a regular expression matching the objects to examine.
+    Objects are \"global\", \"progspace\", and the objfiles within
+    that program space.
+
+    NAME-REGEXP matches the name of the " cmd-name ".")))
+
+  *unspecified*)
diff --git a/gdb/guile/lib/gdb/command/pretty-printer.scm b/gdb/guile/lib/gdb/command/pretty-printer.scm
new file mode 100644
index 0000000..dff333c
--- /dev/null
+++ b/gdb/guile/lib/gdb/command/pretty-printer.scm
@@ -0,0 +1,65 @@ 
+;; Pretty-printer commands.
+;;
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+;;
+;; This file is part of GDB.
+;;
+;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+(define-module (gdb command pretty-printer)
+  #:use-module ((gdb) #:select (COMMAND_DATA
+				pretty-printers
+				objfile-pretty-printers
+				progspace-pretty-printers
+				pretty-printer-name
+				pretty-printer-enabled?
+				set-pretty-printer-enabled!))
+  #:use-module (gdb command-trio))
+
+(define (global-iterator locus name-re doer arg count)
+  (for-each (lambda (printer)
+	      (doer printer name-re arg count))
+	    (pretty-printers))
+  *unspecified*)
+
+(define (progspace-iterator pspace name-re doer arg count)
+  (for-each (lambda (printer)
+	      (doer printer name-re arg count))
+	    (progspace-pretty-printers pspace))
+  *unspecified*)
+
+(define (objfile-iterator objfile name-re doer arg count)
+  (for-each (lambda (printer)
+	      (doer printer name-re arg count))
+	    (objfile-pretty-printers objfile))
+  *unspecified*)
+
+(define (get-name-func printer)
+  (pretty-printer-name printer))
+
+(define (get-enabled-func printer)
+  (pretty-printer-enabled? printer))
+
+(define (set-enabled-func printer flag)
+  (set-pretty-printer-enabled! printer flag))
+
+(define-public (%install-pretty-printer-commands!)
+  (register-guile-command-trio!
+   "pretty-printer" COMMAND_DATA
+   global-iterator progspace-iterator objfile-iterator
+   get-name-func get-enabled-func set-enabled-func
+   "List all registered Guile pretty-printers."
+   "Enable the specified Guile pretty-printers."
+   "Disable the specified Guile pretty-printers.")
+  *unspecified*)
diff --git a/gdb/guile/lib/gdb/init-gdb.scm b/gdb/guile/lib/gdb/init-gdb.scm
new file mode 100644
index 0000000..b637bea
--- /dev/null
+++ b/gdb/guile/lib/gdb/init-gdb.scm
@@ -0,0 +1,174 @@ 
+;; Scheme side initialization of the gdb module.
+;;
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+;;
+;; This file is part of GDB.
+;;
+;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+;; This file is included by (gdb).
+;; Note: You can't refer to any gdb modules yet: The gdb module won't be
+;; fully defined until after we're done.
+
+;; The original i/o ports.  In case the user wants them back.
+(define %orig-input-port #f)
+(define %orig-output-port #f)
+(define %orig-error-port #f)
+
+;; Keys for GDB-generated exceptions.
+;; gdb:with-stack is handled separately.
+
+(define %exception-keys '(gdb:error
+			  gdb:invalid-object-error
+			  gdb:memory-error
+			  gdb:pp-type-error
+			  gdb:user-error))
+
+;; Printer for gdb exceptions, used when Scheme tries to print them directly.
+
+(define (%exception-printer port key args default-printer)
+  (apply (case-lambda
+	  ((subr msg args . rest)
+	   (if subr
+	       (format port "In procedure ~a: " subr))
+	   (apply format port msg (or args '())))
+	  (_ (default-printer)))
+	 args))
+
+;; Print the message part of a gdb:with-stack exception.
+;; The arg list is the way it is because it's passed to set-exception-printer!.
+;; We don't print a backtrace here because Guile will have already printed a
+;; backtrace.
+
+(define (%with-stack-exception-printer port key args default-printer)
+  (let ((real-key (car args))
+	(real-args (cddr args)))
+    (%exception-printer port real-key real-args default-printer)))
+
+;; Copy of Guile's print-exception that tweaks the output for our purposes.
+
+(define (%print-exception-message-worker port key args)
+  (define (default-printer)
+    (format port "Throw to key `~a' with args `~s'." key args))
+  (format port "ERROR: ")
+  ;; Pass #t for tag to catch all errors.
+  (catch #t
+	 (lambda ()
+	   (%exception-printer port key args default-printer))
+	 (lambda (k . args)
+	   (format port "Error while printing gdb exception: ~a ~s."
+		   k args)))
+  ;; Don't print a newline for user errors as gdb will print one too, and
+  ;; the blank line is inconsistent with non-Guile-implemented gdb commands.
+  (if (not (eq? key 'gdb:user-error))
+      (newline port))
+  (force-output port))
+
+;; Called from the C code to print an exception.
+;; Guile prints them a little differently than we want.
+;; See boot-9.scm:print-exception.
+
+(define (%print-exception-message port frame key args)
+  (cond ((memq key %exception-keys)
+	 (%print-exception-message-worker port key args))
+	(else
+	 (print-exception port frame key args)))
+  *unspecified*)
+
+;; Called from the C code to print an exception according to the setting
+;; of "guile print-stack".
+;;
+;; If PORT is #f, use the standard error port.
+;; If STACK is #f, never print the stack, regardless of whether printing it
+;; is enabled.  If STACK is #t, then print it if it is contained in ARGS
+;; (i.e., KEY is gdb:with-stack).  Otherwise STACK is the result of calling
+;; scm_make_stack (which will be ignored in favor of the stack in ARGS if
+;; KEY is gdb:with-stack).
+;; KEY, ARGS are the standard arguments to scm_throw, et.al.
+
+(define (%print-exception-with-stack port stack key args)
+  (let ((style (%exception-print-style)))
+    (if (not (eq? style 'none))
+	(let ((error-port (current-error-port))
+	      (frame #f))
+	  (if (not port)
+	      (set! port error-port))
+	  (if (eq? port error-port)
+	      (begin
+		(force-output (current-output-port))
+		;; In case the current output port is not gdb's output port.
+		(force-output (output-port))))
+
+	  ;; If the exception is gdb:with-stack, unwrap it to get the stack and
+	  ;; underlying exception.  If the caller happens to pass in a stack,
+	  ;; we ignore it and use the one in ARGS instead.
+	  (if (eq? key 'gdb:with-stack)
+	      (begin
+		(set! key (car args))
+		(if stack
+		    (set! stack (cadr args)))
+		(set! args (cddr args))))
+
+	  ;; If caller wanted a stack and there isn't one, disable backtracing.
+	  (if (eq? stack #t)
+	      (set! stack #f))
+	  ;; At this point if stack is true, then it is assumed to be a stack.
+	  (if stack
+	      (set! frame (stack-ref stack 0)))
+
+	  (if (and (eq? style 'full) stack)
+	      (begin
+		;; This is derived from libguile/throw.c:handler_message.
+		;; We include "Guile" in "Guile Backtrace" whereas the Guile
+		;; version does not so that tests can know it's us printing
+		;; the backtrace.  Plus it could help beginners.
+		(display "Guile Backtrace:\n" port)
+		(display-backtrace stack port #f #f '())
+		(newline port)))
+
+	  (%print-exception-message port frame key args)))))
+
+;; Internal utility called during startup to initialize the Scheme side of
+;; GDB+Guile.
+
+(define (%initialize!)
+  (for-each (lambda (key)
+	      (set-exception-printer! key %exception-printer))
+	    %exception-keys)
+  (set-exception-printer! 'gdb:with-stack %with-stack-exception-printer)
+
+  (set! %orig-input-port (set-current-input-port (input-port)))
+  (set! %orig-output-port (set-current-output-port (output-port)))
+  (set! %orig-error-port (set-current-error-port (error-port)))
+
+  *unspecified*)
+
+;; Dummy routine to silence "possibly unused local top-level variable"
+;; warnings from the compiler.
+
+(define-public (%silence-compiler-warnings%)
+  (list %print-exception-with-stack %initialize!))
+
+;; Public routines.
+
+(define-public (orig-input-port) %orig-input-port)
+(define-public (orig-output-port) %orig-output-port)
+(define-public (orig-error-port) %orig-error-port)
+
+;; Utility to throw gdb:user-error for use in writing gdb commands.
+;; The requirements for the arguments to "throw" are a bit obscure,
+;; so give the user something simpler.
+
+(define-public (throw-user-error message . args)
+  (throw 'gdb:user-error #f message args))
diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm
index 7bb1a58..0a67868 100644
--- a/gdb/guile/lib/gdb/init.scm
+++ b/gdb/guile/lib/gdb/init.scm
@@ -1,6 +1,6 @@ 
-;; Scheme side of the gdb module.
+;; Finish Scheme initialization
 ;;
-;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015 Free Software Foundation, Inc.
 ;;
 ;; This file is part of GDB.
 ;;
@@ -17,152 +17,51 @@ 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-;; This file is included by (gdb).
-
-;; The original i/o ports.  In case the user wants them back.
-(define %orig-input-port #f)
-(define %orig-output-port #f)
-(define %orig-error-port #f)
-
-;; Keys for GDB-generated exceptions.
-;; gdb:with-stack is handled separately.
-
-(define %exception-keys '(gdb:error
-			  gdb:invalid-object-error
-			  gdb:memory-error
-			  gdb:pp-type-error
-			  gdb:user-error))
-
-;; Printer for gdb exceptions, used when Scheme tries to print them directly.
-
-(define (%exception-printer port key args default-printer)
-  (apply (case-lambda
-	  ((subr msg args . rest)
-	   (if subr
-	       (format port "In procedure ~a: " subr))
-	   (apply format port msg (or args '())))
-	  (_ (default-printer)))
-	 args))
-
-;; Print the message part of a gdb:with-stack exception.
-;; The arg list is the way it is because it's passed to set-exception-printer!.
-;; We don't print a backtrace here because Guile will have already printed a
-;; backtrace.
-
-(define (%with-stack-exception-printer port key args default-printer)
-  (let ((real-key (car args))
-	(real-args (cddr args)))
-    (%exception-printer port real-key real-args default-printer)))
-
-;; Copy of Guile's print-exception that tweaks the output for our purposes.
-;; TODO: It's not clear the tweaking is still necessary.
-
-(define (%print-exception-message-worker port key args)
-  (define (default-printer)
-    (format port "Throw to key `~a' with args `~s'." key args))
-  (format port "ERROR: ")
-  ;; Pass #t for tag to catch all errors.
-  (catch #t
-	 (lambda ()
-	   (%exception-printer port key args default-printer))
-	 (lambda (k . args)
-	   (format port "Error while printing gdb exception: ~a ~s."
-		   k args)))
-  (newline port)
-  (force-output port))
-
-;; Called from the C code to print an exception.
-;; Guile prints them a little differently than we want.
-;; See boot-9.scm:print-exception.
-
-(define (%print-exception-message port frame key args)
-  (cond ((memq key %exception-keys)
-	 (%print-exception-message-worker port key args))
-	(else
-	 (print-exception port frame key args)))
+(define-module (gdb init)
+  #:use-module ((gdb) #:select (register-command!
+				make-command
+				COMMAND_OBSCURE))
+  #:use-module (gdb command pretty-printer))
+
+;; Install the guile command prefixes:
+;; info guile ...
+;; enable guile ...
+;; disable guile ...
+
+(define (%install-guile-prefix-commands!)
+  (register-command!
+   (make-command
+    "info guile"
+    #:command-class COMMAND_OBSCURE
+    #:prefix? #t
+    #:invoke (lambda (self arg from-tty)
+	       ;; TODO: Call a gdb-provided function to print the list.
+	       (display "Provide an \"info guile\" subcommand.\n"))
+    #:doc "Print info on various Guile-implemented objects."))
+  (register-command!
+   (make-command
+    "enable guile"
+    #:command-class COMMAND_OBSCURE
+    #:prefix? #t
+    #:invoke (lambda (self arg from-tty)
+	       ;; TODO: Call a gdb-provided function to print the list.
+	       (display "Provide an \"enable guile\" subcommand.\n"))
+    #:doc "Enable the specified Guile-implemented objects."))
+  (register-command!
+   (make-command
+    "disable guile"
+    #:command-class COMMAND_OBSCURE
+    #:prefix? #t
+    #:invoke (lambda (self arg from-tty)
+	       ;; TODO: Call a gdb-provided function to print the list.
+	       (display "Provide a \"disable guile\" subcommand.\n"))
+    #:doc "Disable the specified Guile-implemented objects."))
   *unspecified*)
 
-;; Called from the C code to print an exception according to the setting
-;; of "guile print-stack".
-;;
-;; If PORT is #f, use the standard error port.
-;; If STACK is #f, never print the stack, regardless of whether printing it
-;; is enabled.  If STACK is #t, then print it if it is contained in ARGS
-;; (i.e., KEY is gdb:with-stack).  Otherwise STACK is the result of calling
-;; scm_make_stack (which will be ignored in favor of the stack in ARGS if
-;; KEY is gdb:with-stack).
-;; KEY, ARGS are the standard arguments to scm_throw, et.al.
-
-(define (%print-exception-with-stack port stack key args)
-  (let ((style (%exception-print-style)))
-    (if (not (eq? style 'none))
-	(let ((error-port (current-error-port))
-	      (frame #f))
-	  (if (not port)
-	      (set! port error-port))
-	  (if (eq? port error-port)
-	      (begin
-		(force-output (current-output-port))
-		;; In case the current output port is not gdb's output port.
-		(force-output (output-port))))
+;; Finish Scheme side initialization.
+;; This is called from C.
 
-	  ;; If the exception is gdb:with-stack, unwrap it to get the stack and
-	  ;; underlying exception.  If the caller happens to pass in a stack,
-	  ;; we ignore it and use the one in ARGS instead.
-	  (if (eq? key 'gdb:with-stack)
-	      (begin
-		(set! key (car args))
-		(if stack
-		    (set! stack (cadr args)))
-		(set! args (cddr args))))
-
-	  ;; If caller wanted a stack and there isn't one, disable backtracing.
-	  (if (eq? stack #t)
-	      (set! stack #f))
-	  ;; At this point if stack is true, then it is assumed to be a stack.
-	  (if stack
-	      (set! frame (stack-ref stack 0)))
-
-	  (if (and (eq? style 'full) stack)
-	      (begin
-		;; This is derived from libguile/throw.c:handler_message.
-		;; We include "Guile" in "Guile Backtrace" whereas the Guile
-		;; version does not so that tests can know it's us printing
-		;; the backtrace.  Plus it could help beginners.
-		(display "Guile Backtrace:\n" port)
-		(display-backtrace stack port #f #f '())
-		(newline port)))
-
-	  (%print-exception-message port frame key args)))))
-
-;; Internal utility called during startup to initialize the Scheme side of
-;; GDB+Guile.
-
-(define (%initialize!)
-  (for-each (lambda (key)
-	      (set-exception-printer! key %exception-printer))
-	    %exception-keys)
-  (set-exception-printer! 'gdb:with-stack %with-stack-exception-printer)
-
-  (set! %orig-input-port (set-current-input-port (input-port)))
-  (set! %orig-output-port (set-current-output-port (output-port)))
-  (set! %orig-error-port (set-current-error-port (error-port))))
-
-;; Dummy routine to silence "possibly unused local top-level variable"
-;; warnings from the compiler.
-
-(define-public (%silence-compiler-warnings%)
-  (list %print-exception-with-stack %initialize!))
-
-;; Public routines.
-
-(define-public (orig-input-port) %orig-input-port)
-(define-public (orig-output-port) %orig-output-port)
-(define-public (orig-error-port) %orig-error-port)
-
-;; Utility to throw gdb:user-error for use in writing gdb commands.
-;; The requirements for the arguments to "throw" are a bit obscure,
-;; so give the user something simpler.
-
-(define-public (throw-user-error message . args)
-  (throw 'gdb:user-error #f message args))
+(define-public (%finish-init!)
+  (%install-guile-prefix-commands!)
+  (%install-pretty-printer-commands!)
+  *unspecified*)
diff --git a/gdb/guile/lib/gdb/printing.scm b/gdb/guile/lib/gdb/printing.scm
index 137fab4..20229e2 100644
--- a/gdb/guile/lib/gdb/printing.scm
+++ b/gdb/guile/lib/gdb/printing.scm
@@ -18,18 +18,15 @@ 
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gdb printing)
-  #:use-module ((gdb) #:select
-		(pretty-printer? objfile? progspace?
-		 pretty-printers set-pretty-printers!
-		 objfile-pretty-printers set-objfile-pretty-printers!
-		 progspace-pretty-printers set-progspace-pretty-printers!))
-  #:use-module (gdb support))
+  #:use-module (gdb)
+  #:use-module (gdb support)
+  #:use-module (ice-9 format))
 
 (define-public (prepend-pretty-printer! obj matcher)
   "Add MATCHER to the beginning of the pretty-printer list for OBJ.
 If OBJ is #f, add MATCHER to the global list."
-  (assert-type (pretty-printer? matcher) matcher SCM_ARG1
-	       'prepend-pretty-printer! "pretty-printer")
+  (assert-type (pretty-printer? matcher)
+	       matcher SCM_ARG1 'prepend-pretty-printer! "pretty-printer")
   (cond ((eq? obj #f)
 	 (set-pretty-printers! (cons matcher (pretty-printers))))
 	((objfile? obj)
@@ -45,8 +42,8 @@  If OBJ is #f, add MATCHER to the global list."
 (define-public (append-pretty-printer! obj matcher)
   "Add MATCHER to the end of the pretty-printer list for OBJ.
 If OBJ is #f, add MATCHER to the global list."
-  (assert-type (pretty-printer? matcher) matcher SCM_ARG1
-	       'append-pretty-printer! "pretty-printer")
+  (assert-type (pretty-printer? matcher)
+	       matcher SCM_ARG1 'append-pretty-printer! "pretty-printer")
   (cond ((eq? obj #f)
 	 (set-pretty-printers! (append! (pretty-printers) (list matcher))))
 	((objfile? obj)
@@ -58,3 +55,37 @@  If OBJ is #f, add MATCHER to the global list."
 	(else
 	 (assert-type #f obj SCM_ARG1 'append-pretty-printer!
 		      "#f, objfile, or progspace"))))
+
+(define-public (enum-type->flag-list enum-type)
+  "Helper function for pretty-print-enum.
+Return the flag-list arg needed by pretty-print-flag-enum from ENUM-TYPE."
+  (assert-type (and (type? enum-type)
+		    (= (type-code enum-type) TYPE_CODE_ENUM))
+	       enum-type SCM_ARG1 'enum-type->flag-list "enum <gdb:type>")
+  (let ((fields (map (lambda (field) (cons (field-name field)
+					   (field-enumval field)))
+		     (type-fields enum-type))))
+    ;; Output is generally more readable if bits are sorted.
+    (sort fields (lambda (a b) (< (cdr a) (cdr b))))))
+
+(define-public (pretty-print-flag-enum flag-list value)
+  "Print VALUE which is a collection of bits defined by FLAG-LIST.
+FLAG-LIST is a list of (name . value) pairs.
+Returns a string of the form (FLAG1_NAME | FLAG2_NAME | ...)"
+  (assert-type (list? flag-list)
+	       flag-list SCM_ARG1 'pretty-print-flag-enum "list")
+  (assert-type (or (integer? value) (value? value))
+	       value SCM_ARG2 'pretty-print-flag-enum "integer or <gdb:value>")
+  (let* ((value (if (integer? value) value (value->integer value)))
+	 (flags (filter (lambda (flag)
+			  (= (logand value (cdr flag)) (cdr flag)))
+			flag-list))
+	 (all-present-names (map car flags))
+	 (all-present-bits (apply logior (map cdr flags)))
+	 (remaining (logand value (lognot all-present-bits)))
+	 (all-names (if (= remaining 0)
+			all-present-names
+			(append all-present-names
+				(list (format #f "<unknown: 0x~x>"
+					      remaining))))))
+    (format #f "(~a)" (string-join all-names " | "))))
diff --git a/gdb/guile/scm-exception.c b/gdb/guile/scm-exception.c
index 73dfb84..bd1f41b 100644
--- a/gdb/guile/scm-exception.c
+++ b/gdb/guile/scm-exception.c
@@ -482,7 +482,7 @@  gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
   if (gdbscm_is_false (percent_print_exception_message_var))
     {
       percent_print_exception_message_var
-	= scm_c_private_variable (gdbscm_init_module_name,
+	= scm_c_private_variable (gdbscm_module_name,
 				  percent_print_exception_message_name);
       /* If we can't find %print-exception-message, there's a problem on the
 	 Scheme side.  Don't kill GDB, just flag an error and leave it at
@@ -533,7 +533,7 @@  gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
   if (gdbscm_is_false (percent_print_exception_with_stack_var))
     {
       percent_print_exception_with_stack_var
-	= scm_c_private_variable (gdbscm_init_module_name,
+	= scm_c_private_variable (gdbscm_module_name,
 				  percent_print_exception_with_stack_name);
       /* If we can't find %print-exception-with-stack, there's a problem on the
 	 Scheme side.  Don't kill GDB, just flag an error and leave it at
diff --git a/gdb/guile/scm-pretty-print.c b/gdb/guile/scm-pretty-print.c
index 860cf8e..5d5a184 100644
--- a/gdb/guile/scm-pretty-print.c
+++ b/gdb/guile/scm-pretty-print.c
@@ -211,6 +211,17 @@  ppscm_get_pretty_printer_smob_arg_unsafe (SCM self, int arg_pos,
 
 /* Pretty-printer methods.  */
 
+/* (pretty-printer-name <gdb:pretty-printer>) -> string */
+
+static SCM
+gdbscm_pretty_printer_name (SCM self)
+{
+  pretty_printer_smob *pp_smob
+    = ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return pp_smob->name;
+}
+
 /* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
 
 static SCM
@@ -1068,6 +1079,10 @@  Create a <gdb:pretty-printer> object.\n\
     "\
 Return #t if the object is a <gdb:pretty-printer> object." },
 
+  { "pretty-printer-name", 1, 0, 0, gdbscm_pretty_printer_name,
+    "\
+Return the name of the pretty-printer." },
+
   { "pretty-printer-enabled?", 1, 0, 0, gdbscm_pretty_printer_enabled_p,
     "\
 Return #t if the pretty-printer is enabled." },
diff --git a/gdb/testsuite/gdb.guile/scm-pp-maint-gdb.in b/gdb/testsuite/gdb.guile/scm-pp-maint-gdb.in
new file mode 100644
index 0000000..3dd93cc
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pp-maint-gdb.in
@@ -0,0 +1,116 @@ 
+;; Copyright (C) 2010-2015 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+;; This file is part of the GDB testsuite.  It tests guile pretty printer
+;; maintenance.
+
+(use-modules (gdb)
+	     (gdb printing)
+	     (ice-9 format))
+
+(define (pp_s-printer prefix val)
+  (let ((a (value-field val "a"))
+	(b (value-field val "b")))
+    (if (not (value=? (value-address a) b))
+	(error (format #f "&a(~A) != b(~A)"
+		       (value-address a) b)))
+    (format #f "~aa=<~A> b=<~A>" prefix a b)))
+
+(define (make-pp_s-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (pp_s-printer "" val))
+   #f))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct s" make-pp_s-printer)
+    (hash-set! dict "s" make-pp_s-printer)
+
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+
+    dict))
+
+(define (make-pretty-printer-from-dict name dict lookup-maker)
+  (make-pretty-printer
+   name
+   (lambda (matcher val)
+     (let ((printer-maker (lookup-maker dict val)))
+       (and printer-maker (printer-maker val))))))
+
+(define (lookup-pretty-printer-maker-from-dict dict val)
+  (let ((type-name (type-tag (get-type-for-printing val))))
+    (and type-name
+	 (hash-ref dict type-name))))
+
+(append-pretty-printer! #f
+			(make-pretty-printer-from-dict
+			 "s-ss-structs"
+			 (make-pretty-printer-dict)
+			 lookup-pretty-printer-maker-from-dict))
+
+(define (make-flag-enum-printer val type with-value)
+  "Pretty-print flag_enum VAL.
+If WITH_VALUE is true, include its hex value."
+  (make-pretty-printer-worker
+   #f
+   (let ((flag-list (enum-type->flag-list type)))
+     (lambda (printer)
+       (if with-value
+	   (string-append (format #f "0x~x " (value->integer val))
+			  (pretty-print-flag-enum flag-list val))
+	   (pretty-print-flag-enum flag-list val))))
+   #f))
+
+(define (flag-enum-matcher-1 matcher val with-value)
+  (let* ((type (get-type-for-printing val))
+	 (type-name (type-tag type)))
+    (and type-name
+	 (string=? type-name "flag_enum")
+	 (make-flag-enum-printer val type with-value))))
+
+(define (flag-enum-matcher matcher val)
+  (flag-enum-matcher-1 matcher val #f))
+
+(define (flag-enum-matcher-with-value matcher val)
+  (flag-enum-matcher-1 matcher val #t))
+
+(append-pretty-printer! (current-progspace)
+			(make-pretty-printer
+			 "flag-enum"
+			 flag-enum-matcher))
+
+(append-pretty-printer! (current-objfile)
+			(make-pretty-printer
+			 "flag-enum-with-value"
+			 flag-enum-matcher-with-value))
diff --git a/gdb/testsuite/gdb.guile/scm-pp-maint.c b/gdb/testsuite/gdb.guile/scm-pp-maint.c
new file mode 100644
index 0000000..4724fb53
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pp-maint.c
@@ -0,0 +1,65 @@ 
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2010-2015 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.  */
+
+#include <string.h>
+
+enum flag_enum
+  {
+    FLAG_1 = 1,
+    FLAG_2 = 2,
+    FLAG_3 = 4,
+    ALL = FLAG_1 | FLAG_2 | FLAG_3
+  };
+
+enum flag_enum fval;
+
+struct s
+{
+  int a;
+  int *b;
+};
+
+struct ss
+{
+  struct s a;
+  struct s b;
+};
+
+void
+init_s (struct s *s, int a)
+{
+  s->a = a;
+  s->b = &s->a;
+}
+
+void
+init_ss (struct ss *s, int a, int b)
+{
+  init_s (&s->a, a);
+  init_s (&s->b, b);
+}
+
+int
+main ()
+{
+  struct ss ss;
+
+  init_ss (&ss, 1, 2);
+  fval = FLAG_1 | FLAG_3;
+  
+  return 0;      /* break to inspect */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-pp-maint.exp b/gdb/testsuite/gdb.guile/scm-pp-maint.exp
new file mode 100644
index 0000000..19942b6
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-pp-maint.exp
@@ -0,0 +1,199 @@ 
+# Copyright (C) 2010-2015 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the GDB testsuite.  It tests guile pretty printer
+# maintenance.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile debug]} {
+    return -1
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+set remote_scheme_file [gdb_remote_download host \
+			    ${srcdir}/${subdir}/${testfile}-gdb.in \
+			    [standard_output_file ${testfile}-gdb.scm]]
+
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_test_no_output "set auto-load safe-path ${remote_scheme_file}" \
+    "set auto-load safe-path"
+gdb_load ${binfile}
+
+# Verify gdb loaded the script.
+gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*"
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+    ".*Breakpoint.*"
+gdb_test "continue" ".*Breakpoint.*"
+
+set num_pp 3
+
+gdb_test "info guile pretty-printer" \
+    ".*Global.*s-ss-structs.*Progspace.*flag-enum.*${testfile}.*flag-enum-with-value"
+
+proc test_global { } {
+    global hex num_pp
+
+    gdb_test "info guile pretty-printer global .*s-ss" \
+	".*Global.*s-ss-structs"
+
+    gdb_test "info guile pretty-printer .* s-ss" \
+	".*Global.*s-ss-structs"
+
+    gdb_test "print ss" \
+	" = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
+	"print ss enabled #1"
+
+    gdb_test "disable guile pretty-printer -v" \
+	"$num_pp pretty-printers disabled.*0 of $num_pp pretty-printers enabled"
+
+    gdb_test "enable guile pretty-printer -v" \
+	"$num_pp pretty-printers enabled.*$num_pp of $num_pp pretty-printers enabled"
+
+    gdb_test "disable guile pretty-printer -v global" \
+	"1 pretty-printer disabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "enable guile pretty-printer -v" \
+	"1 pretty-printer enabled.*$num_pp of $num_pp pretty-printers enabled"
+
+    gdb_test "disable guile pretty-printer -v global s-ss" \
+	"1 pretty-printer disabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "info guile pretty-printer global s-ss" \
+	{.*s-ss-structs \[disabled\]}
+
+    gdb_test "info guile pretty-printer .* s-ss" \
+	{.*s-ss-structs \[disabled\]}
+
+    gdb_test "print ss" \
+	" = {a = {a = 1, b = $hex}, b = {a = 2, b = $hex}}" \
+	"print ss disabled"
+
+    gdb_test "enable guile pretty-printer -v global s-ss" \
+	"1 pretty-printer enabled.*$num_pp of $num_pp pretty-printers enabled"
+
+    gdb_test "info guile pretty-printer .* s-ss" \
+	".*s-ss-structs" \
+	"info guile pretty-printer .* s-ss, re-enabled"
+
+    gdb_test "print ss" " = a=<a=<1> b=<$hex>> b=<a=<2> b=<$hex>>" \
+	"print ss, re-enabled"
+}
+
+with_test_prefix global {
+    test_global
+}
+
+proc test_progspace { } {
+    global num_pp testfile
+
+    # First disable objfile version of flag_enum printer.
+    gdb_test "disable guile pretty-printer -v ${testfile}" \
+	"1 pretty-printer disabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "info guile pretty-printer progspace" \
+	".*flag-enum"
+
+    gdb_test "print (enum flag_enum) (FLAG_1)" \
+	" = .FLAG_1." \
+	"print FLAG_1"
+
+    gdb_test "disable guile pretty-printer -v progspace" \
+	"1 pretty-printer disabled.*[expr $num_pp - 2] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (FLAG_1)" \
+	" = FLAG_1" \
+	"print FLAG_1, disabled"
+
+    gdb_test "enable guile pretty-printer -v progspace" \
+	"1 pretty-printer enabled.*[expr $num_pp -1] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (FLAG_1 | FLAG_3)" \
+	" = .FLAG_1 | FLAG_3." \
+	"print FLAG_1 | FLAG_3"
+
+    gdb_test "disable guile pretty-printer -v progspace flag-enum" \
+	"1 pretty-printer disabled.*[expr $num_pp - 2] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (4 + 8)" \
+	" = 12" \
+	"print FLAG_3 | 8, disabled"
+
+    gdb_test "enable guile pretty-printer -v progspace flag-enum" \
+	"1 pretty-printer enabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (4 + 8)" \
+	" = .FLAG_3 | <unknown: 0x8>." \
+	"print FLAG_3 | 8"
+
+    gdb_test "enable guile pretty-printer -v ${testfile}" \
+	"1 pretty-printer enabled.*$num_pp of $num_pp pretty-printers enabled"
+}
+
+with_test_prefix progspace {
+    test_progspace
+}
+
+proc test_objfile { } {
+    global num_pp testfile
+
+    gdb_test "info guile pretty-printer ${testfile}" \
+	".*flag-enum-with-value"
+
+    gdb_test "print (enum flag_enum) (FLAG_1)" \
+	" = 0x1 .FLAG_1." \
+	"print FLAG_1"
+
+    gdb_test "disable guile pretty-printer -v ${testfile}" \
+	"1 pretty-printer disabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (FLAG_1)" \
+	" = .FLAG_1." \
+	"print FLAG_1, disabled"
+
+    gdb_test "enable guile pretty-printer -v ${testfile}" \
+	"1 pretty-printer enabled.*$num_pp of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (FLAG_1 | FLAG_3)" \
+	" = 0x5 .FLAG_1 | FLAG_3." \
+	"print FLAG_1 | FLAG_3"
+
+    gdb_test "disable guile pretty-printer -v ${testfile} flag-enum-with-value" \
+	"1 pretty-printer disabled.*[expr $num_pp - 1] of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (4 + 8)" \
+	" = .FLAG_3 | <unknown: 0x8>." \
+	"print FLAG_3 | 8, disabled"
+
+    gdb_test "enable guile pretty-printer -v ${testfile} flag-enum-with-value" \
+	"1 pretty-printer enabled.*$num_pp of $num_pp pretty-printers enabled"
+
+    gdb_test "print (enum flag_enum) (4 + 8)" \
+	" = 0xc .FLAG_3 | <unknown: 0x8>." \
+	"print FLAG_3 | 8"
+}
+
+with_test_prefix objfile {
+    test_objfile
+}