tools for GNU Emacs as application framework

[Tom Lord]

After many years of planning and (one can only assume) careful design
work, the latest releases of GNU Emacs have gained (finally!) some
fancy display capabilities (like images and variable width fonts).

Hard-core emacs users are quite used to using Emacs as a generic
"application framework" -- using it to build quasi-graphical user
interfaces to various programs.  But now we can do that for "regular
users" who expect a truly graphical display instead of a text-based
one.  Really, I think Gnome and KDE advocates ought to think about
this a bit.... not that Emacs now obsoletes those toolkits, but that
there are many applications that might be simpler to do well in Emacs
lisp.

One new need for Emacs lisp programmers is a good "widget toolkit" --
tools to make fancy user interfaces easier to build.

In that spirit, I've implemented _Etalk_: a package that extends
Emacs Lisp with:

        *) generic functions

        *) message passing

        *) mixin-classes of first-class objects which are
           externalizable (printable/readable) and which
           have a natural isomorphism to XML nodes

I've started building a widget kit on top of this, but for today, I'm
going to release just _Etalk_, the language infrastructure.  I'm
curious to see what, if anything, other Emacs lisp programmers might
do with it.

This release of etalk is, as with the release of monkey a few days
ago, part of a fundraising effort at www.regexps.com.

The full documentation for etalk is included with the (GPL'ed, of
course) source.  Appended is a code fragment (from the definition of
the class "View" that I'm working on) that might give you a sense of
what Etalk is like.

-t


(use-class 'Model)


(@ Meta 'new 'View

   "A class for buffer widgets.

A buffer widget is responsible for some of the text within a buffer.
It uses that text to render a user interface."

   '(

     (init (this model format-list)
           (@ this '(put marker) (make-marker))
           (@ this '(put model) model)
           (@ this '(put format-list) format-list)
           (@ this '(put unique-tag) (make-symbol "View" t))
           (@ model 'add-view this)
           this)


     (model (this)
            "Return the model displayed by this view."
            (@ this '(get model)))


     (buffer (this)
             "Return the buffer in which this view renders (or nil)."
             (marker-buffer (@ this '(get marker))))


     (render (this position &optional buffer insert-fn)
             "Render this view at a given location, moving it if necessary."

             (let ((format      (@ this '(get format-list)))
                   (model       (@ this '(get model)))
                   (strings     ())
                   (props       (list (@ this '(get unique-tag)) (@ (@ this 
'class) 'name))))

               (while format
                 (let ((f       (car format)))
                   (setq format (cdr format))
                   (cond
                    ((stringp f)        (setq strings (cons f strings)))
                    (t                  (let ((v (@ model f)))
                                          (cond
                                           ((stringp v)         v)
                                           (t                   
(prin1-to-string v))))))))

               (let ((str       (apply concat (reverse strings)))
                     (marker    (@ this '(get marker))))

                 (if (marker-buffer marker)
                     (@ this 'remove))

                 (save-excursion
                   (set-buffer (or buffer (current-buffer)))
                   (goto-char position)
                   (set-marker marker position)
                   (@ this '(set insert-fn) insert-fn)
                   (funcall insert-fn (vector str 0 (length str)
                   props))))))



     (update (this)
             "The model for this view has changed state.  Update the view's 
appearence."
             (let* ((marker     (@ this '(get marker)))
                    (buf        (marker-buffer marker))
                    (pos        (marker-position marker)))

               (and buf
                    (progn (@ this 'remove)
                           (@ this 'render pos buf (@ this '(get 
insert-fn)))))))
                    


     (remove (this)
             "Unrender this view - making it so that it is not currently 
visible."
             (let ((marker      (@ this '(get marker)))
                   (tag         (@ this '(get unique-tag))))

               (and (marker-buffer marker)
                    (save-excursion
                      (set-buffer (marker-buffer marker))
                      (goto-char (marker-position marker))
                      (let ((prop-here          (get-text-property (point) tag))
                            (prop-change        (next-single-property-change 
(point) tag)))
                        (if prop-here
                            (delete-region (point) (or prop-change 
(point-max))))
                        (set-marker marker nil nil))))))


     (contains-p (this start &optional end buffer)
             "Return true if this view contains the region START..END in 
BUFFER."
             (let ((marker      (@ this '(get marker)))
                   (tag         (@ this '(get unique-tag)))
                   (end         (or end (1+ start)))
                   (buffer      (or buffer (current-buffer))))

               (and (> end start)
                    (eq (marker-buffer marker) buffer)
                    (>= start (marker-position marker))
                    (<= end (or (next-single-property-change start tag buffer) 
(1+ end))))))


     ))