;; noweb-outline.el v0.0.3
;; Dan Schmidt <dfan@alum.mit.edu>
;;
;; This code is copyright (C) 1999 Dan Schmidt.
;; Redistribute it at will.
;; You are free to distribute modified versions, provided you say
;;   how your version differs from this one.
;; If you add features or fix bugs, I would appreciate hearing
;; about it so I can merge your changes.
;;
;;;;
;;
;; This file has been tested only with GNU Emacs 20.3.
;;
;; To use:
;;
;; Put the following lines in your .emacs:
;;
;; (autoload 'noweb-outline-read-buffer
;;           "noweb-outline.el"
;;           "View chunk tree of a noweb file."
;;           t)
;;
;; (autoload 'noweb-outline-jump-to-outline-chunk
;;           "noweb-outline.el"
;;           "Jump to a leaf of the chunk tree of a noweb file."
;;           t)
;;
;; Then visit a buffer with some noweb source, and type M-x
;; noweb-outline-read-buffer, or navigate to a chunk and type
;; M-x noweb-outline-jump-to-outline-chunk.
;;
;; Then use Enter and Delete to expand and unexpand chunks, or
;; s to jump to the current chunk in the source buffer.
;;
;; You can use M-x noweb-outline-new-root to choose a different root
;; chunk.
;;
;; You can also type M-x noweb-outline-jump-to-outline-chunk from your
;; source file; it will generate the outline buffer if necessary, and
;; jump to the chunk that you're at in the noweb buffer.
;; 
;; If you like noweb-outline-mode, you'll probably want to bind keys
;; to noweb-outline-read-buffer and noweb-outline-jump-to-outline-chunk
;; in noweb-mode-map.
;;
;;;;
;;
;; Revision history:
;;
;; 0.0.1  17 Feb 1999
;;  - Very limited functionality, but already useful.
;;
;; 0.0.2  18 Feb 1999
;;  - FIXED: noweb-outline-expand-chunk finds the next unexpanded
;;    chunk, and expands it.  It should instead find the next chunk, of
;;    any sort, and expand it only if it's unexpanded.
;;  - FIXED: noweb-outline-expand-chunk can actually find two different
;;    chunk names for the re-search-backward and the re-search-forward,
;;    messing up the value of INDENTATION.  Just need to clean up
;;    that search logic.
;;  - Simple error handling: at least the regexp searches are protected.
;;  - Calling noweb-outline-jump-to-outline-chunk from your noweb buffer
;;    brings up an outline window and jumps to the chunk that you're
;;    currently at.
;;  - Calling noweb-outline-jump-to-source-chunk from your outline
;;    buffer jumps to the (first) definition of that chunk in the
;;    corresponding noweb buffer.
;;  - The root chunk name is displayed, to make things more consistent.
;;  - noweb-outline-jump-to-outline-chunk switches the root
;;    if it has to.
;;
;; 0.0.3   19 Feb 1999
;;  - noweb-outline-enclosing-chunk intelligently chooses the correct
;;    chunk that point is currently in.  And noweb-outline-collapse-chunk
;;    uses it.
;;  - DWIM functionality for noweb-outline-jump-to-source-chunk: it
;;    jumps to an unexpanded chunk, if one is on the current line,
;;    else jumps to the enclosing expanded chunk.
;;  - noweb-outline-read-buffer starts with all root chunks.
;;    [suggestion: Eric Prestemon]
;;  - Compatible with GNU Emacs 19.34, at least.
;;
;; To do (in vague order of priority):
;;
;;  - Navigation keys (next/prev chunk, etc.)
;;
;;  - Turn off many characters (like ones that self-insert) in
;;    noweb-outline-mode.
;;
;;  - Versions of noweb-outline-jump-to-source-chunk and
;;    noweb-outline-jump-to-outline-chunk that don't change buffers,
;;    for peeking.
;;
;;  - Recognize '@<<' and '@>>'.
;;
;;  - Don't get faked out by '<<' and '>>' inside chunks.
;;
;;  - 's' should go to the relevant instance of the chunk definition,
;;    if a chunk is defined multiple times in the source file.
;;
;;    Because noweb-outline keeps very little actual structural
;;    information around, this is not yet possible.  Though we could
;;    fake it by searching for exact lines of code, which might be
;;    good enough.
;;
;;  - noweb-outline-jump-to-outline-chunk should perhaps jump to
;;    the code chunk after point, not before, if we're currently
;;    in a documentation chunk, since doc chunks usually refer to
;;    the following code chunk.
;;
;;  - Make colors customizable.
;;
;;  - Customize according to web language being used.
;;
;;    Here's fweb, for example:
;;
;;    "@<"   begins a module name
;;    "@>"   ends a module name if used somewhere
;;    "@>="  ends a module name that is getting defined (added to)
;;    "@ "   begins a text-section
;;    "@*"   begins a numbered text section, where the star is optionally
;;           followed by a number.
;;
;;  - We could be nicer about dealing with window configurations.
;;
;;  - You should probably be able to mouse-click on chunk names to expand
;;    and unexpand.
;;
;;  - lazy-lock sometimes won't recolor right away.  Or is that just me?
;;
;;  - noweb-outline-get-or-create-pair helper function (macro)

