/[noctool]/source/graph-utils.lisp
ViewVC logotype

Contents of /source/graph-utils.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Thu Feb 5 15:47:49 2009 UTC (5 years, 2 months ago) by jprewett
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +5 -5 lines
D'OH!  used ingvar's suggestion to use the argument to intern to make the code a little more elegant :)
1 (in-package #:net.hexapodia.noctool-graphs)
2
3 (defvar *monitor-graph-map* (make-hash-table))
4 (defvar *class-compose-map* (make-hash-table :test #'equal))
5
6 (defun compose-graph-class (data display)
7 (let ((cache (gethash (list data display) *class-compose-map*)))
8 (if cache
9 cache
10 (let ((superclasses (list data display))
11 (name (intern (format nil "GRAPH-COMPOSE+~a+~a"
12 (symbol-name data)
13 (symbol-name display))
14 (find-package :noctool-graphs))))
15 (ensure-class name
16 :direct-superclasses superclasses)
17 (setf (gethash superclasses *class-compose-map*) name)))))
18
19 (defclass graph-info ()
20 ((slot :reader slot :initarg :slot)
21 (data :reader data :initarg :data)
22 (display :reader display :initarg :display)
23 ))
24
25 (defmacro add-graph-info (monitor slot data display)
26 `(push (make-instance 'graph-info
27 :slot ',slot
28 :data ',data
29 :display ',display)
30 (gethash ',monitor *monitor-graph-map*)))
31
32
33 (defun add-graphs (monitor)
34 (let ((class (class-name (class-of monitor))))
35 (let ((graphs (gethash class *monitor-graph-map*)))
36 (loop for graph-info in graphs
37 do (setf (slot-value monitor (slot graph-info))
38 (make-graph (compose-graph-class (data graph-info)
39 (display graph-info) )
40 :interval (interval monitor)))))))

  ViewVC Help
Powered by ViewVC 1.1.5