gdb/guile/lib/gdb/printing.scm

   1 ;; Additional pretty-printer support.
   2 ;;
   3 ;; Copyright (C) 2014 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 init))
  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!)
  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
  44 (define-public (append-pretty-printer! obj matcher)
  45   "Add MATCHER to the end of the pretty-printer list for OBJ.
  46 If OBJ is #f, add MATCHER to the global list."
  47   (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
  48                 'append-pretty-printer!)
  49   (cond ((eq? obj #f)
  50          (set-pretty-printers! (append! (pretty-printers) (list matcher))))
  51         ((objfile? obj)
  52          (set-objfile-pretty-printers!
  53           obj (append! (objfile-pretty-printers obj) (list matcher))))
  54         ((progspace? obj)
  55          (set-progspace-pretty-printers!
  56           obj (append! (progspace-pretty-printers obj) (list matcher))))
  57         (else
  58          (%assert-type #f obj SCM_ARG1 'append-pretty-printer!))))