[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
todl-mode.el
|
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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; 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
;;
;; http://www.ma.utexas.edu/~jcorneli/y/todl/
;;
;; 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)
todl-mode-map)
"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))
todl-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
`todl-toggle-narrowing'.")
(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))
todl-history)))
(defun todl-history-record-current-node-from-name (node-name)
(setq todl-history
(cons (list node-name (point))
todl-history)))
(defun todl-scroll-history-backwards ()
"Move one node backwards in time (as long as we aren't at the
first node)."
(interactive)
(if (not (eq todl-history-offset (length todl-history)))
(progn
(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
(todl-narrow-to-current-list)))
(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)."
(interactive)
(if (> todl-history-offset 0)
(progn
(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
(todl-narrow-to-current-list)))
(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 ()
(interactive)
(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 ()
(interactive)
(setq todl-keep-narrowed (not todl-keep-narrowed))
(if todl-keep-narrowed
(todl-narrow-to-current-list)
(widen)))
;; (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."
(interactive)
(if ;; this check should be stronger (1)
(todl-inside-list-p)
(todl-create-node)
(todl-insert-top-level-node)))
(defun todl-create-node ()
;;The following seems to work.
(end-of-line)
(newline 1)
(delete-horizontal-space)
(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."
(interactive)
(if (todl-inside-list-p)
(todl-create-edge)
;; 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.
(end-of-line)
(newline 1)
(delete-horizontal-space)
(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
t)
;; 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
node."
(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
edge."
(save-excursion (beginning-of-line)
(looking-at "[* ] [^ ]")))
(defun todl-create-new-top-level-node (new-node-name)
(goto-char (point-max))
(delete-blank-lines)
(newline 1)
(delete-horizontal-space)
(insert (concat "Top-level node: " new-node-name))
(delete-blank-lines)
(newline)
(backward-char 1)
(todl-maybe-revise-history new-node-name (point))
(if todl-keep-narrowed
(todl-narrow-to-current-list)))
;; 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 ()
(interactive)
(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
`todl-grab-current-list-name'."
(save-excursion (beginning-of-line)
(forward-char 4)
(let ((beg (point))
(end (save-excursion (end-of-line)
(point))))
(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
t)
(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."
(interactive)
;; 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)
(point)))
;; 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
(todl-narrow-to-current-list)))))
(defun todl-get-node (node-name new-point &optional no-update)
"Move to the new node, updating history if necessary."
(widen)
(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
(interactive)
(save-excursion (end-of-line)
(search-backward "Top-level node:" nil t)
(let ((beg (save-excursion (beginning-of-line)
(point)))
(end (save-excursion (search-forward-regexp "^$")
(point))))
(narrow-to-region beg end))))
;; And I still need to write the `generate index' function.
(defun todl-generate-index ()
(interactive)
(todl-insert-top-level-node))
;;; 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)
(progn
(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."
(interactive)
(save-restriction (widen)
(save-excursion (goto-char (point-min))
(while
(re-search-forward "^" nil t)
(todl-markup-node)
(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."
(interactive)
(save-restriction (todl-narrow-to-current-list)
(save-excursion (goto-char (point-min))
(while
(re-search-forward "^" nil t)
(todl-markup-node)
(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."
(interactive)
(save-restriction (widen)
(save-excursion (goto-char (point-min))
(while
(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."
(interactive)
(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)
(todl-narrow-to-current-list)
(let* ((nodetext (buffer-substring (point-min) (point-max)))
(nodename (todl-grab-current-list-name))
(pub-filename (concat todlname "--"
(todl-markup-text-for-html nodename)
".html")))
(set-buffer (get-buffer-create pub-filename))
(widen)
(kill-region (point-min) (point-max))
(goto-char (point-min))
(insert
;; 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
-->
<html>
<head>
<title>" todlname ":" nodename "</title>
</head>
<H3><b>" nodename "</b></H3>") nodetext))
(goto-char (point-min))
(search-forward "</H3>")
(newline)
(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))
(widen)
))))))
(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)
(todl-narrow-to-current-list)
(goto-char (point-min))
args
;; just in case you are still at
(point-min), run this
(end-of-line)
(widen)))))
(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
(nodep
(replace-match " </ul>\n<li>\\2"))
;; if we are looking at another edge, just add
;; to the list
(edgep
(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
(nodep
(replace-match " <li>\\2"))
;; if we were looking at an edge, similarly, add
;; to the list of nodes
(edgep
(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=\"./"
todlname
"--"
(replace-regexp-in-string " " "_" str)
".html\">")))
(cond ((and (not edgep)
(not nodep))
(replace-match (concat " <ul>\n <li>" url "\\2</a><br>")))
(nodep
(replace-match (concat " <li>" url "\\2</a><br>")))
(edgep
(replace-match (concat " <ul>\n <li>" url
"\\2</a><br>")))))
(setq edgep nil)
(setq nodep t))
(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.
Commands:
\\{todl-mode-map}
Entry to this mode calls the value of `todl-mode-hook'
if that value is non-nil."
(interactive)
(kill-all-local-variables)
(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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- todl-mode.el,
Joe Corneli <=