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-printers* pretty-printer? objfile? progspace?
  23                  objfile-pretty-printers set-objfile-pretty-printers!
  24                  progspace-pretty-printers set-progspace-pretty-printers!))
  25   #:use-module (gdb init))
  26
  27 (define-public (prepend-pretty-printer! obj matcher)
  28   "Add MATCHER to the beginning of the pretty-printer list for OBJ.
  29 If OBJ is #f, add MATCHER to the global list."
  30   (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
  31                 'prepend-pretty-printer!)
  32   (cond ((eq? obj #f)
  33          (set! *pretty-printers* (cons matcher *pretty-printers*)))
  34         ((objfile? obj)
  35          (set-objfile-pretty-printers!
  36           obj (cons matcher (objfile-pretty-printers obj))))
  37         ((progspace? obj)
  38          (set-progspace-pretty-printers!
  39           obj (cons matcher (progspace-pretty-printers obj))))
  40         (else
  41          (%assert-type #f obj SCM_ARG1 'prepend-pretty-printer!))))
  42
  43 (define-public (append-pretty-printer! obj matcher)
  44   "Add MATCHER to the end of the pretty-printer list for OBJ.
  45 If OBJ is #f, add MATCHER to the global list."
  46   (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
  47                 'append-pretty-printer!)
  48   (cond ((eq? obj #f)
  49          (set! *pretty-printers* (append! *pretty-printers* (list matcher))))
  50         ((objfile? obj)
  51          (set-objfile-pretty-printers!
  52           obj (append! (objfile-pretty-printers obj) (list matcher))))
  53         ((progspace? obj)
  54          (set-progspace-pretty-printers!
  55           obj (append! (progspace-pretty-printers obj) (list matcher))))
  56         (else
  57          (%assert-type #f obj SCM_ARG1 'append-pretty-printer!))))