contrib/gdb-7/gdb/guile/lib/gdb/printing.scm

   1 ;; Additional pretty-printer support.
   2 ;;
   3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
   4 ;;
   5 ;; This file is part of GDB.
   6 ;;
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 3 of the License, or
  10 ;; (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gdb printing)
  21   #:use-module ((gdb) #:select
  22                 (pretty-printer? objfile? progspace?
  23                  pretty-printers set-pretty-printers!
  24                  objfile-pretty-printers set-objfile-pretty-printers!
  25                  progspace-pretty-printers set-progspace-pretty-printers!))
  26   #:use-module (gdb support))
  27
  28 (define-public (prepend-pretty-printer! obj matcher)
  29   "Add MATCHER to the beginning of the pretty-printer list for OBJ.
  30 If OBJ is #f, add MATCHER to the global list."
  31   (assert-type (pretty-printer? matcher) matcher SCM_ARG1
  32                'prepend-pretty-printer! "pretty-printer")
  33   (cond ((eq? obj #f)
  34          (set-pretty-printers! (cons matcher (pretty-printers))))
  35         ((objfile? obj)
  36          (set-objfile-pretty-printers!
  37           obj (cons matcher (objfile-pretty-printers obj))))
  38         ((progspace? obj)
  39          (set-progspace-pretty-printers!
  40           obj (cons matcher (progspace-pretty-printers obj))))
  41         (else
  42          (assert-type #f obj SCM_ARG1 'prepend-pretty-printer!
  43                       "#f, objfile, or progspace"))))
  44
  45 (define-public (append-pretty-printer! obj matcher)
  46   "Add MATCHER to the end of the pretty-printer list for OBJ.
  47 If OBJ is #f, add MATCHER to the global list."
  48   (assert-type (pretty-printer? matcher) matcher SCM_ARG1
  49                'append-pretty-printer! "pretty-printer")
  50   (cond ((eq? obj #f)
  51          (set-pretty-printers! (append! (pretty-printers) (list matcher))))
  52         ((objfile? obj)
  53          (set-objfile-pretty-printers!
  54           obj (append! (objfile-pretty-printers obj) (list matcher))))
  55         ((progspace? obj)
  56          (set-progspace-pretty-printers!
  57           obj (append! (progspace-pretty-printers obj) (list matcher))))
  58         (else
  59          (assert-type #f obj SCM_ARG1 'append-pretty-printer!
  60                       "#f, objfile, or progspace"))))