;;; Variables

(defvar noweb-outline-chunks-alist
  nil
  "An alist associating chunk names with their contents.
The CAR of each element is a chunk name.
The CDR of each element is a two-element list:
  The first element contains the contents of the chunk.
  The second element contains the name of a chunk that includes this chunk."
)

(make-variable-buffer-local 'noweb-outline-chunks-alist)

;; Unused so far.
;; Integrate this into the code!  Are these sufficient?
(defvar noweb-outline-chunk-name-begin "<<"
  "Text found at the beginning of a chunk name.")
(defvar noweb-outline-chunk-name-end ">>"
  "Text found at the end of a chunk name.")
(defvar noweb-outline-chunk-name-define-end "="
  "Text found after noweb-outline-chunk-name-end
to indicate the beginning of a definition.")
(defvar noweb-outline-chunk-end "^\\(@$\\|@\\s-\\)"
  "Regexp to find the end of a defined chunk.")

;;; Helper functions

(defun noweb-outline-buffer-name (source-name)
  "Return the name of the noweb-outline buffer corresponding to SOURCE-NAME."
  (concat "*" source-name ": Outline*"))

(defun noweb-outline-source-buffer-name (outline-name)
  "Return the name of the noweb buffer corresponding to OUTLINE-NAME."
  (string-match "\\*\\(.*\\): Outline\\*" outline-name)
  (match-string 1 outline-name))

(defun noweb-outline-display-root (chunk-name)
  "Put the root CHUNK-NAME in the outline buffer."
  (insert (concat "<<" chunk-name ">>"))
  (noweb-outline-expand-chunk))

(defun noweb-outline-new-root (chunk-name)
  "Clear out the buffer and start a new tree with CHUNK-NAME as root."
  (interactive "sChunk name: ")
  (erase-buffer)
  (noweb-outline-display-root chunk-name)
  (goto-char (point-min)))

(defun noweb-outline-chunk-text (chunk-name)
  "Return the text of CHUNK-NAME."
  (let ((pair (assoc chunk-name noweb-outline-chunks-alist)))
    (if pair
        (cadr pair)
      nil)))

(defun noweb-outline-chunk-parent (chunk-name)
  "Return a parent of CHUNK-NAME."
  (let ((pair (assoc chunk-name noweb-outline-chunks-alist)))
    (if pair
        (caddr pair)
      nil)))

(defun noweb-outline-indented-chunk-text (chunk-name indentation)
  "Return the text of CHUNK-NAME, with each line indented with INDENTATION."
  (let* ((orig-chunk-text (copy-sequence (noweb-outline-chunk-text chunk-name)))
         (temp-buffer (generate-new-buffer " *NW-Out Temp*"))
         (chunk-text (save-excursion
                       (set-buffer temp-buffer)
                       (insert orig-chunk-text)
                       (goto-char (point-min))
                       (while (re-search-forward "^" nil t)
                         (replace-match indentation))
                       ;; Have to delete spurious replacement at the end
                       (buffer-substring (point-min)
                                         (save-excursion
                                           (goto-char (point-max))
                                           (beginning-of-line)
                                           (backward-char)
                                           (point))))))
    (kill-buffer temp-buffer)
    chunk-text))

;;; Starting up

(defun noweb-outline-read-buffer ()
  "Read in the noweb file in the current buffer and display its outline."
  (interactive)
  ;; TODO: Assert we're in a noweb buffer
  (let (cur-chunk                     ; name of current chunk
        pair                          ; assoc pair
        chunks-alist                  ; alist we're generating
        beg-chunk-marker)             ; beginning of chunk
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^<<\\(.*\\)>>=" nil t)
        ;; Beginning of chunk
        (let ((chunk-name (match-string 1)))
          (set-text-properties 0 (length chunk-name) nil chunk-name)

          ;; This should be abstracted out to noweb-outline-get-or-create-pair
          (setq pair (assoc chunk-name chunks-alist))
          (when (not pair)
            (setq pair (list chunk-name "" ""))
            (setq chunks-alist (cons pair chunks-alist)))

          (forward-char 1)
          (setq beg-chunk-marker (point))

          ;; Go to end of chunk, looking for children along the way
          (let (exit-loop child-chunk-name child-pair)
            (while (not exit-loop)
              ;; Look for end of chunk, or chunk invocation
              (re-search-forward "^\\(@$\\|^@\\s-\\)\\|<<\\(.*\\)>>\\(=\\)?"
                                 nil 'go-to-end)
              (if (or (match-string 1) (match-string 3))
                  (setq exit-loop 1)    ; end of chunk
                (setq child-chunk-name (match-string 2))
                (set-text-properties 0 (length child-chunk-name) nil child-chunk-name)

                ;; This should be abstracted out too
                (setq child-pair (assoc child-chunk-name chunks-alist))
                (when (not child-pair)
                  (setq child-pair (list child-chunk-name "" ""))
                  (setq chunks-alist (cons child-pair chunks-alist)))

                (setcar (cddr child-pair) chunk-name)))) ; set parent

          (beginning-of-line)
          ;; Need to concat in case we're adding to this chunk from before
          (setcar (cdr pair) (concat (cadr pair)
                                     (buffer-substring-no-properties beg-chunk-marker
                                                                     (point)))))))
    (let* ((new-buffer-name (concat "*" (buffer-name) ": Outline*"))
           (new-buffer (get-buffer-create new-buffer-name)))
      (switch-to-buffer-other-window new-buffer)
      (noweb-outline-mode)
      (setq noweb-outline-chunks-alist chunks-alist)
      (erase-buffer)
      ;; Insert all roots
      (mapcar (function (lambda (x)
                          (when (equal (caddr x) "")
                            (goto-char (point-max))
                            (insert (concat "<<" (car x) ">>\n")))))
              noweb-outline-chunks-alist)
      (goto-char (point-min)))))
      
;;; Basic expanding and collapsing

;; Since all we do is return the name, rather than the value of
;; point, we often waste some time redoing a search later when
;; we use this as a helper function.
(defun noweb-outline-enclosing-chunk ()
  "Return the name of the expanded chunk that point is in, or nil if none."
  ;; We've hit the start of the enclosing chunk when we've seen the start
  ;; of a chunk exactly one more time than we've seen the end of a chunk.
  (let ((chunk-beg-count 0)
        (chunk-end-count 0)
        chunk-name)
    (catch 'buffer-beginning
      (save-excursion
        (end-of-line)
        (while (not (= chunk-beg-count (1+ chunk-end-count)))
          (unless (re-search-backward "<<\\(.*\\)>>=\\|^\\s-*>>" nil t)
            (throw 'buffer-beginning nil))
          (if (match-string 1)
              (progn
                (setq chunk-beg-count (1+ chunk-beg-count))
                (setq chunk-name (match-string 1)))
            (setq chunk-end-count (1+ chunk-end-count)))))
      (set-text-properties 0 (length chunk-name) nil chunk-name)
      chunk-name)))

(defun noweb-outline-unexpanded-chunk-on-line ()
  "Returns the chunk name of the unexpanded chunk on the current line.
If there is none, returns nil."
  (save-excursion
    (let ((ln (thing-at-point 'line))
          (chunk-name nil))
      (when (string-match "<<\\(.*\\)>>\\(\\([^=]\\)\\|$\\)" ln)
        (setq chunk-name (match-string 1 ln))
        (set-text-properties 0 (length chunk-name) nil chunk-name))
      chunk-name)))

;; TODO: Rewrite to use noweb-outline-unexpanded-chunk-on-line
(defun noweb-outline-expand-chunk ()
  "Expand the first unexpanded chunk at or before point."
  (interactive)
  (save-excursion
    (let (indentation
          chunk-name
          beg-chunk-name-marker)
      (end-of-line)
      (unless (re-search-backward "^\\(.*\\)<<" nil t)
        (error "Couldn't find a chunk to expand"))
      (search-forward "<<")
      (backward-char 2)
      (setq beg-chunk-name-marker (point))
      ;; indentation is enough whitespace to get us out to the current column
      (setq indentation (make-string (current-column) ?\ ))
      ;; The following regexp is hairy mostly because we might be
      ;; at the very end of the file.
      (unless (re-search-forward "<<\\(.*\\)>>\\(\\([^=]\\)\\|$\\)" nil t)
        (error "Couldn't find a chunk to expand"))
      (if (> (count-lines beg-chunk-name-marker (point)) 1)
          (error "Chunk on this line is already expanded"))
      (setq chunk-name (match-string 1))
      (set-text-properties 0 (length chunk-name) nil chunk-name)
      (if (match-string 3) (backward-char)) ; move back over the [^=]
      (insert "=\n")
      (insert (noweb-outline-indented-chunk-text chunk-name (concat " " indentation)))
      (insert (concat "\n" indentation ">>")))))

(defun noweb-outline-collapse-chunk ()
  "Collapse the innermost surrounding chunk."
  (interactive)
  (let (indentation
        (chunk-name (noweb-outline-enclosing-chunk))
        chunk-beg-marker)
    (if (null chunk-name)
        (error "Point is not in an expanded chunk"))
    (end-of-line)
    (search-backward (concat "<<" chunk-name ">>="))
    (setq chunk-beg-marker (point))
    (setq indentation (make-string (current-column) ?\ ))
    (unless (re-search-forward (concat "^" indentation ">>") nil t)
      (error "Couldn't find end of expanded chunk"))
    (delete-region chunk-beg-marker (point))
    (insert (concat "<<" chunk-name ">>"))
    (beginning-of-line)))

;;; Searching through the tree for chunks

(defun noweb-outline-descend-and-expand-chunk (chunk-name)
  "Find CHUNK-NAME, and expand it.
If the chunk isn't currently visible, we open up chunks as necessary
to get to it.  We may also need to change the current root."
  (unless (assoc chunk-name noweb-outline-chunks-alist)
    (error (concat chunk-name " is not a chunk")))
  (let ((cur-chunk chunk-name)
        parent-chunk
        (chunk-stack (cons chunk-name nil)))
    (save-excursion
      ;; We rise up the tree of chunks, stopping when we hit
      ;; a visible chunk or a root.  If we hit a root, we have
      ;; change the current root to be it.
      (when (catch 'new-root
              (while (not (noweb-outline-chunk-visible-p cur-chunk))
                (setq parent-chunk (noweb-outline-chunk-parent cur-chunk))
                (if (equal parent-chunk "") (throw 'new-root t)
                  (setq cur-chunk parent-chunk)
                  (setq chunk-stack (cons cur-chunk chunk-stack))))
              nil)
        ;; TODO: Just put the new root at the end of the buffer,
        ;; rather than replacing the whole thing.
        (noweb-outline-new-root cur-chunk))
      (while chunk-stack
        (noweb-outline-find-and-expand (car chunk-stack))
        (setq chunk-stack (cdr chunk-stack)))))
  (goto-char (noweb-outline-chunk-visible-p chunk-name)))
    
(defun noweb-outline-chunk-visible-p (chunk-name)
  "If CHUNK-NAME is currently visible, return its location, otherwise nil."
  (save-excursion
    (goto-char (point-min))
    (if (re-search-forward (concat "<<" (regexp-quote chunk-name) ">>") nil t)
        (progn (beginning-of-line) (point))
      nil)))
   
(defun noweb-outline-find-and-expand (chunk-name)
  "Find CHUNK-NAME, and expand it.
Assumes that the chunk is already visible."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward (concat "<<" (regexp-quote chunk-name) ">>\\(=\\)?") nil t)
    (when (not (match-string 1))
      (noweb-outline-expand-chunk))))

(defun noweb-outline-jump-to-outline-chunk ()
  "Jump to the source buffer's current chunk, in the outline buffer.
The outline buffer is created if it doesn't already exist.
'Current chunk' means the code chunk at or before point."
  (interactive)
  ;; TODO: Assert we're in a noweb buffer
  (let* ((outline-buffer-name (noweb-outline-buffer-name (buffer-name)))
         (outline-buffer (get-buffer outline-buffer-name))
         chunk-name)
    ;; We should only do this if we don't have the buffer already
    (or outline-buffer
        (save-excursion
          (save-window-excursion
            (noweb-outline-read-buffer)
            (setq outline-buffer (current-buffer)))))
    (save-excursion
      (end-of-line)
      (unless (re-search-backward "<<\\(.*\\)>>=" nil t)
        (error "No defined chunk before point")))
    (setq chunk-name (match-string 1))
    (switch-to-buffer-other-window outline-buffer)
    (set-text-properties 0 (length chunk-name) nil chunk-name)
    (noweb-outline-descend-and-expand-chunk chunk-name)))

(defun noweb-outline-jump-to-source-chunk ()
  "Jump to the outline buffer's current chunk, in the source buffer.
'Current chunk' means the code chunk point is in."
  (interactive)
  (let* ((source-buffer-name (noweb-outline-source-buffer-name (buffer-name)))
         (source-buffer (get-buffer source-buffer-name))
         ;; First look for an unexpanded chunk on the current line,
         ;; then the chunk we're currently in.
         (chunk-name (or (noweb-outline-unexpanded-chunk-on-line)
                         (noweb-outline-enclosing-chunk))))
    (unless chunk-name
      (error "Can't find the current chunk"))
    (unless source-buffer
      (error (concat "Can't find " source-buffer-name)))
    (switch-to-buffer-other-window source-buffer)
    (goto-char (point-min))
    (search-forward (concat "<<" chunk-name ">>="))
    (beginning-of-line)))

;;; Font lock stuff

(defvar noweb-outline-font-lock-keywords
  '(("<<.*>>=" 0 font-lock-keyword-face t)
    ("^\\s-*>>" . font-lock-keyword-face)
    ("<<.*>>" . font-lock-variable-name-face)))

(defun noweb-outline-font-lock ()
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(noweb-outline-font-lock-keywords
                             nil nil nil nil
                             )))

;;; noweb-outline-mode

(defvar noweb-outline-mode-map (make-sparse-keymap))
(define-key noweb-outline-mode-map "\r" 'noweb-outline-expand-chunk)
(define-key noweb-outline-mode-map "\C-?" 'noweb-outline-collapse-chunk)
(define-key noweb-outline-mode-map "s" 'noweb-outline-jump-to-source-chunk)

(defun noweb-outline-mode ()
  "Mode for looking at Noweb outlines.
Type M-x noweb-outline-read-buffer from a Noweb buffer to bring up an
outline of that Noweb file.

You can also type M-x noweb-outline-jump-to-outline-chunk from a Noweb
buffer to jump to that chunk in the outline buffer, creating the
outline first if necessary.

\\<noweb-outline-mode-map>
Commands:
\\[noweb-outline-expand-chunk]	  Expand the chunk at or before point.
\\[noweb-outline-collapse-chunk]	  Collapse the chunk at or before point.
\\[noweb-outline-jump-to-source-chunk]	  Jump to the current chunk, in the source buffer.

noweb-outline-mode is in a rather alpha state.

The first chunk is automatically expanded as the root of the tree.  If
pyou want to expand a different chunk, you can type M-x
noweb-outline-new-root, or go to that chunk in your source file and
type M-x noweb-outline-jump-to-outline-chunk."

  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'noweb-outline-mode)
  (setq mode-name "NW-Out")
  (use-local-map noweb-outline-mode-map)
  (noweb-outline-font-lock)
  (run-hooks 'noweb-outline-mode))

;;
;;;;

(provide 'noweb-outline)