comparison lisp/emacs-lisp/ewoc.el @ 71006:103ed71d4639

(ewoc): Add member `hf-pp' to this structure. (ewoc--wrap): New func. (ewoc-create): Take additional arg NOSEP. If nil, wrap node and header/footer pretty-printers. Save header/footer pretty-printer. (ewoc-set-hf): Use ewoc's header/footer pretty-printer.

71005:1755e59e9a8a

;; Texinfo manual.

;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
;; you find all the exported functions:
;;
;; (defun ewoc-create (pretty-printer &optional header footer)
;; (defalias 'ewoc-data 'ewoc--node-data)
;; (defun ewoc-set-data (node data)
;; (defun ewoc-location (node)
;; (defun ewoc-enter-first (ewoc data)
;; (defun ewoc-enter-last (ewoc data)

(defstruct (ewoc
	    (:constructor nil)
	    (:constructor ewoc--create (buffer pretty-printer dll))
	    (:conc-name ewoc--))
  buffer pretty-printer header footer dll last-node)

(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
  "Execute FORMS with ewoc--buffer selected as current buffer,
`ewoc--current-dll' bound to the dll, and VARLIST bound as in a let*.
`ewoc--current-dll' will be bound when VARLIST is initialized, but

    (delete-region m (ewoc--node-start-marker R))
    ;; Calculate and insert the string.
    (goto-char m)
    (funcall pp (ewoc--node-data node))
    (ewoc--adjust m (point) R)))

;;; ===========================================================================
;;;                  Public members of the Ewoc package

;;;###autoload
(defun ewoc-create (pretty-printer &optional header footer)
  "Create an empty ewoc.

The ewoc will be inserted in the current buffer at the current position.

PRETTY-PRINTER should be a function that takes one argument, an

several lines.  The PRETTY-PRINTER should use `insert', and not
`insert-before-markers'.

Optional second and third arguments HEADER and FOOTER are strings,
possibly empty, that will always be present at the top and bottom,
respectively, of the ewoc."
  (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))
         (dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
                     (setf (ewoc--node-left dummy-node) dummy-node)
                     dummy-node))
         (new-ewoc (ewoc--create (current-buffer)
                                 pretty-printer
                                 dll))
         (pos (point))
         head foot)
    (ewoc--set-buffer-bind-dll new-ewoc
      ;; Set default values
      (unless header (setq header ""))
      (unless footer (setq footer ""))
      (setf (ewoc--node-start-marker dll) (copy-marker pos)
            foot (ewoc--insert-new-node  dll footer 'insert)
            head (ewoc--insert-new-node foot header 'insert)
            (ewoc--footer new-ewoc) foot
            (ewoc--header new-ewoc) head))
    ;; Return the ewoc
    new-ewoc))

(defun ewoc-set-hf (ewoc header footer)
  "Set the HEADER and FOOTER of EWOC."
  (ewoc--set-buffer-bind-dll-let* ewoc
      ((head (ewoc--header ewoc))
       (foot (ewoc--footer ewoc)))
    (setf (ewoc--node-data head) header
          (ewoc--node-data foot) footer)
    (save-excursion
      (ewoc--refresh-node 'insert head)
      (ewoc--refresh-node 'insert foot))))


(provide 'ewoc)

;;; Local Variables:

71006:103ed71d4639

;; Texinfo manual.

;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
;; you find all the exported functions:
;;
;; (defun ewoc-create (pretty-printer &optional header footer nosep)
;; (defalias 'ewoc-data 'ewoc--node-data)
;; (defun ewoc-set-data (node data)
;; (defun ewoc-location (node)
;; (defun ewoc-enter-first (ewoc data)
;; (defun ewoc-enter-last (ewoc data)

(defstruct (ewoc
	    (:constructor nil)
	    (:constructor ewoc--create (buffer pretty-printer dll))
	    (:conc-name ewoc--))
  buffer pretty-printer header footer dll last-node hf-pp)

(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
  "Execute FORMS with ewoc--buffer selected as current buffer,
`ewoc--current-dll' bound to the dll, and VARLIST bound as in a let*.
`ewoc--current-dll' will be bound when VARLIST is initialized, but

    (delete-region m (ewoc--node-start-marker R))
    ;; Calculate and insert the string.
    (goto-char m)
    (funcall pp (ewoc--node-data node))
    (ewoc--adjust m (point) R)))

(defun ewoc--wrap (func)
  (lexical-let ((ewoc--user-pp func))
    (lambda (data)
      (funcall ewoc--user-pp data)
      (insert "\n"))))


;;; ===========================================================================
;;;                  Public members of the Ewoc package

;;;###autoload
(defun ewoc-create (pretty-printer &optional header footer nosep)
  "Create an empty ewoc.

The ewoc will be inserted in the current buffer at the current position.

PRETTY-PRINTER should be a function that takes one argument, an

several lines.  The PRETTY-PRINTER should use `insert', and not
`insert-before-markers'.

Optional second and third arguments HEADER and FOOTER are strings,
possibly empty, that will always be present at the top and bottom,
respectively, of the ewoc.

Normally, a newline is automatically inserted after the header,
the footer and every node's printed representation.  Optional
fourth arg NOSEP non-nil inhibits this."
  (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST))
         (dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
                     (setf (ewoc--node-left dummy-node) dummy-node)
                     dummy-node))
         (wrap (if nosep 'identity 'ewoc--wrap))
         (new-ewoc (ewoc--create (current-buffer)
                                 (funcall wrap pretty-printer)
                                 dll))
         (hf-pp (funcall wrap 'insert))
         (pos (point))
         head foot)
    (ewoc--set-buffer-bind-dll new-ewoc
      ;; Set default values
      (unless header (setq header ""))
      (unless footer (setq footer ""))
      (setf (ewoc--node-start-marker dll) (copy-marker pos)
            foot (ewoc--insert-new-node  dll footer hf-pp)
            head (ewoc--insert-new-node foot header hf-pp)
            (ewoc--hf-pp new-ewoc) hf-pp
            (ewoc--footer new-ewoc) foot
            (ewoc--header new-ewoc) head))
    ;; Return the ewoc
    new-ewoc))

(defun ewoc-set-hf (ewoc header footer)
  "Set the HEADER and FOOTER of EWOC."
  (ewoc--set-buffer-bind-dll-let* ewoc
      ((head (ewoc--header ewoc))
       (foot (ewoc--footer ewoc))
       (hf-pp (ewoc--hf-pp ewoc)))
    (setf (ewoc--node-data head) header
          (ewoc--node-data foot) footer)
    (save-excursion
      (ewoc--refresh-node hf-pp head)
      (ewoc--refresh-node hf-pp foot))))


(provide 'ewoc)

;;; Local Variables: