/[gcl]/gcl/lsp/gcl_defstruct.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_defstruct.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by camm, Wed Aug 25 22:48:24 2004 UTC revision 1.6 by camm, Fri Jul 8 06:11:00 2005 UTC
# Line 1  Line 1 
1    ;;-*-Lisp-*-
2  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
3    
4  ;; This file is part of GNU Common Lisp, herein referred to as GCL  ;; This file is part of GNU Common Lisp, herein referred to as GCL
# Line 511  Line 512 
512          copier          copier
513          predicate predicate-specified          predicate predicate-specified
514          include          include
515          print-function type named initial-offset          print-function print-object  type named initial-offset
516          offset name-offset          offset name-offset
517          documentation          documentation
518          static          static
# Line 562  Line 563 
563                     (setq include (cdar os))                     (setq include (cdar os))
564                     (unless (get v 's-data)                     (unless (get v 's-data)
565                             (error "~S is an illegal included structure." v)))                             (error "~S is an illegal included structure." v)))
566                     (:print-object
567                      (and (consp v) (eq (car v) 'function)
568                           (setq v (second v)))
569                      (setq print-object v))
570                   (:print-function                   (:print-function
571                    (and (consp v) (eq (car v) 'function)                    (and (consp v) (eq (car v) 'function)
572                         (setq v (second v)))                         (setq v (second v)))
# Line 587  Line 592 
592    
593      (setq conc-name (intern (string conc-name)))      (setq conc-name (intern (string conc-name)))
594    
595        (when (and print-function print-object)
596          (error "Cannot specify both :print-function and :print-object."))
597        (when print-object
598          (setq print-function (lambda (x y z) (declare (ignore z)) (funcall print-object x y))))
599    
600      (and include (not print-function)      (and include (not print-function)
601           (setq print-function (s-data-print-function (get (car include)  's-data))))           (setq print-function (s-data-print-function (get (car include)  's-data))))
602    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26