[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]


From: Joe Corneli
Subject: todl-mode.el
Date: Wed, 07 Apr 2004 22:31:26 -0500

A while ago, I brought up the idea for a mode for editing everything
as lists on emacs-devel.  Here how I've begun.

;;; todl-mode.el --- Major mode for editing and browsing TODL.

;; Copyright (C) 2004 Joe Corneli  <address@hidden>

;; Time-stamp: <jac -- Wed Apr  7 21:22:43 CDT 2004>

;; This file is not part of GNU Emacs, but it is distributed under
;; the same terms as GNU Emacs.

;; GNU Emacs 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 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Documentation of TODL is available on the web at
;; Some comments for on how you can set up Emacs to use this mode
;; follow.
;; You can put this file in a directory called ~/site-lisp/ and add
;; these lines to your .emacs:
;; (add-to-list 'load-path "~/site-lisp/")
;; (load "todl-mode")
;; Files with the .todl suffix or a "-*- Mode: Todl -*-" string in the
;; first line will then be loaded in TODL mode. You can also switch
;; into TODL mode with the command M-x todl-mode.

;;; Code:

;; TODO: (1) consider making this a minor mode that can run inside
;;           emacs-wiki or other modes
;;       (2) semantics

(defvar todl-mode-hook nil)

(defvar todl-mode-map
  (let ((todl-mode-map (make-keymap)))
    (define-key todl-mode-map "\C-o" 'todl-insert-node)
    (define-key todl-mode-map "\M-o" 'todl-insert-edge)
    (define-key todl-mode-map "\C-\M-o" 'todl-insert-top-level-node)
    ;; I thought about binding to RET, but it is nice to save it
    ;; for doing character-level editing
    (define-key todl-mode-map "\C-c\C-c" 'todl-open-node)
    (define-key todl-mode-map "\C-cw" 'todl-toggle-narrowing)
    (define-key todl-mode-map "\C-cp" 'todl-scroll-history-backwards)
    (define-key todl-mode-map "\C-cn" 'todl-scroll-history-forwards)
    (define-key todl-mode-map "\C-cm" 'todl-markup-list)
  "Keymap for TODL major mode")

(add-to-list 'auto-mode-alist '("\\.todl\\'" . todl-mode))

;; Font lock is inessential for todl.  At some point we might add
;; some font lock features to fontify the string "Top-level node:"
;; and to fontify edge labels.  There are more comments on this
;; topic in the user manual and development notes.

;; at some point, more customizations to the syntax table might be done.
(defvar todl-mode-syntax-table
  (let ((todl-mode-syntax-table text-mode-syntax-table))

;;; User-level variables

(defvar todl-keep-narrowed nil 
"This will determine whether you see all the definitions in the
current buffer, or just the current one. Toggle with

(defvar todl-pub-directory "~/WebTodl/"
"Directory in which to save documents when exporting to html.")

; "Top-level node: " -- maybe this string should be readily configurable?

;;; History support (loosely modeled on history support in Info)

;; The function `todl-scroll-history-backwards' lets us move back
;; in time. Functions for moving to new nodes should maintain the
;; historical record appropriately by checking to see whether we
;; are coming back along the same historical development when we
;; move next time.  If progression is like this:

;;        (A) B C -- A (B) C -- A B (C) -- A (B) C -- A B (C)

;; simply set the history offset to zero. However if development is
;; like this:

;;        (A) B C -- A (B) C -- A B (C) -- A (B) C -- A B C (D)

;; then history should become A B D, i.e. we forget we ever visited
;; C.  The function `todl-scroll-history-forwards' just moves us
;; forward in time.

;; Functions outside of this section that have an effect on the
;; history are: `todl-get-node' and `todl-insert-top-level-node'
;; (which call the function `todl-maybe-revise-history' every time
;; they are used) and `todl-open-node' (which calls the function
;; `todl-revise-history' the first time a node is opened, so we can
;; get the starting node into the history list).

;; TODO: (1) extend this to work on multiple files (like info)
;;       (2) write an interface that will show the someplace
;;           useful
;;       (3) an "advanced" feature would be to change the way
;;           history is handled to be aware of different branches -
;;           so you could go "forward" in several directions
;;           (compare `pop-to-buffer')
;;       (4) the way we deal with history should be modified to deal
;;           with "drift" that happens when the user moves around
;;           the buffer using the normal editing functions

;; If we are only going to be working with single buffer KB's, this
;; should probably be a local variable. But since in fact I'm
;; planning to extend the mode to work with multi-buffer KB's
;; pretty soon, I'm not going to worry about that.
(defvar todl-history nil
  "List of todl nodes user has visited.
Each element of list is a list (NODENAME BUFFERPOS).")

(defvar todl-history-offset 0
  "Units of time back in history.")

(defun todl-history-record-current-node ()
  (setq todl-history
        (cons (list (todl-grab-current-node-name) (point))

(defun todl-history-record-current-node-from-name (node-name)
  (setq todl-history
        (cons (list node-name (point))

(defun todl-scroll-history-backwards ()
  "Move one node backwards in time (as long as we aren't at the
first node)."
  (if (not (eq todl-history-offset (length todl-history)))
        (setq todl-history-offset (1+ todl-history-offset))
        (let ((record (nth todl-history-offset todl-history)))
          ;; the function we call can not change the history!
          (todl-get-node (car record) (cadr record) 1))
        (if todl-keep-narrowed
    (message "You are at the first visited node.")))

(defun todl-scroll-history-forwards ()
  "Move one node forwards in time (as long as we aren't at the
last node)."
  (if (> todl-history-offset 0)
        (setq todl-history-offset (1- todl-history-offset))
        (let ((record (nth todl-history-offset todl-history)))
          ;; the function we call can not change the history!
          (todl-get-node (car record) (cadr record) 1))
        (if todl-keep-narrowed
    (message "You are at the most recently visited node.")))

;; this might need more than just the node position.
(defun todl-revise-history (new-node-name new-node-position)
  (setq todl-history
        (cons (list new-node-name new-node-position)
              (nthcdr todl-history-offset todl-history)))
  (setq todl-history-offset 0))

(defun todl-maybe-revise-history (node-name new-node-position)
  (if (and (> todl-history-offset 0)
           (eq node-name (cadr (nth (1- todl-history-offset) todl-history))))
      ;; a little bit of history repeating itself
      (setq todl-history-offset (1- todl-history-offset))
    ;; we have for the first time in all history created a garden
    ;; of pure ideology
    (todl-revise-history node-name new-node-position)))

(defun todl-clear-history ()
  (setq todl-history nil))

;;; Main functions

;; List-building functions are separated into two hierarchies: the
;; `create' hierachy and the `insert' hierarchy. (Later perhaps to
;; be complemented by `destroy' and `remove' hierarchies.)

;; `create' functions are internal "utility functions" `insert'
;; functions are user commands (or functions requiring user input)

;; The idea of `provenance' is a very important in "advanced" TODL.
;; We want to keep track of lots of different things. Time stamps
;; and usernames are just two of these things.  It will also be
;; important to keep of back-and-forth links.  If we link to B from
;; A, B should contain a backlink to A (and this backlink should
;; have its own documentation). Many of these things should be
;; hidden from the user in day-to-day operation.

(defun todl-toggle-narrowing ()
  (setq todl-keep-narrowed (not todl-keep-narrowed))
  (if todl-keep-narrowed

;; (1) nodes should only be inserted at the far end of edges, I
;; think!  so this function should make sure that we are really
;; capable of inserting a node.  If not, it should either give an
;; error, or prompt the user to supply an edge label instead
(defun todl-insert-node ()
  "Add a node that neighbors the current node."
  (if ;; this check should be stronger (1)

(defun todl-create-node ()
  ;;The following seems to work.
  (newline 1)
  (insert "    "))

;; Perhaps in contrast to nodes, we may want to enter edges in
;; using the minibuffer.  In general, it would be more BBDB-like to
;; enter everything using the minibuffer, and more casual to enter
;; everything right in the buffer itself.  We might want to
;; experiment with both "feels". Hence the code should be written
;; in such way as to be open to substituting different ways of
;; retreiving/entering text.  Sometimes someone might want to
;; create a node (or edge) from a string originating somewhere
;; else, so we should make a function (or at least room for a
;; function) for that too.  We might *not* want to input new
;; top-level nodenames from the minibuffer - maybe everything
;; should be input directly from the buffer itself.  However, we
;; would like to make *sure* that people actually do input things
;; when they say they are going to.  It isn't a particularly good
;; idea to have dangling edges pointing nowhere.  At least... I
;; don't think so.  It might not be as bad as all that, though.  On
;; the other hand, one thing that we will need to be a bit careful
;; about is the topic of trailing whitespace.  I guess it would be
;; OK to have trailing whitespace as part of a node/edge name, but
;; it would be a bit weird.

(defun todl-insert-edge ()
  "Add an edge going out from the current node."
  (if (todl-inside-list-p)
    ;; instead of being so rigid we might allow the user to specify
    ;; a top-level node (using autocompletion?) and then supply an
    ;; edge name going out from that edge.  These sorts of commands
    ;; might later be used from outside of TODL (sort of like the
    ;; "remember" functionality, I'm guessing).
    (message "Your cursor should be inside a list to create an edge.")))

(defun todl-create-edge ()
  ;; see comments on `todl-create-internal-node'.  Note that both
  ;; these functions could call a lower-level utility function for
  ;; inserting spaces.
  (newline 1)
  (insert "  "))

;; it isn't clear to me whether this should work if we are simply
;; inside a node or only if we are at the end of an edge radiating
;; out from a node (i.e. in the 4-space indented part of a node).
(defun todl-inside-list-p ()
  "This is the test to use to decide whether we are in the right
  place to insert a node."
  ;; clearly, if we actually want to use this function, it should
  ;; be fixed

;; nodes and edges are assumed to have labels that begin with
;; something other than space this is just me being strict for some
;; unknown reason

;; I'm adding the possibility of starting a line with a `*'.  This
;; is supposed to be used by TODL to indicate which nodes are
;; actually linked to.

(defun todl-on-node-p ()
  "This is the test to use to decide whether we are sitting on a
  (save-excursion (beginning-of-line)
                  (looking-at "[* ]   [^ ]")))

;; For now `*' is used here as well - maybe `#' should be used
;; instead to set things off visually. Note that you currently
;; can't link from an edge, this should be changed later.
(defun todl-on-edge-p ()
  "This is the test to use to decide whether we are sitting on an
  (save-excursion (beginning-of-line)
                  (looking-at "[* ] [^ ]")))

(defun todl-create-new-top-level-node (new-node-name)
  (goto-char (point-max))
  (newline 1)
  (insert (concat "Top-level node: " new-node-name))
  (backward-char 1)
  (todl-maybe-revise-history new-node-name (point))
  (if todl-keep-narrowed

;; I'm not entirely sure how we are going to make sure we avoid
;; duplicates.  But we *should* avoid duplicates. Probably
;; following the general strategy of `todl-open-node' and
;; `todl-visit-or-create'.
(defun todl-insert-top-level-node ()
  (let ((new-node-name (read-string "New Top-level node: ")))
    (todl-create-new-top-level-node new-node-name)))

;; this thing is only called if we know we are on a node
(defun todl-grab-current-node-name ()
  "Get the buffer substring that labels the node we are looking at.
To grab the name of the node we are sitting on, use 
  (save-excursion (beginning-of-line)
                  (forward-char 4)
                  (let ((beg (point))
                        (end (save-excursion (end-of-line)
                    (buffer-substring beg end))))

(defun todl-grab-current-list-name ()
  "Get the buffer substring that labels the list we are in."
  (save-excursion (end-of-line)
                  (search-backward-regexp "\\(Top-level node: \\)\\(.*\\)" nil 
                  (match-string 2)))

;; Checking whether a node exists (in general) seems to require
;; maintaining a lot of state.  Maybe we should use something like
;; in HOWM to be able to navigate between nodes that are in
;; different files and other far-flung locations.  Actually, since
;; HOWM just uses grep, this is sort of trivial (and not elegant).
;; For working with just one file, a very simple is way to go would
;; be to just to search for the node-name in the file (like HOWM
;; does).  I should actually take a look at the HOWM code at some
;; point to see more of how they do things.

(defun todl-find-node (node-name)
  "Utility function for getting the position of a node from its name."
  (save-restriction (widen)
  (save-excursion (goto-char (point-min))
     (search-forward (concat "Top-level node: " node-name) nil t))))

;; (1) This is pretty good, but it assumes that we are working with
;;     one buffer.  We should change the functions `todl-find-node'
;;     and `todl-goto-node' to work across several buffers.
;; (2) Probably `todl-open-node' should mark the node, but if this
;;     proves to be a problem the behavior can be changed.

(defun todl-open-node ()
  "This is the command that is used to follow a node to its
definition or to create a new definition if none exists."
  ;; make sure we are on a node in reality, if we aren't, there
  ;; should probably be a message to that effect
  (if (todl-on-node-p)
      ;; grab the current nodename and see if this node has been
      ;; developed
      (let* ((node-name (todl-grab-current-node-name))
             (new-point (todl-find-node node-name)))
        ;; if this is the first time we are opening a node
        ;; (evidenced by the history being nil), we should add
        ;; ourself to the history list.
        (if (not todl-history)
            (todl-revise-history (todl-grab-current-list-name)
        ;; For overview, see (2) above.  I'm commenting out the
        ;; conditional for working with "legacy" lists that aren't
        ;; marked up propertly.
        ;;;(if (not new-point)
            (todl-adjust-leading-char " " "*")
        (todl-visit-or-create node-name new-point)
        (if todl-keep-narrowed

(defun todl-get-node (node-name new-point &optional no-update)
  "Move to the new node, updating history if necessary."
  (if (not no-update)
      (todl-maybe-revise-history node-name new-point))
  (goto-char new-point))

(defun todl-visit-or-create (node-name new-point)
  "Decide whether to get an existing node or create a new one.  This
function will create a new node iff NEW-POINT is nil."
  ;; if node exists, go to it
  (if new-point
      (todl-get-node node-name new-point)
    ;; if it does not exist, create it
    (todl-create-new-top-level-node node-name)))

;; Probably this function should make use of autocompletion! Do we
;; need to keep a separate list of all extant nodes, or can we
;; somehow pick this up IRT?  There is no particular reason _not_
;; to keep a list of all extant nodes someplace inside the buffer,
;; especially since such a list might be helpful to the user.  On
;; wonders whether there would be any way for the user to modify
;; this list (is there a way to make parts of a buffer read-only?)
(defun todl-goto-node (node-name)
  "This command lets you select a node by name."
  (interactive "MGoto node: ")
  (let ((new-point (todl-find-node node-name)))
    (todl-visit-or-create node-name new-point)))

(defun todl-narrow-to-current-list ()
  ;; in reality, maybe this function shouldn't be interactive 
  (save-excursion (end-of-line) 
                  (search-backward "Top-level node:" nil t)
                  (let ((beg (save-excursion (beginning-of-line)
                        (end (save-excursion (search-forward-regexp "^$")
                    (narrow-to-region beg end))))

;; And I still need to write the `generate index' function.

(defun todl-generate-index ()

;;; Markup functions

;; I still need to implement some way of continually marking up as
;; you go along.  The basic problem is that you can't always assume
;; that a node that opened will not be abandoned.

(defun todl-markup-node ()
  "This function is used to mark up a node according to whether or not it has
been developed."
  (if (todl-on-node-p)
      ;; grab the current nodename and see if this node has been
      ;; developed note that the next three lines or so could be
      ;; refactored into a function
      ;; `location-of-development-of-this-node' which would return
      ;; the location or nil if the node has not been developed
      (let* ((node-name (todl-grab-current-node-name))
             (new-point (todl-find-node node-name)))
        (if new-point
            (todl-adjust-leading-char " " "*")
          (todl-adjust-leading-char "*" " ")))))

(defun todl-adjust-leading-char (reg rep)
  "A basic utility function for changing the first character in a
line. Expects REG and REP to be strings of length one."
  (save-excursion (beginning-of-line)
                  (if (looking-at reg)
                        (delete-char 1)
                        (insert rep)))))

(defun todl-markup-buffer ()
  "This function is used to mark up all the nodes in a buffer
according to whether or not they have been developed."
  (save-restriction (widen)
                    (save-excursion (goto-char (point-min))
                                    (re-search-forward "^" nil t)
                                    (next-line 1)))))

;; bug: this function frequently needs to be called twice for it to
;; take effect
(defun todl-markup-list ()
  "This function is used to mark up all the nodes in a list
according to whether or not they have been developed."
  (save-restriction (todl-narrow-to-current-list)
                    (save-excursion (goto-char (point-min))
                                    (re-search-forward "^" nil t)
                                    (next-line 1)))))

(defun todl-unmarkup-buffer ()
  "This function is used to unmark all the nodes in a buffer
regardless of whether or not they have been developed."
  (save-restriction (widen)
                    (save-excursion (goto-char (point-min))
                                    (re-search-forward "^" nil t)
                                    (if (looking-at "*")
                                        (save-excursion (delete-char 1)
                                                        (insert " ")))
                                    (next-line 1)))))

;;; Exporting

(defun todl-on-link-p ()
  "This is the test to use to decide whether we are sitting on a link."
  (save-excursion (beginning-of-line)
                  (looking-at "*   ")))

(defun todl-to-html ()
  "Create a page <todlname>:<nodename>.html for each node in this todl."
  (let* ((current-buffer (buffer-name))
         (todlname (replace-regexp-in-string "\\.todl$" "" current-buffer)))
        (save-restriction          (widen)
        (save-excursion            (goto-char (point-min))
        (while (re-search-forward "^Top-level node:" nil t)
       (let* ((nodetext (buffer-substring (point-min) (point-max)))
              (nodename (todl-grab-current-list-name))
              (pub-filename (concat todlname "--" 
                                    (todl-markup-text-for-html nodename) 
       (set-buffer (get-buffer-create pub-filename))
       (kill-region (point-min) (point-max))
       (goto-char (point-min))
        ;; this is a somewhat obscure way of getting rid of "Top-level node".
        (replace-regexp-in-string "^Top-level node: .*\n"
                                  (concat "<!-- This page was created with TODL 
<title>" todlname ":" nodename "</title>
<H3><b>" nodename "</b></H3>") nodetext))
       (goto-char (point-min))
       (search-forward "</H3>")
       (todl-html-markup-engine todlname)
       ;; write and close html buffer
       (write-file (concat todl-pub-directory pub-filename))
       (kill-buffer (current-buffer))
       (set-buffer (get-buffer current-buffer))

(defun todl-do-forall-lists (&rest args)
  "This function runs its arguments on each of the nodes separately."
  ;; I think there is a problem with the save-excursion stuff
  (save-restriction (widen)
                    (save-excursion (goto-char (point-min))
                                    (while (re-search-forward "^Top-level 
node:" nil t)
                                      (goto-char (point-min))
                                      ;; just in case you are still at 
(point-min), run this

(defun todl-html-markup-engine (todlname)
  ;; these variables keep track of what kind of thing we are
  ;; looking at and/or were just looking at
  (let ((edgep nil)
        (nodep nil))
    (while (and (not (eobp))
                (re-search-forward "^" nil t))
      ;; edge case
      (cond ((looking-at "^\\(  \\)\\([^ ].*\\)")
             ;; if we are just starting out, begin a list
             (cond ((and (not edgep)
                         (not nodep))
                    (replace-match "<ul>\n<li>\\2"))
                   ;; if we were just looking at a node, end a list
                   ;; of nodes, and add what we are looking at to
                   ;; the list of edges
                    (replace-match " </ul>\n<li>\\2"))
                   ;; if we are looking at another edge, just add
                   ;; to the list
                    (replace-match "<li>\\2")))
             ;; update log
             (setq edgep t)
             (setq nodep nil))
            ;; node case
            ((looking-at "^\\(    \\)\\([^ ].*\\)")
             ;; if we are just starting out, begin a list
            (cond ((and (not edgep)
                        (not nodep))
                   (replace-match " <ul>\n <li>\\2"))
                  ;; if we were just looking at a node and add what
                  ;; we are looking at to the list of nodes
                   (replace-match " <li>\\2"))
                  ;; if we were looking at an edge, similarly, add
                  ;; to the list of nodes
                   (replace-match " <ul>\n <li>\\2")))
            ;; update log
            (setq edgep nil)
            (setq nodep t))
            ;; this is like the case just above, but with URL text
            ;; to deal with
            ((looking-at "^\\(*   \\)\\([^ ].*\\)")
            (let* ((str (buffer-substring (match-beginning 2) (match-end 2)))
                   (url (concat "<a href=\"./"
                                (replace-regexp-in-string " " "_" str)
              (cond ((and (not edgep)
                          (not nodep))
                     (replace-match (concat " <ul>\n <li>" url "\\2</a><br>")))
                     (replace-match (concat " <li>" url "\\2</a><br>")))
                     (replace-match (concat " <ul>\n <li>" url 
            (setq edgep nil)
            (setq nodep t))
            (insert " </ul>\n</ul>"))))))

;; this should eventually contain some other useful rewritings. For now, I'm not
;; even using it.
(defun todl-markup-text-for-html (str)
  (replace-regexp-in-string " " "_" str))

;;; Conclusion

(defun todl-mode ()
  "Major mode for editing TODL.
Entry to this mode calls the value of `todl-mode-hook'
if that value is non-nil."
  (set-syntax-table todl-mode-syntax-table)
  (use-local-map todl-mode-map)
  (setq major-mode 'todl-mode)
  ;; this makes sure we are inserting spaces (not tabs) when
  ;; pressing TAB (important for regexp matching used in this
  ;; mode).
  (set (make-local-variable 'indent-tabs-mode) nil)
;  (set (make-local-variable 'font-lock-defaults)
;  '(todl-font-lock-keywords))
  (setq major-mode 'todl-mode)
  (setq mode-name "Todl")
  ;; run hook before beginning
  (run-hooks 'todl-mode-hook))

(provide 'todl-mode)

;;; end of todl-mode.el

reply via email to

[Prev in Thread] Current Thread [Next in Thread]