;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ****c* named-object/linked-named-object
;;; NAME 
;;; linked-named-object
;;;
;;; File:             linked-named-object.lsp
;;;
  Class Hierarchy :   named - object - > linked - named - object
;;;
  Version :           1.0.12
;;;
;;; Project:          slippery chicken (algorithmic composition)
;;;
;;; Purpose:          Extension of named-object class to provide slots for the
;;;                   previous and next objects in a recursive-assoc-list.
;;;
  Author :              : 
;;;
  Creation date :     March 10th 2002
;;;
;;; $$ Last modified:  17:47:47 Wed Jan 31 2018 CET
;;;
  SVN ID : $ Id$
;;;
;;; ****
  Licence :           Copyright ( c ) 2010  
;;;
;;;                   This file is part of slippery-chicken
;;;
;;;                   slippery-chicken 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.
;;;
;;;                   slippery-chicken 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 slippery-chicken; if not, write to the
                    Free Software Foundation , Inc. , 59 Temple Place , Suite
                    330 , Boston , MA 02111 - 1307 USA
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :slippery-chicken)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defclass linked-named-object (named-object)
  ((previous :accessor previous :initarg :previous :initform nil)
   (this :accessor this :initarg :this :initform nil)
   (next :accessor next :initarg :next :initform nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod clone ((lno linked-named-object))
  (clone-with-new-class lno 'linked-named-object))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod clone-with-new-class :around ((lno linked-named-object) new-class)
  (declare (ignore new-class))
  (let ((no (call-next-method)))
    (setf (slot-value no 'previous) (basic-copy-object (previous lno))
          (slot-value no 'this) (basic-copy-object (this lno))
          (slot-value no 'next) (basic-copy-object (next lno)))
    no))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod print-object :before ((lno linked-named-object) stream)
  (format stream "~&LINKED-NAMED-OBJECT: previous: ~a, ~
                  ~&                     this: ~a, ~
                  ~&                     next: ~a"
          (previous lno) (this lno) (next lno)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Related functions.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun no-to-lno (named-object &optional previous this next)
  ;; (print 'no-to-lno)
  ;; (print (id named-object))
  (let ((lno (clone-with-new-class named-object 'linked-named-object)))
    ;; make previous and next slots just named-objects, not the
    ;; linked-named-objects that they may well be
    (setf (previous lno) previous
  20/3/05 this
          (next lno) next)
    lno))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun linked-named-object-p (thing)
  (typep thing 'linked-named-object))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  EOF linked-named-object.lsp


 ****c* named-object/linked-named-object
 NAME 
 linked-named-object

 File:             linked-named-object.lsp



 Project:          slippery chicken (algorithmic composition)

 Purpose:          Extension of named-object class to provide slots for the
                   previous and next objects in a recursive-assoc-list.



 $$ Last modified:  17:47:47 Wed Jan 31 2018 CET


 ****

                   This file is part of slippery-chicken

                   slippery-chicken is free software; you can redistribute it
                   and/or modify it under the terms of the GNU General
 either version 3 of the License , or ( at your
                   option) any later version.

                   slippery-chicken 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.

                   License along with slippery-chicken; if not, write to the
 







 Related functions.


 (print 'no-to-lno)
 (print (id named-object))
 make previous and next slots just named-objects, not the
 linked-named-objects that they may well be


  Class Hierarchy :   named - object - > linked - named - object
  Version :           1.0.12
  Author :              : 
  Creation date :     March 10th 2002
  SVN ID : $ Id$
  Licence :           Copyright ( c ) 2010  
                    Public License as published by the Free Software
                    You should have received a copy of the GNU General Public
                    Free Software Foundation , Inc. , 59 Temple Place , Suite
                    330 , Boston , MA 02111 - 1307 USA

(in-package :slippery-chicken)


(defclass linked-named-object (named-object)
  ((previous :accessor previous :initarg :previous :initform nil)
   (this :accessor this :initarg :this :initform nil)
   (next :accessor next :initarg :next :initform nil)))


(defmethod clone ((lno linked-named-object))
  (clone-with-new-class lno 'linked-named-object))


(defmethod clone-with-new-class :around ((lno linked-named-object) new-class)
  (declare (ignore new-class))
  (let ((no (call-next-method)))
    (setf (slot-value no 'previous) (basic-copy-object (previous lno))
          (slot-value no 'this) (basic-copy-object (this lno))
          (slot-value no 'next) (basic-copy-object (next lno)))
    no))


(defmethod print-object :before ((lno linked-named-object) stream)
  (format stream "~&LINKED-NAMED-OBJECT: previous: ~a, ~
                  ~&                     this: ~a, ~
                  ~&                     next: ~a"
          (previous lno) (this lno) (next lno)))


(defun no-to-lno (named-object &optional previous this next)
  (let ((lno (clone-with-new-class named-object 'linked-named-object)))
    (setf (previous lno) previous
  20/3/05 this
          (next lno) next)
    lno))


(defun linked-named-object-p (thing)
  (typep thing 'linked-named-object))


  EOF linked-named-object.lsp
