1 ;;; cogre.el --- COnnected GRaph Editor for Emacs
3 ;;; Copyright (C) 2001, 2002, 2003, 2005, 2007 Eric M. Ludlam
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; Keywords: graph, oop, extensions, outlines
7 ;; X-RCS: $Id: cogre.el,v 1.1 2007-11-26 15:04:23 michaels Exp $
9 (defvar cogre-version "0.5"
10 "Current version of Cogre.")
12 ;; This file is not part of GNU Emacs.
14 ;; This is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; This software is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;; Many types of code can be displayed as a series of connected
32 ;; graphs, such as UML class or sequence diagrams. COGRE attempts to
33 ;; allow Emacs to display such graphs with data generated from
43 (require 'picture-hack))
49 "COnnected GRaph Editor."
52 (defcustom cogre-horizontal-margins 10
53 "*Horizontal margins between nodes when they are being layed out."
57 (defcustom cogre-vertical-margins 7
58 "*Horizontal margins between nodes when they are being layed out."
63 (defclass cogre-graph (eieio-persistent)
64 ((extension :initform ".cgr") ;; Override the default
70 "The name of this graph.
71 The save file name is based on this name.")
72 (buffer :initarg :buffer
74 :type (or null buffer)
76 "When this graph is active, this is the buffer the graph is
78 (elements :initarg :elements
82 "The list of elements in this graph.")
85 a connected graph contains a series of nodes and links which are
86 rendered in a buffer, or serialized to disk.")
88 (defclass cogre-graph-element (eieio-named)
91 "Non-nil if this graph element is dirty.
92 Elements are made dirty when they are erased from the screen.
93 Elements must be erased before any graphical fields are changed.")
94 (name-default :initform "Name"
99 "The object-name of this node.
100 Node object-names must be unique within the current graph so that save
101 references in links can be restored.")
106 "List of menu items in Easymenu format of changeable things.
107 Any given element may have several entries of details which are
109 Examples could be Add/Removing/Renaming slots, or changing linkages."
113 Graph elements are anything that is drawn into a `cogre-graph'.
114 Graph elements have a method for marking themselves dirty."
117 (defclass cogre-node (cogre-graph-element)
118 ((position :initarg :position
121 :custom (vector integer integer)
123 "The X,Y [COL ROW] position as a vector for this node.
124 The Width/Height if this node is determined by RECTANGLE, which is
125 a list of strings representing the body of the node."
127 (blank-lines-top :allocation :class
130 "Number of blank lines above the object-name.")
131 (blank-lines-bottom :allocation :class
134 "Number of blank lines below the last line of text.")
135 (alignment :initform nil
139 "Alignment of text when displayed in the box.")
140 (rectangle :initform nil
143 "A List of strings representing an Emacs rectangle.
144 This rectangle is used for inserting and moving the block of
145 characters that represent this node in a buffer.
146 The rectangle is NOT SAVED.
147 Other fields in the node are used to build a new RECTANGLE of strings
150 "Connected Graph node.
151 Nodes are regions with a fill color, and some amount of text representing
152 a status, or values."
155 (defclass cogre-link (cogre-graph-element)
156 ((start :initarg :start
158 :type (or null string cogre-node)
159 :documentation "The starting node.
160 As a string, the object-name of the node we start on.
161 As an object, the node we start on.")
164 :type (or null string cogre-node)
165 :documentation "The ending node.
166 As a string, the object-name of the node we end on.
167 As an object, the node we end on.")
168 (start-glyph :initform [ nil nil nil nil ]
171 :documentation "The starting glyph.
172 A Glyph can be NULL, meaning nothing, or a vector.
173 A Vector must be 4 elements long. This represents glyphs on
174 the [ TOP BOTTOM LEFT RIGHT ] of the attached node.
175 Each element of the vector must be a list representing a rectangle.")
176 (end-glyph :initform [ nil nil nil nil ]
179 :documentation "The ending glyph.
180 See slot `start-glyph'")
181 (horizontal-preference-ratio
185 "When choosing a link's direction, a weight applied to horizontal.
186 Since characters are not square, this ratio attempts to handle the visible
187 space the link spans, not the number of characters in the coordinate
189 Also, some links may want to be vertical or horizontal as often as
190 possible, thus values of 0 or 10 are also fine to advance a
192 (stop-position :initform nil
194 "After drawing this link, store a place for a tab stop.")
198 "When using the layout engine, the preferred direction this link points.
199 This can have a value of 'up, 'down, 'left, 'right, 'horizontal,
200 'vertical, or 'any.")
202 "Connected Graph link.
203 Links are lines drawn between two nodes, or possibly loose in space
204 as an intermediate step. Some links have text describing what they
205 do, and most links have special markers on one end or another, such as
208 ;;; Connecte Graph variables
210 (defvar cogre-loading-from-file nil
211 "Flag indicating that we are loading a graph from a file.")
213 (defcustom cogre-mode-hooks nil
214 "Hooks run in `cogre-mode'."
218 (defvar cogre-graph nil
219 "The current connected graph.")
220 (make-variable-buffer-local 'cogre-graph)
222 ;;; Buffer initialization
225 (defun cogre (name &optional graph-class)
226 "Create a new graph with the Connected Graph Editor.
227 The new graph will be given NAME. See `cogre-mode' for details.
228 Optional argument GRAPH-CLASS indicates the type of graph to create."
229 (interactive "sGraph Name: ")
230 (let ((newgraph (if graph-class
231 (funcall graph-class name :name name)
232 (cogre-graph name :name name))))
233 (switch-to-buffer (get-buffer-create (concat "*Graph " name "*")))
234 (setq cogre-graph newgraph)
235 ;;(toggle-read-only 1)
236 (require 'cogre-mode)
240 ;;; Default management
242 ;; Defaults provide a way of quickly creating a bunch of the same type
243 ;; of node/link, or whatever. By using these functions in `interactive'
244 ;; commands, a set of defaults can be specified which are used
246 (defvar cogre-node-history nil
247 "The history for reading in node class names.")
249 (defvar cogre-default-node nil
250 "The last node type queried.
251 Used as the default node type when a user wants a node, and no request
252 to change it has been made.")
254 (defun cogre-default-node (&optional node prefix)
255 "Return the default node type.
256 If run interactively, query for a new node to make the default.
257 If called non-interactivly there is no default, query for one.
258 If NODE is supplied, use that.
259 If there is a PREFIX argument, then force a query for one."
260 (interactive (list (eieio-read-subclass "Node Type: "
265 ;; Save whatever is being set.
266 (if node (setq cogre-default-node node))
267 ;; If we are not interactive, then check the prefix.
268 (if (or prefix (not cogre-default-node))
269 (setq cogre-default-node (eieio-read-subclass "Node Type: "
273 ;; Return the cached node.
277 (defvar cogre-link-history nil
278 "The history for reading in link class names.")
280 (defvar cogre-default-link nil
281 "The last link type queried.
282 Used as the default link type when a user wants a link, and no request
283 to change it has been made.")
285 (defun cogre-default-link (&optional link prefix)
286 "Return the default link type.
287 If run interactively, query for a new link to make the default.
288 If called non-interactivly there is no default, query for one.
289 If LINK is supplied, use that.
290 If there is a PREFIX argument, then force a query for one."
291 (interactive (list (eieio-read-subclass "Link Type: "
296 ;; Save whatever is being set.
297 (if link (setq cogre-default-link link))
298 ;; If we are not interactive, then check the prefix.
299 (if (or prefix (not cogre-default-link))
300 (setq cogre-default-link (eieio-read-subclass "Link Type: "
304 ;; Return the cached link.
308 ;;; Commands for Graph Mode
310 (defun cogre-refresh ()
311 "Refresh the current display completely."
313 (cogre-render-buffer cogre-graph t))
317 (defun cogre-map-elements (function)
318 "Map FUNCTION onto all current graph elements."
319 (cogre-map-graph-elements cogre-graph function))
321 (defun cogre-map-graph-elements (graph function)
322 "For elements of GRAPH, call FUNCTION.
323 Function must take one argument, which is the element.
324 This function can also be a method.
325 Returns a list of return values from each call of function."
326 (mapcar function (oref graph elements)))
330 (defvar cogre-custom-originating-graph-buffer nil
331 "The graph from which a custom buffer originated.")
332 (make-variable-buffer-local 'cogre-custom-originating-graph-buffer)
334 (defmethod cogre-activate ((element cogre-graph-element))
336 This could be as simple as displaying the current state,
337 customizing the object, or performing some complex task."
338 (let ((b (current-buffer)))
339 (require 'eieio-custom)
340 (customize-object element)
341 (setq cogre-custom-originating-graph-buffer b))
344 (defmethod eieio-done-customizing ((element cogre-graph-element))
345 "Finish customizing a graph element."
346 (cogre-set-dirty element t)
348 (set-buffer cogre-custom-originating-graph-buffer)
349 (cogre-render-buffer cogre-graph))
352 (defmethod cogre-add-element ((graph cogre-graph) elt)
353 "Add to GRAPH a new element ELT."
354 (object-add-to-list graph 'elements elt t))
356 (defmethod cogre-delete-element ((graph cogre-graph) elt)
357 "Delete from GRAPH the element ELT."
358 (object-remove-from-list graph 'elements elt))
360 (defmethod cogre-unique-name ((graph cogre-graph) name)
361 "Within GRAPH, make NAME unique."
363 (obj (object-assoc name :object-name (oref graph elements)))
366 (setq newname (concat name (int-to-string inc)))
368 (setq obj (object-assoc newname :object-name (oref graph elements))))
371 (defmethod cogre-set-dirty ((element cogre-graph-element) dirty-state)
372 "Set the dirty state for ELEMENT to DIRTY-STATE."
373 (oset element dirty dirty-state))
375 (defmethod cogre-set-dirty ((node cogre-node) dirty-state)
376 "Set the dirty state for NODE to DIRTY-STATE."
377 (if dirty-state (oset node rectangle nil))
380 (defmethod initialize-instance ((elt cogre-graph-element) fields)
381 "Initialize ELT's name before the main FIELDS are initialized."
382 (unless cogre-loading-from-file
383 (let ((n (oref elt name-default)))
384 (object-set-name-string elt n)))
387 (defmethod initialize-instance :AFTER ((elt cogre-graph-element) fields)
388 "When creating a new element, add it to the current graph.
389 Argument ELT is the element being created.
390 Argument FIELDS are ignored."
391 (unless cogre-loading-from-file
392 (let ((n (oref elt object-name)))
393 ;; make sure our name is unique.
394 (oset elt object-name (cogre-unique-name cogre-graph n)))
395 (cogre-add-element cogre-graph elt)))
399 (defmethod cogre-render-buffer ((graph cogre-graph) &optional erase)
400 "Render the current graph GRAPH.
401 If optional argument ERASE is non-nil, then erase the buffer,
402 and render everything. If ERASE is nil, then only redraw items
403 with dirty flags set."
404 (let ((inhibit-read-only t)
406 (y (1- (picture-current-line)))
407 (inhibit-point-motion-hooks t))
412 (cogre-map-elements (lambda (e) (cogre-set-dirty e t)))))
413 (cogre-map-elements 'cogre-render))
414 (picture-goto-coordinate x y)))
416 (defmethod cogre-render ((element cogre-graph-element))
418 By default, an ELEMENT has nothing to see, but assume we
419 are called from `call-next-method', so reset our dirty flag."
420 (cogre-set-dirty element nil))
422 (defmethod cogre-erase ((element cogre-graph-element))
424 By default, an ELEMENT has nothing to erase, but assume we
425 are called from `call-next-method', so set our dirty flag."
426 (cogre-set-dirty element t))
428 (defmethod cogre-element-pre-serialize ((elt cogre-graph-element))
429 "Prepare the current node to be serialized.
430 Remove all pointers to objects (such as links), and replace
431 with something reversable."
434 (defmethod cogre-element-post-serialize ((elt cogre-graph-element))
435 "Restore object pointers after being loaded from disk.
436 Also called after a graph was saved to restore all objects.
437 Reverses `cogre-graph-pre-serialize'."
440 (defmethod cogre-entered ((element cogre-graph-element) start end)
441 "Method called when the cursor enters ELEMENT.
442 START and END cover the region with the property."
443 (message "%s" (object-name element)))
445 (defmethod cogre-left ((element cogre-graph-element) start end)
446 "Method called when the cursor exits ELEMENT.
447 START and END cover the region with the property."
451 (defmethod cogre-erase ((node cogre-node))
452 "Erase NODE from the screen."
453 (let ((position (oref node position))
454 (rectangle (cogre-node-rectangle node))
455 (links (cogre-node-links node)))
456 (cogre-erase-rectangle (aref position 0) (aref position 1)
457 (length (car rectangle))
459 (mapcar 'cogre-erase links))
462 (defmethod cogre-node-links ((node cogre-node))
463 "Return a list of links which reference NODE."
464 (with-slots (elements) cogre-graph
466 (mapcar (lambda (n) (if (and (obj-of-class-p n cogre-link)
467 (or (eq (oref n start) node)
468 (eq (oref n end) node)))
469 (setq links (cons n links))))
473 (defmethod cogre-node-rectangle ((node cogre-node))
474 "Fetch the rectangle representation for NODE."
475 (or (oref node rectangle)
476 (cogre-node-rebuild node)))
478 (defmethod cogre-render ((node cogre-node))
479 "Render NODE in the current graph."
480 (cogre-node-rectangle node)
481 (with-slots (position rectangle) node
482 (picture-goto-coordinate (aref position 0) (aref position 1))
483 (picture-insert-rectangle rectangle nil))
486 (defmethod cogre-node-rebuild ((node cogre-node))
487 "Create a new value for `:rectangle' in NODE.
488 The `:rectangle' slot is inserted with rectangle commands.
489 A Rectangle is basically a list of equal length strings.
490 Those strings must have the proper face values on them.
491 Always make the width 2 greater than the widest string."
492 (let* ((width (+ (cogre-node-widest-string node) 2))
493 (top-lines (oref node blank-lines-top))
494 (bottom-lines (oref node blank-lines-bottom))
495 (title (cogre-node-title node))
496 (slots (cogre-node-slots node))
497 (align (oref node alignment))
500 (while (> top-lines 0)
501 (setq rect (cons (cogre-string-with-face
504 (progn (setq first nil)
505 'cogre-box-first-face)
509 top-lines (1- top-lines)))
510 (setq title (nreverse title))
512 (let ((face (cond ((and first (null (cdr title)))
513 '(cogre-box-first-face cogre-box-last-face))
515 'cogre-box-first-face)
516 ((and (null (cdr title))
517 (not (and (null slots)
518 (/= bottom-lines 0))))
519 'cogre-box-last-face)
520 (t 'cogre-box-face))))
521 (setq rect (cons (cogre-string-with-face
527 (let ((sl (car slots)))
528 ;; If a subnode has nil here, make sure we put in a blank
530 (if (not sl) (setq sl (list "")))
532 (let ((face (cond ((and (= bottom-lines 0)
534 'cogre-box-last-face)
535 (t 'cogre-box-face))))
536 (setq rect (cons (cogre-string-with-face
541 (setq slots (cdr slots)))
542 (while (> bottom-lines 0)
543 (setq rect (cons (cogre-string-with-face
545 (if (= bottom-lines 1)
550 bottom-lines (1- bottom-lines)))
551 (oset node rectangle (nreverse rect))))
553 (defmethod cogre-move-delta ((node cogre-node) dx dy)
554 "Move NODE's position by DX, DY."
555 (let ((p (oref node position)))
556 (cogre-move node (+ (aref p 0) dx) (+ (aref p 1) dy))))
558 (defmethod cogre-move ((node cogre-node) x y)
559 "Move NODE to position X, Y."
560 (if (> 0 x) (setq x 0))
561 (if (> 0 y) (setq y 0))
562 (oset node position (vector x y))
565 (defmethod cogre-node-title ((node cogre-node))
566 "Return a list of strings representing the title of the NODE.
567 For example: ( \"Title\" ) or ( \"<Type>\" \"Title\" )"
568 (list (oref node object-name)))
570 (defmethod cogre-node-slots ((node cogre-node))
571 "For NODE, return a list of slot lists.
572 Slots are individual lines of text appearing in the body of a node.
573 Each list will be prefixed with a line before it."
576 (defmethod cogre-node-widest-string ((node cogre-node))
577 "Return the widest string in NODE."
578 (let ((namel (length (oref node object-name)))
579 (slots (cogre-node-slots node))
583 (setq names (car slots))
585 (if (> (length (car names)) ws)
586 (setq ws (length (car names))))
587 (setq names (cdr names)))
588 (setq slots (cdr slots)))
589 (if (> ws namel) ws namel)))
592 (defun cogre-node-horizontal-distance (node1 node2)
593 "Calculate the horizontal distance between NODE1 and NODE2.
594 This number is positive or negative, depending on the direction
596 ;; Make sure their rectangle's are up to date.
597 (cogre-node-rebuild node1)
598 (cogre-node-rebuild node2)
599 ;; Get all the details
600 (let* ((p1 (oref node1 position)) ;position vector
601 (p2 (oref node2 position))
602 (x1 (aref p1 0)) ;X,Y for NODE1
603 (x2 (aref p2 0)) ;X,Y for NODE2
606 ;; positive distance.
607 (- x2 x1 (length (car (cogre-node-rectangle node1))))
608 (- x1 x2 (length (car (cogre-node-rectangle node2))))
611 (defun cogre-node-vertical-distance (node1 node2)
612 "Calculate the vertical distance between NODE1 and NODE2.
613 This number is positive or negative, depending on the direction
615 ;; Make sure their rectangle's are up to date.
616 (cogre-node-rebuild node1)
617 (cogre-node-rebuild node2)
618 ;; Get all the details
619 (let* ((p1 (oref node1 position)) ;position vector
620 (p2 (oref node2 position))
621 (y1 (aref p1 1)) ;X,Y for NODE1
622 (y2 (aref p2 1)) ;X,Y for NODE2
625 ;; positive distance.
626 (- y2 y1 (length (cogre-node-rectangle node1)))
627 (- y1 y2 (length (cogre-node-rectangle node2)))
630 (defun cogre-choose-horizontal-link-anchors (node1 node2)
631 "Choose horizontal link anchor points between NODE1 and NODE2.
632 The data returned is (X1 Y1 X2 Y2)."
633 (let* ((p1 (oref node1 position)) ;position vector
634 (p2 (oref node2 position))
635 (x1 (aref p1 0)) ;X,Y for START
637 (x2 (aref p2 0)) ;X,Y for END
639 (r1 (cogre-node-rectangle node1)) ;rectangle text
640 (r2 (cogre-node-rectangle node2))
641 (h1 (length r1)) ;Height
643 (w1 (length (car r1))) ;Width
644 (w2 (length (car r2)))
647 (list (+ x1 w1) (+ y1 (/ h1 2)) (1- x2) (+ y2 (/ h2 2)))
648 (list (1- x1) (+ y1 (/ h1 2)) (+ x2 w2) (+ y2 (/ h2 2))))
651 (defun cogre-choose-vertical-link-anchors (node1 node2)
652 "Choose vertical link anchor points between NODE1 and NODE2.
653 The data returned is (X1 Y1 X2 Y2)."
654 (let* ((p1 (oref node1 position)) ;position vector
655 (p2 (oref node2 position))
656 (x1 (aref p1 0)) ;X,Y for START
658 (x2 (aref p2 0)) ;X,Y for END
660 (r1 (cogre-node-rectangle node1)) ;rectangle text
661 (r2 (cogre-node-rectangle node2))
662 (h1 (length r1)) ;Height
664 (w1 (length (car r1))) ;Width
665 (w2 (length (car r2)))
668 (list (+ x1 (/ w1 2)) (+ y1 h1) (+ x2 (/ w2 2)) (1- y2))
669 (list (+ x1 (/ w1 2)) (1- y1) (+ x2 (/ w2 2)) (+ y2 h2)))
674 (defmethod cogre-element-pre-serialize ((link cogre-link))
675 "Prepare the current node to be serialized.
676 Remove all pointers to objects (such as links), and replace
677 with something reversable."
679 ;; Remove the node objects from ourselves, and remove ourselves
680 ;; from the nodes we point to.
681 (with-slots (start end) link
682 (setf start (oref start :object-name))
683 (setf end (oref end :object-name))
687 (defmethod cogre-element-post-serialize ((link cogre-link))
688 "Restore object pointers in LINK after being loaded from disk.
689 Also called after a graph was saved to restore all objects.
690 Reverses `cogre-graph-pre-serialize'."
692 ;; Convert the textual names back to object references from the
693 ;; current graphs element list.
694 (with-slots (start end) link
696 (object-assoc start :object-name (oref cogre-graph elements)))
698 (object-assoc end :object-name (oref cogre-graph elements)))
702 (defvar cogre-erase-mode nil
703 "Non nil means we are in erase mode while rendering this link.")
705 (defmethod cogre-erase ((link cogre-link))
706 "Erase LINK from the screen."
707 (let ((picture-rectangle-ctl ? )
708 (picture-rectangle-ctr ? )
709 (picture-rectangle-cbl ? )
710 (picture-rectangle-cbr ? )
711 (picture-rectangle-v ? )
712 (picture-rectangle-h ? ))
713 ;; Links use picture line drawing teqnique to wander about.
714 ;; By setting the picture line characters to spaces, we can
715 ;; erase the line with the render command.
716 (let ((cogre-erase-mode t))
720 (defmethod cogre-render ((link cogre-link))
721 "Render LINK in the current graph."
722 (with-slots (start end start-glyph end-glyph) link
723 (let* ((hd (cogre-node-horizontal-distance start end))
724 (vd (cogre-node-vertical-distance start end))
728 ;; Calculate starting points in relation to our attached nodes.
729 (if (> (* hd (oref link horizontal-preference-ratio)) vd)
730 ;; In this case, the X delta is larger than the Y delta,
731 ;; so the line is going mostly left/right.
732 (setq linkcoords (cogre-choose-horizontal-link-anchors start end)
734 (setq linkcoords (cogre-choose-vertical-link-anchors start end)
736 (oset link stop-position (list (car linkcoords) (car (cdr linkcoords))))
737 ;; Now draw a rectiliniar line
738 (apply 'picture-draw-rectilinear-line
739 (append linkcoords (list dir 'face nil 'element link)))
740 ;; Handle start/end glyps.
741 (if (and (not start-glyph) (not end-glyph))
742 ;; We need to do nothing if we have no glyphs.
744 (let* (startrect endrect x1 y1 x2 y2)
745 ;; Calculate the modificates needed to the end points for
746 ;; creating the textual glyph.
747 (setq x1 (nth 0 linkcoords)
748 y1 (nth 1 linkcoords)
749 x2 (nth 2 linkcoords)
750 y2 (nth 3 linkcoords))
751 (if (eq dir 'horizontal)
754 (setq startrect (aref start-glyph 2)
755 endrect (aref end-glyph 3)
756 x2 (- x2 -1 (length (car endrect))))
757 (setq startrect (aref start-glyph 3)
758 endrect (aref end-glyph 2)
759 x1 (- x1 -1 (length (car startrect)))))
760 (setq y1 (- y1 (/ (length startrect) 2))
761 y2 (- y2 (/ (length endrect) 2))))
763 (setq startrect (aref start-glyph 0)
764 endrect (aref end-glyph 1)
765 y2 (- y2 -1 (length endrect)))
766 (setq startrect (aref start-glyph 1)
767 endrect (aref end-glyph 0)
768 y1 (- y1 -1 (length startrect))))
769 (setq x1 (- x1 (/ (length (car startrect)) 2))
770 x2 (- x2 (/ (length (car endrect)) 2))))
771 ;; Ok, splat the glyph
774 (cogre-erase-rectangle x1 y1
775 (length (car startrect))
777 (cogre-erase-rectangle x2 y2
778 (length (car endrect))
781 (picture-goto-coordinate x1 y1)
782 (picture-insert-rectangle startrect nil)
783 (picture-goto-coordinate x2 y2)
784 (picture-insert-rectangle endrect nil)
791 ;; Save and restore graphs to disk
792 (defun cogre-save-graph-as (file)
793 "Save the current graph into FILE.
794 This can change the current file assocaited with the current graph."
795 (interactive "fFile: ")
796 (oset cogre-graph file file)
797 (cogre-save cogre-graph))
799 (defun cogre-save-graph (file)
800 "Save the current graph to FILE."
802 (eieio-persistent-save-interactive cogre-graph
804 (oref cogre-graph name))))
805 (cogre-save cogre-graph))
807 (defmethod cogre-save ((graph cogre-graph))
808 "Save the current graph."
809 (cogre-map-elements 'cogre-element-pre-serialize)
811 (eieio-persistent-save cogre-graph)
812 (cogre-map-elements 'cogre-element-post-serialize))
816 (defun cogre-load-graph (file)
817 "Load a graph from FILE into a new graph buffer."
818 (interactive "fFile: ")
820 (cogre-loading-from-file t))
821 (setq graph (eieio-persistent-read file))
822 (oset graph file file)
823 (cogre (oref graph name))
824 (setq cogre-graph graph)
825 (cogre-map-elements 'cogre-element-post-serialize)
826 (cogre-render-buffer graph t)))
828 ;;; Low Level Rendering and status
831 (defun cogre-string-with-face (string face element &optional length align)
832 "Using text STRING, apply FACE to that text.
833 The string in question belongs to the graph ELEMENT.
834 If optional argument LENGTH is supplied, pad STRING on the left and
835 right so that it is centered. If optional argument ALIGN is non-nil,
836 the align the string either 'left or 'right.
837 Return the new string."
839 (let* ((preprops (copy-sequence (text-properties-at 0 string)))
840 (ws (- length (length string)))
841 (sws (cond ((not align)
842 (make-string (/ ws 2) ? ))
844 (make-string (1- ws) ? ))
849 (ews (cond ((not align)
850 (make-string (+ (/ ws 2) (% ws 2)) ? ))
852 (make-string (1- ws) ? ))
858 (let ((pm (plist-get preprops 'face)))
860 ;; We don't want to modify the face on this based
861 ;; on the first character.
862 (setq preprops (delq 'face preprops))
863 (setq preprops (delq pm preprops))))
864 (setq string (concat sws string ews))
865 (add-text-properties 0 (length string) preprops string)
867 ;; Add our faces on. Preserve previously applied faces.
869 (alter-text-property 0 (length string) 'face
870 (lambda (current-face)
872 (cond ((facep current-face)
874 ((listp current-face)
885 ;; Add on other properties.
886 (add-text-properties 0 (length string)
887 (list 'rear-nonsticky t
888 'detachable t ;; xemacs
891 ;; 'modification-hooks
894 (let ((inhibit-point-motion-hooks t))
895 (when (cogre-current-element)
896 (cogre-entered (cogre-current-element) s e))))
899 (let* ((inhibit-point-motion-hooks t)
903 (cogre-current-element))))
904 (when el (cogre-left el s e)))))
908 (defun cogre-erase-rectangle (x y width height)
909 "Clear out the rectangle at X Y, with dimensions WIDTH HEIGHT."
910 (picture-goto-coordinate x y)
911 (clear-rectangle (point)
913 (picture-goto-coordinate (+ x width)
918 (defun cogre-current-element (&optional point)
919 "Return the element under POINT."
920 (get-text-property (or point (point)) 'element))
922 (defun cogre-current-line ()
923 "Get the current line."
924 (cond ((eq (point-min) (point))
926 (t (1- (count-lines (point-min) (point))))))
930 ;;; cogre.el ends here