cgit.sxemacs.org Git - packages/blob - xemacs-packages/ess/lisp/noweb-mode.el

   1 ;; noweb-mode.el - edit noweb files with GNU Emacs
   2
   3 ;; Copyright (C) 1995 by Thorsten.Ohl @ Physik.TH-Darmstadt.de
   4 ;;     with a little help from Norman Ramsey <norman@bellcore.com>
   5 ;;                         and Mark Lunt <mark.lunt@mrc-bsu.cam.ac.uk>
   6 ;;                         and A.J. Rossini <rossini@biostat.washington.edu>
   7 ;; Copyright (C) 1999--2004 A.J. Rossini, Rich M. Heiberger, Martin
   8 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   9
  10 ;; ESS-related Changes for ESS added by Mark Lunt and A.J. Rossini,
  11 ;; starting March, 1999.
  12
  13 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  14
  15 ;; This program is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19 ;;
  20 ;; This program is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with this program; if not, write to the Free Software
  27 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  28 ;;
  29 ;; See bottom of this file for information on language-dependent
  30 ;; highlighting, and recent changes.
  31 ;;
  32
  33 ;; BASED ON: (from Mark Lunt).
  34 ;; -- Id: noweb-mode.el,v 1.11 1999/03/21 20:14:41 root Exp --
  35
  36 ;;
  37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;; THIS IS UNRELEASED CODE: IT IS MISSING FUNCTIONALITY AND IT NEEDS CLEANUP ;;
  39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40 \f
  41 ;; Put this into your ~/.emacs to use this mode automagically.
  42 ;;
  43 ;; (autoload 'noweb-mode "noweb-mode" "Editing noweb files." t)
  44 ;; (setq auto-mode-alist (append (list (cons "\\.nw$" 'noweb-mode))
  45 ;;                            auto-mode-alist))
  46 \f
  47 ;; NEWS:
  48 ;;
  49 ;;   * [tho] M-n q, aka: M-x noweb-fill-chunk
  50 ;;
  51 ;;   * [tho] `M-n TAB', aka: `M-x noweb-complete-chunk'
  52 ;;
  53 ;;   * [tho] noweb-occur
  54 ;;
  55 ;;   * [nr] use `M-n' instead of `C-c n' as default command prefix
  56 ;;
  57 ;;   * [nr] don't be fooled by
  58 ;;
  59 ;;         @
  60 ;;         <<foo>>=
  61 ;;         int foo;
  62 ;;         @ %def foo
  63 ;;         Here starts a new documentation chunk!
  64 ;;         <<bar>>=
  65 ;;         int bar;
  66 ;;
  67 ;;  * [nr] switch mode changing commands off during isearch-mode
  68 ;;
  69 ;;  * [tho] noweb-goto-chunk proposes a default
  70 ;;
  71 \f
  72 ;; TODO:
  73 ;;
  74 ;;   * replace obscure hacks like `(stringp (car (noweb-find-chunk)))'
  75 ;;     by something more reasonable like `(noweb-code-chunkp)'.
  76 ;;
  77 ;;   * _maybe_ replace our `noweb-chunk-vector' by text properties.  We
  78 ;;     could then use highlighting to jazz up the visual appearance.
  79 ;;     (Highlighting is sorted: `noweb-chunk-vector' can be
  80 ;;     ditched. It is simple to determine if we are in a doc or code
  81 ;;     chunk.)
  82 ;;
  83 ;;   * wrapped `noweb-goto-next' and `noweb-goto-previous'
  84 ;;
  85 ;;   * more range checks and error exits
  86 ;;
  87 ;;   * commands for tangling, weaving, etc.
  88 ;;
  89 ;;   * `noweb-hide-code-quotes' should be superfluous now, and could
  90 ;;     be removed
  91 ;;
  92 ;;   * ...
  93 ;;
  94
  95 \f
  96 ;;; Variables
  97
  98 (defconst noweb-mode-RCS-Id
  99   "Imported to ESS Subversion repository and RCS ids not maintained.")
 100
 101 (defconst noweb-mode-RCS-Name
 102   " ")
 103
 104 (defvar noweb-mode-prefix "\M-n"
 105   "*Prefix key to use for noweb mode commands.
 106 The value of this variable is checked as part of loading noweb mode.
 107 After that, changing the prefix key requires manipulating keymaps.")
 108
 109 (defvar noweb-mode-load-hook nil
 110   "Hook that is run after noweb mode is loaded.")
 111
 112 (defvar noweb-mode-hook nil
 113   "Hook that is run after entering noweb mode.")
 114
 115 (defvar noweb-select-code-mode-hook nil
 116   "Hook that is run after the code mode is selected.
 117 This is the place to overwrite keybindings of the NOWEB-CODE-MODE.")
 118
 119 (defvar noweb-select-doc-mode-hook nil
 120   "Hook that is run after the documentation mode is selected.
 121 This is the place to overwrite keybindings of the NOWEB-DOC-MODE.")
 122
 123 (defvar noweb-select-mode-hook nil
 124   "Hook that is run after the documentation or the code mode is selected.
 125 This is the place to overwrite keybindings of the other modes.")
 126
 127 (defvar noweb-changed-chunk-hook nil
 128   "Hook that is run every time point moves from one chunk to another.
 129 It will be run whether or not the major-mode changes.")
 130
 131 (defvar noweb-default-code-mode 'fundamental-mode
 132   "Default major mode for editing code chunks.
 133 This is set to FUNDAMENTAL-MODE by default, but you might want to
 134 change this in the Local Variables section of your file to something
 135 more appropriate, like C-MODE, FORTRAN-MODE, or even
 136 INDENTED-TEXT-MODE.")
 137
 138 (defvar noweb-code-mode 'c-mode
 139   "Major mode for editing this particular code chunk.
 140 It defaults to noweb-default-code-mode, but can be reset by a comment
 141 on the first line of the chunk containing the string
 142 \"-*- NEWMODE -*-\" or
 143 \"-*- NEWMODE-mode -*-\" or
 144 \"-*- mode: NEWMODE -*- \"  or
 145 \"-*- mode: NEWMODE-mode -*- \"
 146 Option three is recommended, as it is the closest to standard emacs usage.")
 147
 148 (defvar noweb-default-doc-mode 'latex-mode
 149   "Major mode for editing documentation chunks.
 150 Sensible choices would be tex-mode, latex-mode, sgml-mode, or
 151 html-mode.  Maybe others will exist someday.")
 152
 153 (defvar noweb-doc-mode-syntax-table nil
 154   "A syntax-table syntax table that makes quoted code in doc chunks to
 155 behave.")
 156
 157 (defvar noweb-last-chunk-index 0
 158   "This keeps track of the chunk we have just been in. If this is not
 159 the same as the current chunk, we have to check if we need to change
 160 major mode.")
 161
 162 (defvar noweb-chunk-vector nil
 163   "Vector of the chunks in this buffer.")
 164
 165 (defvar noweb-narrowing nil
 166   "If not NIL, the display will always be narrowed to the
 167 current chunk pair.")
 168
 169 (defvar noweb-electric-@-and-< t
 170   "If not nil, the keys `@' and `<' will be bound to NOWEB-ELECTRIC-@
 171 and NOWEB-ELECTRIC-<, respectively.")
 172
 173 (defvar noweb-use-mouse-navigation t
 174   "If not nil, enables moving between chunks using mouse-1.
 175 Clicking on the '<<' at the beginning of a chunk name takes you to the
 176 previous occurence of that chunk name, clicking on the '>>' takes you
 177 to the next.
 178 Assumes mouse-1 is bound to mouse-set-point, so if you have rebound
 179 mouse-1, this will override your binding.")
 180
 181 ; \f
 182
 183 ;; The following is apparently broken -- dangling code that was
 184 ;; commented out.  Need to see if we can get it working?
 185
 186 (defvar noweb-weave-options "-delay")
 187 (defvar noweb-latex-viewer "xdvi")
 188 (defvar noweb-html-viewer "netscape")
 189
 190 (defun noweb-weave (&optional name)
 191   (interactive)
 192   (let ((buffer (get-buffer-create "Weave Buffer")))
 193     (if (not name)
 194         (progn
 195           ;; Assume latex documentation, but set to html if appropriate
 196           (if (eq noweb-doc-mode html-mode)
 197               (setq name (concat (substring (buffer-file-name) 0
 198                                             (string-match ".nw" name))
 199                                  ".html"))
 200             (setq name (concat (substring (buffer-file-name) 0
 201                                           (string-match ".nw" name))
 202                                ".tex")))))
 203     (setq name (concat "> " name))
 204     (setq noweb-weave-options (concat noweb-weave-options name))
 205     (start-process weave-process buffer "noweave" noweb-weave-options)))
 206 ;;(defun noweb-view  ())
 207
 208 \f
 209 ;;; Setup
 210 (defvar noweb-mode nil
 211   "Buffer local variable, T iff this buffer is edited in noweb mode.")
 212
 213 ;; For some reason that I do not understand, `newline' does not do the
 214 ;; right thing in quoted code. If point is not preceded by whitespace,
 215 ;; it moves to the beginning of the current line, not the beginning of
 216 ;; the new line. `newline 1' works fine, hence the kludge. I'd love to
 217 ;; understand what's going on, though. Try running M-x newline in the
 218 ;; middle of a code quote in a doc chunk to see
 219 ;; what I mean: its odd.
 220
 221 (defun noweb-newline (&optional arg)
 222   "A kludge to get round very odd behaviour of newline in quoted code."
 223   (interactive "p")
 224   (if arg (newline arg) (newline 1)))
 225
 226 (defvar noweb-mode-prefix-map
 227   (let ((map (if (featurep 'xemacs)
 228                  (make-keymap) ;; XEmacs/Emacs problems...
 229                (make-sparse-keymap))))
 230     (define-key map "\C-n" 'noweb-next-chunk)
 231     (define-key map "\C-p" 'noweb-previous-chunk)
 232     (define-key map "\M-n" 'noweb-goto-next)
 233     (define-key map "\M-m" 'noweb-insert-default-mode-line)
 234     (define-key map "\M-p" 'noweb-goto-previous)
 235     (define-key map "c" 'noweb-next-code-chunk)
 236     (define-key map "C" 'noweb-previous-code-chunk)
 237     (define-key map "d" 'noweb-next-doc-chunk)
 238     (define-key map "D" 'noweb-previous-doc-chunk)
 239     (define-key map "g" 'noweb-goto-chunk)
 240     (define-key map "\C-l" 'noweb-update-chunk-vector)
 241     (define-key map "\M-l" 'noweb-update-chunk-vector)
 242     (define-key map "w" 'noweb-copy-chunk-as-kill)
 243     (define-key map "W" 'noweb-copy-chunk-pair-as-kill)
 244     (define-key map "k" 'noweb-kill-chunk)
 245     (define-key map "K" 'noweb-kill-chunk-pair)
 246     (define-key map "m" 'noweb-mark-chunk)
 247     (define-key map "M" 'noweb-mark-chunk-pair)
 248     (define-key map "n" 'noweb-narrow-to-chunk)
 249     (define-key map "N" 'noweb-narrow-to-chunk-pair)
 250     (define-key map "t" 'noweb-toggle-narrowing)
 251     (define-key map "\t" 'noweb-complete-chunk)
 252     (define-key map "q" 'noweb-fill-chunk)
 253     (define-key map "i" 'noweb-new-chunk)
 254     (define-key map "o" 'noweb-occur)
 255     (define-key map "v" 'noweb-mode-version)
 256     (define-key map "h" 'noweb-describe-mode)
 257     (define-key map "\C-h" 'noweb-describe-mode)
 258     map)
 259   "noweb minor-mode prefix keymap")
 260
 261 (defvar noweb-minor-mode-map
 262   (let ((map (make-sparse-keymap)))
 263     (if noweb-electric-@-and-<
 264         (progn
 265           (define-key map "@" 'noweb-electric-@)
 266           (define-key map "<" 'noweb-electric-<)))
 267     (define-key map "\M-q" 'noweb-fill-paragraph-chunk)
 268     ;;(define-key map "\C-c\C-n" 'noweb-indent-line) ; Override TeX-normal!
 269     (define-key map [tab] 'noweb-indent-line)
 270     (define-key map [return] 'noweb-newline)
 271     (define-key map [mouse-1] 'noweb-mouse-first-button)
 272     (define-key map noweb-mode-prefix noweb-mode-prefix-map)
 273     map)
 274   "Noweb minor mode keymap")
 275
 276 (easy-menu-define
 277  noweb-minor-mode-menu noweb-minor-mode-map
 278  "Menu keymap for noweb."
 279  '("Noweb"
 280    ("Movement"
 281     ["Previous chunk" noweb-previous-chunk t]
 282     ["Next chunk" noweb-next-chunk t]
 283     ["Previous chunk of same name" noweb-goto-previous t]
 284     ["Next chunk of same name" noweb-goto-next t]
 285     ["Goto chunk" noweb-goto-chunk t]
 286     ["Previous code chunk" noweb-previous-code-chunk t]
 287     ["Next code chunk" noweb-next-code-chunk t]
 288     ["Previous documentation chunk" noweb-previous-doc-chunk t]
 289     ["Next documentation chunk" noweb-next-doc-chunk t])
 290    ("Editing"
 291     ["Copy chunk" noweb-copy-chunk-as-kill t]
 292     ["Copy chunk pair" noweb-copy-chunk-pair-as-kill t]
 293     ["Kill chunk" noweb-kill-chunk t]
 294     ["Kill chunk pair" noweb-kill-chunk-pair t]
 295     ["Mark chunk" noweb-mark-chunk t]
 296     ["Mark chunk pair" noweb-mark-chunk-pair t])
 297    ("Narrowing"
 298     ["Narrow to chunk" noweb-narrow-to-chunk t]
 299     ["Narrow to chunk pair" noweb-narrow-to-chunk-pair t]
 300     ["Toggle auto narrowing" noweb-toggle-narrowing t]
 301     ["Widen" widen t])
 302    ("Modes"
 303     ["Set documentation mode" noweb-set-doc-mode t]
 304     ["Set default code mode" noweb-set-code-mode t]
 305     ["Set code mode for this chunk" noweb-set-this-code-mode t]
 306     ["Insert default mode line" noweb-insert-default-mode-line t])
 307    ("Tangling"
 308     ["Tangle current chunk" noweb-tangle-chunk t]
 309     ["Tangle current thread" noweb-tangle-current-thread t]
 310     ["Tangle named thread" noweb-tangle-thread t])
 311    ("Miscellaneous"
 312     ["Complete chunk name" noweb-complete-chunk t]
 313     ["Fill current chunk" noweb-fill-chunk t]
 314     ["Insert new chunk" noweb-new-chunk t]
 315     ["Update the chunk vector" noweb-update-chunk-vector t]
 316     ["Chunk occurrences" noweb-occur t])
 317    "--"
 318    ["Help" noweb-describe-mode t]
 319    ["Version" noweb-mode-version t]))
 320
 321 ;; Add noweb-mode to the list of minor modes
 322 (if (not (assq 'noweb-mode minor-mode-alist))
 323     (setq minor-mode-alist (append minor-mode-alist
 324                                    (list '(noweb-mode " Noweb")))))
 325 ;; Add noweb-minor-mode-map to the list of minor-mode keymaps
 326 ;; available. Then, whenever noweb-mode is activated, the keymap is
 327 ;; automatically activated
 328 (if (not (assq 'noweb-mode minor-mode-map-alist))
 329     (setq minor-mode-map-alist
 330           (cons (cons 'noweb-mode noweb-minor-mode-map)
 331                 minor-mode-map-alist)))
 332
 333 ;; Old XEmacs hacks.
 334 (defun noweb-mode-xemacs-menu ()
 335   "Hook to install noweb-mode menu for XEmacs (w/ easymenu)."
 336   (if 'noweb-mode
 337       (easy-menu-add noweb-minor-mode-menu)
 338     (easy-menu-remove noweb-minor-mode-menu)
 339     ))
 340
 341 (if (string-match "XEmacs" emacs-version)
 342     (progn
 343       (add-hook 'noweb-select-mode-hook 'noweb-mode-xemacs-menu)
 344       ;; Next line handles some random problems...
 345       (easy-menu-add noweb-minor-mode-menu)))
 346
 347 (defun noweb-minor-mode (&optional arg)
 348   "Minor meta mode for editing noweb files. See NOWEB-MODE."
 349   (interactive)
 350   (noweb-mode arg)) ; this was noweb-minor-mode???  (truly recursive)
 351
 352 (defun noweb-mode ( &optional arg )
 353   "Minor meta mode for editing noweb files.
 354 `Meta' refers to the fact that this minor mode is switching major
 355 modes depending on the location of point.
 356
 357 The following special keystrokes are available in noweb mode:
 358
 359 Movement:
 360 \\[noweb-next-chunk] \tgoto the next chunk
 361 \\[noweb-previous-chunk] \tgoto the previous chunk
 362 \\[noweb-goto-previous] \tgoto the previous chunk of the same name
 363 \\[noweb-goto-next] \tgoto the next chunk of the same name
 364 \\[noweb-goto-chunk] \t\tgoto a chunk
 365 \\[noweb-next-code-chunk] \t\tgoto the next code chunk
 366 \\[noweb-previous-code-chunk] \t\tgoto the previous code chunk
 367 \\[noweb-next-doc-chunk] \t\tgoto the next documentation chunk
 368 \\[noweb-previous-doc-chunk] \t\tgoto the previous documentation chunk
 369
 370 Copying/Killing/Marking/Narrowing:
 371 \\[noweb-copy-chunk-as-kill] \t\tcopy the chunk the point is in into the kill ring
 372 \\[noweb-copy-chunk-pair-as-kill] \t\tcopy the pair of doc/code chunks the point is in
 373 \\[noweb-kill-chunk] \t\tkill the chunk the point is in
 374 \\[noweb-kill-chunk-pair] \t\tkill the pair of doc/code chunks the point is in
 375 \\[noweb-mark-chunk] \t\tmark the chunk the point is in
 376 \\[noweb-mark-chunk-pair] \t\tmark the pair of doc/code chunks the point is in
 377 \\[noweb-narrow-to-chunk] \t\tnarrow to the chunk the point is in
 378 \\[noweb-narrow-to-chunk-pair] \t\tnarrow to the pair of doc/code chunks the point is in
 379 \\[widen] \twiden
 380 \\[noweb-toggle-narrowing] \t\ttoggle auto narrowing
 381
 382 Filling and Indenting:
 383 \\[noweb-fill-chunk] \tfill (or indent) the chunk at point according to mode
 384 \\[noweb-fill-paragraph-chunk] \tfill the paragraph at point, restricted to chunk
 385 \\[noweb-indent-line] \tindent the line at point according to mode
 386
 387 Insertion:
 388 \\[noweb-insert-default-mode-line] \tinsert a line to set this file's code mode
 389 \\[noweb-new-chunk] \t\tinsert a new chunk at point
 390 \\[noweb-complete-chunk] \tcomplete the chunk name before point
 391 \\[noweb-electric-@] \t\tinsert a `@' or start a new doc chunk
 392 \\[noweb-electric-<] \t\tinsert a `<' or start a new code chunk
 393
 394 Modes:
 395 \\[noweb-set-doc-mode] \t\tset the major mode for editing doc chunks
 396 \\[noweb-set-code-mode] \tset the major mode for editing code chunks
 397 \\[noweb-set-this-code-mode] \tset the major mode for editing this code chunk
 398
 399 Misc:
 400 \\[noweb-occur] \t\tfind all occurrences of the current chunk
 401 \\[noweb-update-chunk-vector] \tupdate the markers for chunks
 402 \\[noweb-describe-mode] \tdescribe noweb-mode
 403 \\[noweb-mode-version] \t\tshow noweb-mode's version in the minibuffer
 404 "  (interactive "P")
 405 ; This bit is tricky: copied almost verbatim from bib-cite-mode.el
 406 ; It seems to ensure that the variable noweb-mode is made
 407 ; local to this buffer. It then sets noweb-mode to `t' if
 408 ;     1) It was called with an argument greater than 0
 409 ; or  2) It was called with no argument, and noweb-mode is
 410 ;        currently nil
 411 ; noweb-mode is nil if the argument was <= 0 or there
 412 ; was no argument and noweb-mode is currently `t'
 413   (set (make-local-variable 'noweb-mode)
 414        (if arg
 415            (> (prefix-numeric-value arg) 0)
 416          (not noweb-mode)))
 417 ; Now, if noweb-mode is true, we want to turn
 418 ; noweb-mode on
 419   (cond
 420    (noweb-mode                 ;Setup the minor-mode
 421     (mapcar 'noweb-make-variable-permanent-local
 422             '(noweb-mode
 423               after-change-functions
 424               noweb-narrowing
 425               noweb-chunk-vector
 426               post-command-hook
 427               isearch-mode-hook
 428               isearch-mode-end-hook
 429               noweb-doc-mode
 430               noweb-code-mode
 431               noweb-default-code-mode
 432               noweb-last-chunk-index))
 433     (noweb-update-chunk-vector)
 434     (if (equal 0 (noweb-find-chunk-index-buffer))
 435         (setq noweb-last-chunk-index 1)
 436       (setq noweb-last-chunk-index 0))
 437     (if font-lock-mode
 438         (progn
 439           (font-lock-mode -1)
 440           (noweb-font-lock-mode 1)))
 441     (add-hook 'post-command-hook 'noweb-post-command-function)
 442     (add-hook 'after-change-functions 'noweb-after-change-function)
 443     (add-hook 'noweb-select-doc-mode-hook 'noweb-auto-fill-doc-mode)
 444     (add-hook 'noweb-select-code-mode-hook 'noweb-auto-fill-code-mode)
 445     (add-hook 'isearch-mode-hook 'noweb-note-isearch-mode)
 446     (add-hook 'isearch-mode-end-hook 'noweb-note-isearch-mode-end)
 447     (setq noweb-doc-mode-syntax-table nil)
 448     (run-hooks 'noweb-mode-hook)
 449     (message
 450      "noweb mode: use `M-x noweb-describe-mode' for further information"))
 451    ;; If we didn't do the above, then we want to turn noweb-mode
 452    ;; off, no matter what (hence the condition `t')
 453    (t
 454     (remove-hook 'post-command-hook 'noweb-post-command-function)
 455     (remove-hook 'after-change-functions 'noweb-after-change-function)
 456     (remove-hook 'noweb-select-doc-mode-hook 'noweb-auto-fill-doc-mode)
 457     (remove-hook 'noweb-select-code-mode-hook 'noweb-auto-fill-code-mode)
 458     (remove-hook 'isearch-mode-hook 'noweb-note-isearch-mode)
 459     (remove-hook 'isearch-mode-end-hook 'noweb-note-isearch-mode-end)
 460     (if noweb-font-lock-mode
 461         (progn
 462           (noweb-font-lock-mode -1)
 463           (message "Noweb and Noweb-Font-Lock Modes Removed"))
 464       (message "Noweb mode removed")))))
 465
 466 (defun noweb-make-variable-permanent-local (var)
 467   "Declare VAR buffer local, but protect it from beeing killed
 468 by major mode changes."
 469   (make-variable-buffer-local var)
 470   (put var 'permanent-local 't))
 471
 472 (defun noweb-note-isearch-mode ()
 473   "Take note of an incremental search in progress"
 474   (remove-hook 'post-command-hook 'noweb-post-command-function))
 475
 476 (defun noweb-note-isearch-mode-end ()
 477   "Take note of an incremental search having ended"
 478   (add-hook 'post-command-hook 'noweb-post-command-function))
 479
 480 (defun noweb-post-command-function ()
 481   "The hook being run after each command in noweb mode."
 482   (noweb-select-mode))
 483
 484 (defun noweb-after-change-function (begin end length)
 485   "Function to run after every change in a noweb buffer.
 486 If the changed region contains a chunk start (^@ or ^<<), it will
 487 update the chunk vector"
 488   (save-excursion
 489     (goto-char begin)
 490     (if (re-search-forward "^\\(@[^@]\\)\\|\\(<<\\)" end t)
 491       (noweb-update-chunk-vector))))
 492
 493 \f
 494 ;;; Chunks
 495
 496 (defun noweb-update-chunk-vector ()
 497   "Scan the whole buffer and place a marker at each \"^@\" and \"^<<\".
 498 Record them in NOWEB-CHUNK-VECTOR."
 499   (interactive)
 500   (save-excursion
 501     (goto-char (point-min))
 502     (let ((chunk-list (list (cons 'doc (point-marker)))))
 503       (while (re-search-forward "^\\(@\\( \\|$\\|\\( %def\\)\\)\\|<<\\(.*\\)>>=\\)" nil t)
 504         (goto-char (match-beginning 0))
 505         ;; If the 3rd subexpression matched @ %def, we're still in a code
 506         ;; chunk (sort of), so don't place a marker here.
 507         (if (not (match-beginning 3))
 508             (setq chunk-list
 509                   ;; If the 4th subexpression matched inside <<...>>,
 510                   ;; we're seeing a new code chunk.
 511                   (cons (cons (if (match-beginning 4)
 512                                   ;;buffer-substring-no-properties better
 513                                   ;;than buffer-substring if highlighting
 514                                   ;;may be used
 515                                   (buffer-substring-no-properties
 516                                    (match-beginning 4) (match-end 4))
 517                                 'doc)
 518                               (point-marker))
 519                         chunk-list))
 520           ;; Scan forward either to !/^@ %def/, which will start a docs chunk,
 521           ;; or to /^<<.*>>=$/, which will start a code chunk.
 522           (progn
 523             (next-line 1)
 524             (while (looking-at "@ %def")
 525               (next-line 1))
 526             (setq chunk-list
 527                   ;; Now we can tell code vs docs
 528                   (cons (cons (if (looking-at "<<\\(.*\\)>>=")
 529                                   (buffer-substring-no-properties
 530                                    (match-beginning 1) (match-end 1))
 531                                 'doc)
 532                               (point-marker))
 533                         chunk-list))))
 534         (next-line 1))
 535       (setq chunk-list (cons (cons 'doc (point-max-marker)) chunk-list))
 536       (setq noweb-chunk-vector (vconcat (reverse chunk-list))))))
 537
 538 (defun noweb-find-chunk ()
 539   "Return a pair consisting of the name (or 'DOC) and the
 540 marker of the current chunk."
 541   (if (not noweb-chunk-vector)
 542       (noweb-update-chunk-vector))
 543   (aref noweb-chunk-vector (noweb-find-chunk-index-buffer)))
 544
 545 (defun noweb-chunk-is-code (index)
 546   "Return t if the chunk 'index' is a code chunk, nil otherwise"
 547   (interactive)
 548   (stringp (car (noweb-chunk-vector-aref index))))
 549
 550 (defun noweb-in-code-chunk ()
 551   "Return t if we are in a code chunk, nil otherwise."
 552   (interactive)
 553   (noweb-chunk-is-code (noweb-find-chunk-index-buffer)))
 554
 555 (defun noweb-in-mode-line ()
 556   "Return the name of the mode to use if we are in a mode line, nil
 557 otherwise."
 558   (interactive)
 559   (let (beg end mode)
 560     (save-excursion
 561       (beginning-of-line 1)
 562       (and (progn
 563              (ess-write-to-dribble-buffer
 564               (format "(n-i-m-l: 1)"))
 565              (search-forward "-*-"
 566                              (save-excursion (end-of-line) (point))
 567                              t))
 568            (progn
 569              (ess-write-to-dribble-buffer
 570               (format "(n-i-m-l: 2)"))
 571              (skip-chars-forward " \t")
 572              (setq beg (point))
 573              (search-forward "-*-"
 574                              (save-excursion (end-of-line) (point))
 575                              t))
 576            (progn
 577              (ess-write-to-dribble-buffer
 578               (format "(n-i-m-l: 3)"))
 579              (forward-char -3)
 580              (skip-chars-backward " \t")
 581              (setq end (point))
 582              (goto-char beg)
 583              (setq mode (concat
 584                          (downcase (buffer-substring beg end))
 585                          "-mode"))
 586              (if (and (>= (length mode) 11))
 587                       (progn
 588                         (if
 589                             (equal (substring mode -10 -5) "-mode")
 590                             (setq mode (substring mode 0 -5)))
 591                         (if
 592                             (equal (substring mode 0 5) "mode:")
 593                             (setq mode (substring mode 6))))))
 594            (progn
 595              (ess-write-to-dribble-buffer
 596               (format "(n-i-m-l: 3) mode=%s" mode))
 597              (intern mode))))))
 598
 599 (defun noweb-find-chunk-index-buffer ()
 600   "Return the index of the current chunk in NOWEB-CHUNK-VECTOR."
 601   (noweb-find-chunk-index 0 (1- (length noweb-chunk-vector))))
 602
 603 (defun noweb-find-chunk-index (low hi)
 604   (if (= hi (1+ low))
 605       low
 606     (let ((med (/ (+ low hi) 2)))
 607       (if (< (point) (cdr (aref noweb-chunk-vector med)))
 608           (noweb-find-chunk-index low med)
 609         (noweb-find-chunk-index med hi)))))
 610
 611 (defun noweb-chunk-region ()
 612   "Return a pair consisting of the beginning and end of the current chunk."
 613   (interactive)
 614   (let ((start (noweb-find-chunk-index-buffer)))
 615     (cons (marker-position (cdr (aref noweb-chunk-vector start)))
 616           (marker-position (cdr (aref noweb-chunk-vector (1+ start)))))))
 617
 618 (defun noweb-copy-code-chunk ()
 619   "Copy the current code chunk to the kill ring, excluding the chunk name.
 620 This will be particularly useful when interfacing with ESS."
 621   (interactive)
 622   (let ((r (noweb-chunk-region)))
 623     (save-excursion
 624       (goto-char (car r))
 625       (if (noweb-in-code-chunk)
 626           (progn
 627             (beginning-of-line 2)
 628             (copy-region-as-kill (point) (cdr r)))))))
 629
 630 (defun noweb-extract-code-chunk ()
 631   "Create a new buffer with the same name as the current code chunk,
 632 and copy all code  from chunks of the same name to it."
 633   (interactive)
 634   (save-excursion
 635     (if (noweb-in-code-chunk)
 636         (progn
 637           (let ((chunk-name (car (noweb-find-chunk)))
 638                 (chunk-counter 0)
 639                 (copy-counter 0)
 640                 (this-chunk) (oldbuf (current-buffer)))
 641             (if (get-buffer chunk-name)
 642                 (progn
 643                   (set-buffer-modified-p nil)
 644                   (kill-buffer chunk-name)))
 645             (get-buffer-create chunk-name)
 646             (message "Created buffer %s" chunk-name)
 647             (while (< chunk-counter (- (length noweb-chunk-vector) 2))
 648               (setq this-chunk (noweb-chunk-vector-aref
 649                                 chunk-counter))
 650               (message "Current buffer is %s" (car this-chunk))
 651               (if (equal chunk-name (car this-chunk))
 652                   (progn
 653                     (setq copy-counter (+ copy-counter 1))
 654                     (goto-char (cdr this-chunk))
 655                     (noweb-copy-code-chunk)
 656                     (set-buffer chunk-name)
 657                     (goto-char (point-max))
 658                     (yank)
 659                     (set-buffer oldbuf)))
 660               (setq chunk-counter (+ chunk-counter 1)))
 661             (message "Copied %d bits" copy-counter)
 662             (set-buffer chunk-name)
 663             (copy-region-as-kill (point-min)(point-max)))))))
 664
 665 (defun noweb-chunk-pair-region ()
 666   "Return a pair consisting of the beginning and end of the current pair of
 667 documentation and code chunks."
 668   (interactive)
 669   (let* ((start (noweb-find-chunk-index-buffer))
 670          (end (1+ start)))
 671     (if (noweb-chunk-is-code start)
 672         (cons (marker-position (cdr (aref noweb-chunk-vector (1- start))))
 673               (marker-position (cdr (aref noweb-chunk-vector end))))
 674       (while (not (noweb-chunk-is-code  end))
 675         (setq end (1+ end)))
 676       (cons (marker-position (cdr (aref noweb-chunk-vector start)))
 677             (marker-position (cdr (aref noweb-chunk-vector (1+ end))))))))
 678
 679 (defun noweb-chunk-vector-aref (i)
 680   (if (< i 0)
 681       (error "Before first chunk."))
 682   (if (>= i (length noweb-chunk-vector))
 683       (error "Beyond last chunk."))
 684   (aref noweb-chunk-vector i))
 685
 686 (defun noweb-complete-chunk ()
 687   "Complete the chunk name before point, if any."
 688   (interactive)
 689   (if (noweb-in-code-chunk)
 690       (let ((end (point))
 691       (beg (save-excursion
 692             (if (re-search-backward "<<"
 693                    (save-excursion
 694                                              (beginning-of-line)
 695                                              (point))
 696                                            t)
 697                        (match-end 0)
 698                      nil))))
 699         (if beg
 700             (let* ((pattern (buffer-substring beg end))
 701                    (alist (noweb-build-chunk-alist))
 702                    (completion (try-completion pattern alist)))
 703               (cond ((eq completion t))
 704                     ((null completion)
 705                      (message "Can't find completion for \"%s\"" pattern)
 706                      (ding))
 707                     ((not (string= pattern completion))
 708                      (delete-region beg end)
 709                      (insert completion)
 710                      (if (not (looking-at ">>"))
 711                          (insert ">>")))
 712                     (t
 713                      (message "Making completion list...")
 714                      (with-output-to-temp-buffer "*Completions*"
 715                        (display-completion-list (all-completions pattern alist)))
 716                      (message "Making completion list...%s" "done"))))
 717           (message "Not at chunk name...")))
 718     (message "Not in code chunk...")))
 719
 720 \f
 721 ;;; Filling, etc
 722
 723 (defun noweb-hide-code-quotes ()
 724   "Replace all non blank characters in [[...]] code quotes
 725 in the current buffer (you might want to narrow to the interesting
 726 region first) by `*'.  Return a list of pairs with the position and
 727 value of the original strings."
 728   (save-excursion
 729     (let ((quote-list nil))
 730       (goto-char (point-min))
 731       (while (re-search-forward "\\[\\[" nil 'move)
 732         (let ((beg (match-end 0))
 733               (end (if (re-search-forward "\\]\\]" nil t)
 734                        (match-beginning 0)
 735                      (point-max))))
 736           (goto-char beg)
 737           (while (< (point) end)
 738             ;; Move on to the next word:
 739             (let ((b (progn
 740                        (skip-chars-forward " \t\n" end)
 741                        (point)))
 742                   (e (progn
 743                        (skip-chars-forward "^ \t\n" end)
 744                        (point))))
 745               (if (> e b)
 746                   ;; Save the string and a marker to the end of the
 747                   ;; replacement text.  A marker to the beginning is
 748                   ;; useless.  See NOWEB-RESTORE-CODE-QUOTES.
 749                   (save-excursion
 750                     (setq quote-list (cons (cons (copy-marker e)
 751                                                  (buffer-substring b e))
 752                                            quote-list))
 753                     (goto-char b)
 754                     (insert-char ?* (- e b) t)
 755                     (delete-char (- e b))))))))
 756       (reverse quote-list))))
 757
 758 (defun noweb-restore-code-quotes (quote-list)
 759   "Reinsert the strings modified by `noweb-hide-code-quotes'."
 760   (save-excursion
 761     (mapcar '(lambda (q)
 762                (let* ((e (marker-position (car q)))
 763                       ;; Slightly inefficient, but correct way to find
 764                       ;; the beginning of the word to be replaced.
 765                       ;; Using the marker at the beginning will loose
 766                       ;; if whitespace has been rearranged
 767                       (b (save-excursion
 768                            (goto-char e)
 769                            (skip-chars-backward "*")
 770                            (point))))
 771                  (delete-region b e)
 772                  (goto-char b)
 773                  (insert (cdr q))))
 774             quote-list)))
 775
 776 (defun noweb-fill-chunk ()
 777   "Fill the current chunk according to mode.
 778 Run `fill-region' on documentation chunks and `indent-region' on code
 779 chunks."
 780   (interactive)
 781   (save-excursion
 782     (save-restriction
 783       (noweb-narrow-to-chunk)
 784       (if (noweb-in-code-chunk)
 785           (progn
 786             ;; Narrow to the code section proper; w/o the first and any
 787             ;; index declaration lines.
 788             (narrow-to-region (progn
 789                                 (goto-char (point-min))
 790                                 (forward-line 1)
 791                                 (point))
 792                               (progn
 793                                 (goto-char (point-max))
 794                                 (forward-line -1)
 795                                 (while (looking-at "@")
 796                                   (forward-line -1))
 797                                 (forward-line 1)
 798                                 (point)))
 799             (if (or indent-region-function indent-line-function)
 800                 (indent-region (point-min) (point-max) nil)
 801               (error "No indentation functions defined in %s!" major-mode)))
 802         (let ((quote-list (noweb-hide-code-quotes)))
 803           (fill-region (point-min) (point-max))
 804           (noweb-restore-code-quotes quote-list))))))
 805
 806 (defun noweb-indent-line ()
 807   "Indent the current line according to mode, after narrowing to this chunk."
 808   (interactive)
 809   (save-restriction
 810     (noweb-narrow-to-chunk)
 811     (if (stringp (car (noweb-find-chunk)))
 812         (progn
 813           ;; Narrow to the code section proper; w/o the first and any
 814           ;; index declaration lines.
 815           (save-excursion
 816             (narrow-to-region (progn
 817                                 (goto-char (point-min))
 818                                 (forward-line 1)
 819                                 (point))
 820                               (progn
 821                                 (goto-char (point-max))
 822                                 (forward-line -1)
 823                                 (while (looking-at "@")
 824                                   (forward-line -1))
 825                                 (forward-line 1)
 826                                 (point))))))
 827       (indent-according-to-mode)))
 828
 829 (defun noweb-fill-paragraph-chunk (&optional justify)
 830   "Fill a paragraph in the current chunk."
 831   (interactive "P")
 832   (noweb-update-chunk-vector)
 833   (save-restriction
 834     (save-excursion
 835       (noweb-narrow-to-chunk)
 836       (if (stringp (car (noweb-find-chunk)))
 837           (progn
 838             ;; Narrow to the code section proper; w/o the first and any
 839             ;; index declaration lines.
 840             (narrow-to-region (progn
 841                                 (goto-char (point-min))
 842                                 (forward-line 1)
 843                                 (point))
 844                               (progn
 845                                 (goto-char (point-max))
 846                                 (forward-line -1)
 847                                 (while (looking-at "@")
 848                                   (forward-line -1))
 849                                 (forward-line 1)
 850                                 (point)))
 851             (fill-paragraph justify))
 852         (let ((quote-list (noweb-hide-code-quotes)))
 853           (fill-paragraph justify)
 854           (noweb-restore-code-quotes quote-list))))))
 855
 856 (defun noweb-auto-fill-doc-chunk ()
 857   "Replacement for `do-auto-fill'."
 858   (save-restriction
 859     (narrow-to-region (car (noweb-chunk-region))
 860                       (save-excursion
 861                         (end-of-line)
 862                         (point)))
 863     (let ((quote-list (noweb-hide-code-quotes)))
 864       (do-auto-fill)
 865       (noweb-restore-code-quotes quote-list))))
 866
 867 (defun noweb-auto-fill-doc-mode ()
 868   "Install the improved auto fill function, iff necessary."
 869   (if auto-fill-function
 870       (setq auto-fill-function 'noweb-auto-fill-doc-chunk)))
 871
 872 (defun noweb-auto-fill-code-mode ()
 873   "Install the default auto fill function, iff necessary."
 874   (if auto-fill-function
 875       (setq auto-fill-function 'do-auto-fill)))
 876 \f
 877 ;;; Marking
 878
 879 (defun noweb-mark-chunk ()
 880   "Mark the current chunk."
 881   (interactive)
 882   (let ((r (noweb-chunk-region)))
 883     (goto-char (car r))
 884     (push-mark (cdr r) nil t)))
 885
 886 (defun noweb-mark-chunk-pair ()
 887   "Mark the current pair of documentation and code chunks."
 888   (interactive)
 889   (let ((r (noweb-chunk-pair-region)))
 890     (goto-char (car r))
 891     (push-mark (cdr r) nil t)))
 892
 893 \f
 894 ;;; Narrowing
 895
 896 (defun noweb-toggle-narrowing (&optional arg)
 897   "Toggle if we should narrow the display to the current pair of
 898 documentation and code chunks after each movement.  With argument:
 899 switch narrowing on."
 900   (interactive "P")
 901   (if (or arg (not noweb-narrowing))
 902       (progn
 903         (setq noweb-narrowing t)
 904         (noweb-narrow-to-chunk-pair))
 905     (setq noweb-narrowing nil)
 906     (widen)))
 907
 908 (defun noweb-narrow-to-chunk ()
 909   "Narrow the display to the current chunk."
 910   (interactive)
 911   (let ((r (noweb-chunk-region)))
 912     (narrow-to-region (car r) (cdr r))))
 913
 914 (defun noweb-narrow-to-chunk-pair ()
 915   "Narrow the display to the current pair of documentation and code chunks."
 916   (interactive)
 917   (let ((r (noweb-chunk-pair-region)))
 918     (narrow-to-region (car r) (cdr r))))
 919
 920 \f
 921 ;;; Killing
 922
 923 (defun noweb-kill-chunk ()
 924   "Kill the current chunk."
 925   (interactive)
 926   (let ((r (noweb-chunk-region)))
 927     (kill-region (car r) (cdr r))))
 928
 929 (defun noweb-kill-chunk-pair ()
 930   "Kill the current pair of chunks."
 931   (interactive)
 932   (let ((r (noweb-chunk-pair-region)))
 933     (kill-region (car r) (cdr r))))
 934
 935 (defun noweb-copy-chunk-as-kill ()
 936   "Place the current chunk on the kill ring."
 937   (interactive)
 938   (let ((r (noweb-chunk-region)))
 939     (copy-region-as-kill (car r) (cdr r))))
 940
 941 (defun noweb-copy-chunk-pair-as-kill ()
 942   "Place the current pair of chunks on the kill ring."
 943   (interactive)
 944   (let ((r (noweb-chunk-pair-region)))
 945     (copy-region-as-kill (car r) (cdr r))))
 946
 947 \f
 948 ;;; Movement
 949
 950 (defun noweb-sign (n)
 951   "Return the sign of N."
 952   (if (< n 0) -1 1))
 953
 954 (defun noweb-next-doc-chunk (&optional cnt)
 955   "Goto to the Nth documentation chunk from point."
 956   (interactive "p")
 957   (widen)
 958   (let ((start (noweb-find-chunk-index-buffer))
 959         (i 1))
 960     (while (<= i (abs cnt))
 961       (setq start (+ (noweb-sign cnt) start))
 962       (while (noweb-chunk-is-code start)
 963         (setq start (+ (noweb-sign cnt) start)))
 964       (setq i (1+ i)))
 965     (goto-char (marker-position (cdr (noweb-chunk-vector-aref start))))
 966     (forward-char 1))
 967   (if noweb-narrowing
 968       (noweb-narrow-to-chunk-pair)))
 969
 970 (defun noweb-previous-doc-chunk (&optional n)
 971   "Goto to the -Nth documentation chunk from point."
 972   (interactive "p")
 973   (noweb-next-doc-chunk (- n)))
 974
 975 (defun noweb-next-code-chunk (&optional cnt)
 976   "Goto to the Nth code chunk from point."
 977   (interactive "p")
 978   (widen)
 979   (let ((start (noweb-find-chunk-index-buffer))
 980         (i 1))
 981     (while (<= i (abs cnt))
 982       (setq start (+ (noweb-sign cnt) start))
 983       (while (not (noweb-chunk-is-code start))
 984         (setq start (+ (noweb-sign cnt) start)))
 985       (setq i (1+ i)))
 986     (goto-char (marker-position (cdr (noweb-chunk-vector-aref start))))
 987     (next-line 1))
 988   (if noweb-narrowing
 989       (noweb-narrow-to-chunk-pair)))
 990
 991 (defun noweb-previous-code-chunk (&optional n)
 992   "Goto to the -Nth code chunk from point."
 993   (interactive "p")
 994   (noweb-next-code-chunk (- n)))
 995
 996 (defun noweb-next-chunk (&optional n)
 997   "If in a documentation chunk, goto to the Nth documentation
 998 chunk from point, else goto to the Nth code chunk from point."
 999   (interactive "p")
1000   (if (noweb-in-code-chunk)
1001       (noweb-next-code-chunk n)
1002     (noweb-next-doc-chunk n)))
1003
1004 (defun noweb-previous-chunk (&optional n)
1005   "If in a documentation chunk, goto to the -Nth documentation
1006 chunk from point, else goto to the -Nth code chunk from point."
1007   (interactive "p")
1008   (noweb-next-chunk (- n)))
1009
1010 (defvar noweb-chunk-history nil
1011   "")
1012
1013 (defun noweb-goto-chunk ()
1014   "Goto the named chunk."
1015   (interactive)
1016   (widen)
1017   (let* ((completion-ignore-case t)
1018          (alist (noweb-build-chunk-alist))
1019          (chunk (completing-read
1020                  "Chunk: " alist nil t
1021                  (noweb-goto-chunk-default)
1022                  noweb-chunk-history)))
1023     (goto-char (cdr (assoc chunk alist))))
1024   (if noweb-narrowing
1025       (noweb-narrow-to-chunk-pair)))
1026
1027 (defun noweb-goto-chunk-default ()
1028   (save-excursion
1029     (if (re-search-backward "<<"
1030                             (save-excursion
1031                               (beginning-of-line)
1032                               (point))
1033                             'move)
1034         (goto-char (match-beginning 0)))
1035     (if (re-search-forward "<<\\(.*\\)>>"
1036                            (save-excursion
1037                              (end-of-line)
1038                              (point))
1039                            t)
1040         (buffer-substring (match-beginning 1) (match-end 1))
1041       nil)))
1042
1043 (defun noweb-build-chunk-alist ()
1044   (if (not noweb-chunk-vector)
1045       (noweb-update-chunk-vector))
1046   ;; The naive recursive solution will exceed MAX-LISP-EVAL-DEPTH in
1047   ;; buffers w/ many chunks.  Maybe there is a tail recursivce solution,
1048   ;; but iterative solutions should be acceptable for dealing with vectors.
1049   (let ((alist nil)
1050         (i (1- (length noweb-chunk-vector))))
1051     (while (>= i 0)
1052       (let* ((chunk (aref noweb-chunk-vector i))
1053              (name (car chunk))
1054              (marker (cdr chunk)))
1055         (if (and (stringp name)
1056                  (not (assoc name alist)))
1057             (setq alist (cons (cons name marker) alist))))
1058       (setq i (1- i)))
1059     alist))
1060
1061 (defun noweb-goto-next (&optional cnt)
1062   "Goto the continuation of the current chunk."
1063   (interactive "p")
1064   (widen)
1065   (if (not noweb-chunk-vector)
1066       (noweb-update-chunk-vector))
1067   (let ((start (noweb-find-chunk-index-buffer)))
1068     (if (not (noweb-chunk-is-code  start))
1069         (setq start (1+ start)))
1070     (if (noweb-chunk-is-code start)
1071         (let ((name (car (noweb-chunk-vector-aref start)))
1072               (i 1))
1073           (while (<= i (abs cnt))
1074             (setq start (+ (noweb-sign cnt) start))
1075             (while (not (equal (car (noweb-chunk-vector-aref start))
1076                                name))
1077               (setq start (+ (noweb-sign cnt) start)))
1078             (setq i (1+ i)))
1079           (goto-char (marker-position
1080                       (cdr (noweb-chunk-vector-aref start))))
1081           (next-line 1))))
1082   (if noweb-narrowing
1083       (noweb-narrow-to-chunk-pair)))
1084
1085 (defun noweb-goto-previous (&optional cnt)
1086   "Goto the previous chunk."
1087   (interactive "p")
1088   (noweb-goto-next (- cnt)))
1089
1090 (defun noweb-occur (arg)
1091   "Find all occurences of the current chunk.
1092 This function simply runs OCCUR on \"<<NAME>>\"."
1093   (interactive "P")
1094   (let ((n (if (and arg
1095                     (numberp arg))
1096                arg
1097              0))
1098         (idx (noweb-find-chunk-index-buffer)))
1099     (if (noweb-chunk-is-code idx)
1100         (occur (regexp-quote (concat "<<"
1101                                      (car (aref noweb-chunk-vector idx))
1102                                      ">>"))
1103                n)
1104       (setq idx (1+ idx))
1105       (while (not (noweb-chunk-is-code idx))
1106         (setq idx (1+ idx)))
1107       (occur (regexp-quote (concat "<<"
1108                                    (car (aref noweb-chunk-vector idx))
1109                                    ">>"))
1110                            n))))
1111
1112 \f
1113 ;;; Insertion
1114
1115 (defun noweb-new-chunk (name)
1116   "Insert a new chunk."
1117   (interactive "sChunk name: ")
1118   (insert "@ \n<<" name ">>=\n")
1119   (save-excursion
1120     (insert "@ %def \n"))
1121   (noweb-update-chunk-vector))
1122
1123 (defun noweb-at-beginning-of-line ()
1124   (equal (save-excursion
1125            (beginning-of-line)
1126            (point))
1127          (point)))
1128
1129 (defun noweb-electric-@ (arg)
1130   "Smart incarnation of `@', starting a new documentation chunk, maybe.
1131 If given an numerical argument, it will act just like the dumb `@'.
1132 Otherwise and if at the beginning of a line in a code chunk:
1133 insert \"@ \" and update the chunk vector."
1134   (interactive "P")
1135   (if arg
1136       (self-insert-command (if (numberp arg) arg 1))
1137     (if (and (noweb-at-beginning-of-line)
1138              (noweb-in-code-chunk))
1139         (progn
1140           (insert "@ ")
1141           (noweb-update-chunk-vector))
1142       (self-insert-command 1))))
1143
1144 (defun noweb-electric-< (arg)
1145   "Smart incarnation of `<', starting a new code chunk, maybe.
1146 If given an numerical argument, it will act just like the dumb `<'.
1147 Otherwise and if at the beginning of a line in a documentation chunk:
1148 insert \"<<>>=\" and a newline if necessary.  Leave point in the middle
1149 and and update the chunk vector."
1150   (interactive "P")
1151   (if arg
1152       (self-insert-command (if (numberp arg) arg 1))
1153     (if (and (noweb-at-beginning-of-line)
1154              (not (stringp (car (noweb-find-chunk)))))
1155         (progn
1156           (insert "<<")
1157           (save-excursion
1158             (insert ">>=")
1159             (if (not (looking-at "\\s *$"))
1160                 (newline)))
1161           (noweb-update-chunk-vector))
1162       (self-insert-command 1))))
1163
1164 \f
1165 ;;; Modes
1166
1167 (defun noweb-set-chunk-code-mode ()
1168   "Set the noweb-code-mode for the current chunk"
1169   (interactive)
1170   (if (noweb-in-code-chunk)
1171       (progn
1172         ;; Reset code-mode to default and then check for a mode comment.
1173         (setq noweb-code-mode noweb-default-code-mode)
1174         (let (mode chunk-name)
1175           (save-restriction
1176             (save-excursion
1177               (end-of-line)
1178               (re-search-backward "^[ \t]*<<\\(.*\\)>>=" nil t)
1179               (setq chunk-name (match-string 1))
1180               (widen)
1181               (goto-char (point-min))
1182               (re-search-forward (concat "^<<" chunk-name ">>=") nil t)
1183               (beginning-of-line 2)
1184               (setq mode (noweb-in-mode-line))
1185               (if (functionp mode)
1186                   (setq noweb-code-mode mode))))))
1187     (error "This only makes sense in a code chunk")))
1188
1189 (defun noweb-set-doc-syntax-table ()
1190   "Sets the doc-mode syntax-table to treat code quotes as comments."
1191   (interactive)
1192   (let ((square-bracket-string (char-to-string (char-syntax ?\[))))
1193     (if (string= square-bracket-string "(")
1194         (progn
1195           (modify-syntax-entry ?\[ "(]12b" noweb-doc-mode-syntax-table)
1196           (modify-syntax-entry ?\] ")[34b" noweb-doc-mode-syntax-table))
1197       (progn
1198         (modify-syntax-entry  ?\[
1199                               (concat square-bracket-string " 12b")
1200                               noweb-doc-mode-syntax-table)
1201         (modify-syntax-entry  ?\]
1202                               (concat square-bracket-string " 34b")
1203                               noweb-doc-mode-syntax-table)))))
1204
1205 (defun noweb-select-mode ()
1206   "Select NOWEB-DOC-MODE or NOWEB-CODE-MODE, as appropriate."
1207   (interactive)
1208   (let ((this-chunk-index (noweb-find-chunk-index-buffer)))
1209     ;; Has the last change to the buffer taken us into a different
1210     ;; chunk ?
1211     (if (not (equal this-chunk-index noweb-last-chunk-index))
1212         (progn
1213           (setq noweb-last-chunk-index this-chunk-index)
1214           (if (noweb-in-code-chunk)
1215               ;; Inside a code chunk
1216               (progn
1217                 ;; Find out which code mode to use
1218                 (noweb-set-chunk-code-mode)
1219                 ;; If we aren't already using it, use it.
1220                 (if (not (equal major-mode noweb-code-mode))
1221                     (progn
1222                       (funcall noweb-code-mode)
1223                       (run-hooks 'noweb-select-mode-hook)
1224                       (run-hooks 'noweb-select-code-mode-hook))))
1225             ;; Inside a documentation chunk
1226             (progn
1227               (if (not (equal major-mode noweb-doc-mode))
1228                   (progn
1229                     (funcall noweb-doc-mode)))
1230               (if (not noweb-doc-mode-syntax-table)
1231                   (progn
1232                     (message "Setting up syntax table")
1233                     (setq noweb-doc-mode-syntax-table
1234                           (make-syntax-table (syntax-table)))
1235                     (noweb-set-doc-syntax-table)))
1236               (set-syntax-table noweb-doc-mode-syntax-table)
1237               (run-hooks 'noweb-select-mode-hook)
1238               (run-hooks 'noweb-select-doc-mode-hook)))
1239           (run-hooks 'noweb-changed-chunk-hook)))))
1240
1241 (defvar noweb-doc-mode noweb-default-doc-mode
1242   "Default major mode for editing noweb documentation chunks.
1243 It is not possible to have more than one doc-mode in a file.
1244 However, this variable is used to determine whether the doc-mode needs
1245 to by added to the mode-line")
1246
1247 (defun noweb-set-doc-mode (mode)
1248   "Change the major mode for editing documentation chunks."
1249   (interactive "CNew major mode for documentation chunks: ")
1250   (setq noweb-doc-mode mode)
1251   (setq noweb-doc-mode-syntax-table nil)
1252   ;;Pretend we've changed chunk, so the mode will be reset if necessary
1253   (setq noweb-last-chunk-index (1- noweb-last-chunk-index))
1254   (noweb-select-mode))
1255
1256 (defun noweb-set-code-mode (mode)
1257   "Change the major mode for editing all code chunks."
1258   (interactive "CNew major mode for all code chunks: ")
1259   (setq noweb-default-code-mode mode)
1260   ;;Pretend we've changed chunk, so the mode will be reset if necessary
1261   (setq noweb-last-chunk-index (1- noweb-last-chunk-index))
1262   (noweb-select-mode))
1263
1264 (defun noweb-set-this-code-mode (mode)
1265   "Change the major mode for editing this code chunk.
1266 The only sensible way to do this is to add a mode line to the chunk"
1267   (interactive "CNew major mode for this code chunk: ")
1268   (if (noweb-in-code-chunk)
1269       (progn
1270         (setq noweb-code-mode mode)
1271         (save-restriction
1272           (save-excursion
1273             (let (chunk-name)
1274               (widen)
1275               (end-of-line)
1276               (re-search-backward "^[ \t]*<<\\(.*\\)>>=" nil t)
1277               (setq chunk-name (match-string 1))
1278               (goto-char (point-min))
1279               (re-search-forward (concat "^<<" chunk-name ">>=") nil t)
1280               (beginning-of-line 2))
1281             ;; remove mode-line, if there is one
1282             (if (noweb-in-mode-line)
1283                 (progn
1284                   (kill-line)
1285                   (kill-line)))
1286             (if (not (equal noweb-code-mode noweb-default-code-mode))
1287                 (progn
1288                   (setq mode (substring (symbol-name mode) 0 -5))
1289                   ;; Need to set major mode so that we can comment out
1290                   ;; the mode line
1291                   (funcall noweb-code-mode)
1292                   (if (not (boundp 'comment-start))
1293                       (setq comment-start "#"))
1294                   (insert comment-start
1295                           " -*- " mode
1296                           " -*- " comment-end "\n")))
1297             (setq noweb-last-chunk-index (1- noweb-last-chunk-index)))))
1298     (message "This only makes sense in a code chunk.")))
1299 \f
1300 ;;; Misc
1301
1302 (defun noweb-mode-version ()
1303   "Echo the RCS identification of noweb mode."
1304   (interactive)
1305   (message "Thorsten's noweb-mode (PRERELEASE). RCS: %s"
1306            noweb-mode-RCS-Id))
1307
1308 (defun noweb-describe-mode ()
1309   "Describe noweb mode."
1310   (interactive)
1311   (describe-function 'noweb-mode))
1312
1313 (defun noweb-insert-default-mode-line ()
1314   "Insert line that will set the noweb mode of this file in emacs.
1315 The file is set to use the current doc and default-code modes, so
1316 ensure they are set correctly (with noweb-set-code-mode and
1317 noweb-set-doc-mode) before calling this function"
1318   (interactive)
1319   (save-excursion
1320     (goto-char 1)
1321     (if (noweb-in-mode-line)
1322         (progn
1323           (kill-line)
1324           (kill-line)))
1325     (if (not (eq major-mode noweb-doc-mode))
1326         (noweb-select-mode))
1327     (insert comment-start " -*- mode: noweb; noweb-default-code-mode: "
1328             (symbol-name noweb-default-code-mode)
1329             (if (not (eq noweb-doc-mode noweb-default-doc-mode))
1330                 (concat "; noweb-doc-mode: " (symbol-name
1331                                               noweb-doc-mode) ";")
1332               ";")
1333             " -*-" comment-end "\n"))
1334   (noweb-select-mode))
1335
1336 (defun noweb-mouse-first-button (event)
1337   (interactive "e")
1338   (mouse-set-point event)
1339   (if (and noweb-use-mouse-navigation
1340            (eq (save-excursion
1341                  (end-of-line)
1342                  (re-search-backward "^[\t ]*\\(<<\\)\\(.*\\)\\(>>\\)" nil t))
1343                (save-excursion
1344                  (beginning-of-line) (point))))
1345       (progn
1346 (if (< (point) (match-beginning 2))
1347             (let ((chunk-name (buffer-substring-no-properties
1348                                (match-beginning 2)
1349                                (match-end 2))))
1350               (re-search-backward (concat "<<" chunk-name ">>") nil t))
1351           (if (and (<= (match-end 2) (point))
1352                    (>  (+ 2 (match-end 2)) (point)))
1353               (let ((chunk-name (buffer-substring-no-properties
1354                                  (match-beginning 2)
1355                                  (match-end 2))))
1356                 (re-search-forward (concat "<<" chunk-name ">>") nil t)))))))
1357
1358 \f
1359 ;;; Debugging
1360
1361 (defun noweb-log (s)
1362   (let ((b (current-buffer)))
1363     (switch-to-buffer (get-buffer-create "*noweb-log*"))
1364     (goto-char (point-max))
1365     (setq buffer-read-only nil)
1366     (insert s)
1367     (setq buffer-read-only t)
1368     (switch-to-buffer b)))
1369
1370
1371
1372
1373
1374 (defvar noweb-thread-alist nil
1375   "A list of threads in the current buffer.
1376 Each entry in the list contains 5 elements:
1377 1) The name of the threads
1378 2) The name of the immdiate parent thread in which it is used (nil if
1379    it is a \"top-level\" thread which is not used anywhere).
1380 3) The name of the top-level parent thread in which it is used (i.e. a
1381    thread in which it is used but which is not itself used anywhere:
1382    nil if this thread is not used anywhere.
1383 4) The format string to use to define line numbers in the output
1384    file of this thread. Should only be set if this thread is not used
1385    anywhere: if a thread is used as part of another thread, the parent
1386    thread's format string should be used.
1387 5) If this is nil, tabs are converted to spaces in the tangled
1388    file. If it is a number, tabs are copied to the tangled file
1389    unchanged, and tabs are also used for indentation, with the number
1390    of spaces per tab defined by this number. This MUST be set in order
1391    to tangle makefiles, which depend on tabs.Should only be set if
1392    this thread is not used anywhere. otherwise set to nil. "
1393 )
1394
1395 (defun noweb-update-thread-alist ()
1396   "Updates the list of threads in the current buffer.
1397 Each entry in the list contains 5 elements:
1398 1) The name of the thread
1399 2) The name of the immdiate parent thread in which it is used (nil if
1400    it is a \"top-level\" thread which is not used anywhere).
1401 3) The name of the top-level parent thread in which it is used (i.e. a
1402    thread in which it is used but which is not itself used anywhere:
1403    nil if this thread is not used anywhere.
1404 4) The format string to use to define line numbers in the output
1405    file of this thread. Should only be set if this thread is not used
1406    anywhere: if a thread is used as part of another thread, the parent
1407    thread's format string should be used.
1408 5) If this is nil, tabs are converted to spaces in the tangled
1409    file. If it is a number, tabs are copied to the tangled file
1410    unchanged, and tabs are also used for indentation, with the number
1411    of spaces per tab defined by this number. This MUST be set in order
1412    to tangle makefiles, which depend on tabs.Should only be set if
1413    this thread is not used anywhere. otherwise set to nil. "
1414   (interactive)
1415   (save-excursion
1416     (goto-char (point-min))
1417     (let ((thread-alist) (thread-list-entry) (chunk-use-name)
1418           (current-thread) (new-thread-alist))
1419       (while (re-search-forward
1420               "^[ \t]*<<\\(.*\\)>>\\(=\\)?" nil t)
1421         (goto-char (match-beginning 0))
1422         ;; Is this the definition of a chunk ?
1423         (if (match-beginning 2)
1424             ;;We have a chunk definition
1425             (progn
1426               ;; Get the thread name
1427               (setq current-thread
1428                     (buffer-substring-no-properties (match-beginning 1)
1429                                                     (match-end 1)))
1430               ;; Is this thread already in our list ?
1431               (if (assoc current-thread thread-alist)
1432                   nil
1433                 (progn
1434                   ;; If not, create an entry with 4 nils at the end
1435                   (setq thread-list-entry
1436                         (list (cons current-thread
1437                                     (make-list 4 nil))))
1438                   ;; And add it to the list
1439                   (setq thread-alist
1440                         (append thread-alist thread-list-entry)))))
1441
1442             ;; Not a definition but a use
1443             (progn
1444               ;; Get the thread name
1445                 (setq chunk-use-name
1446                     (buffer-substring-no-properties (match-beginning 1)
1447                                                     (match-end 1)))
1448               ;; Has the thread already been defined before being used ?
1449               (if (setq thread-list-entry (assoc chunk-use-name
1450                                                  thread-alist))
1451                   ;; If it has, set its parent to be the thread we are in at the moment
1452                   (setcar (cdr thread-list-entry) current-thread)
1453                 ;; If not, add it to the list, with its parent name and 3 nils
1454                 (progn
1455                   (setq thread-list-entry
1456                         (list (cons chunk-use-name
1457                                     (cons current-thread
1458                                           (make-list 3 nil)))))
1459                   (setq thread-alist (append thread-alist thread-list-entry)))))
1460 )
1461         ;;Go to the next line
1462         (beginning-of-line 2))
1463       ;; Now, the second element of each entry points to that thread's
1464       ;; immediate parent. Need to set it to the thread's ultimate
1465       ;; parent.
1466       (let ((thread-counter 0)
1467             (this-thread)
1468             (this-thread-parent))
1469         (while (<= thread-counter (1- (length thread-alist)))
1470           (setq this-thread (nth thread-counter thread-alist))
1471           (setq this-thread-parent (assoc
1472                                     (car (cdr this-thread))
1473                                     thread-alist))
1474           (while (not (equal nil (car (cdr this-thread-parent))))
1475             (setq this-thread-parent (assoc
1476                                       (car (cdr this-thread-parent))
1477                                       thread-alist)))
1478           (setq this-thread (cons (car this-thread)
1479                                   (cons (car (cdr this-thread))
1480                                         (cons (car this-thread-parent)
1481                                               (nthcdr 2 this-thread)))))
1482           (setq new-thread-alist (append new-thread-alist (list this-thread)))
1483           (setq thread-counter (1+ thread-counter))))
1484
1485       (setq noweb-thread-alist new-thread-alist))))
1486
1487
1488 ; Option setting functions to go here
1489
1490 (defun noweb-set-thread-line-format ())
1491
1492 (defun noweb-set-thread-tabs ())
1493
1494
1495 (defvar noweb-default-line-number-format nil
1496   "The format string to use to  define line numbers in this thread.
1497 If nil, do  not use line numbers.")
1498
1499 (defvar noweb-default-line-number-skip-lines 0
1500   "The number of initial lines to output before the line number.
1501 This may be useful in shell scripts, where the first line (or two) must have a
1502   specific form.")
1503
1504 (defvar noweb-default-tab-width 8
1505   "If a number, convert tabs to  that number of spaces in the output. If nil, let tabs through to the output unaltered.")
1506
1507 (defvar noweb-line-number-format  noweb-default-line-number-format
1508   "The format string to use to  define line numbers in this thread.
1509 If nil, do  not use line numbers.")
1510
1511 (defvar noweb-line-number-skip-lines noweb-default-line-number-skip-lines
1512   "The number of initial lines to output before the line number.
1513 This may be useful in shell scripts, where the first line (or two) must have a
1514   specific form.")
1515
1516 (defvar noweb-tab-width  noweb-default-tab-width
1517   "If a number, convert tabs to  that number of spaces in the output. If nil, let tabs through to the output unaltered.")
1518
1519 (defun noweb-get-thread-local-variables ()
1520   "Get the values of the variables that are local to a thread."
1521   (interactive)
1522   (save-restriction
1523     (save-excursion
1524       (end-of-line)
1525       (re-search-backward "^[ \t]*<<\\(.*\\)>>=" nil t)
1526       (let ((chunk-name (match-string 1)))
1527         (widen)
1528         (goto-char (point-min))
1529         (re-search-forward (concat "^<<" chunk-name ">>=") nil t)
1530         (beginning-of-line 2)
1531         (while (looking-at ".*-\*-.*-\*-")
1532           (let ((this-line (buffer-substring-no-properties
1533                             (point)
1534                             (progn (end-of-line) (point)))))
1535             (if (string-match
1536                  "mode:[ \t]*\\([^\t ]*\\)" this-line)
1537                 (setq noweb-code-mode
1538                       (if (featurep 'xemacs)
1539                           (match-string 1 this-line)
1540                         (match-string-no-properties 1 this-line))
1541                       ))
1542             (if (string-match
1543                  "noweb-line-number-format:[ \t]*\"\\([^\"]*\\)\"" this-line)
1544                 (setq noweb-line-number-format
1545                       (if (featurep 'xemacs)
1546                           (match-string 1 this-line)
1547                         (match-string-no-properties 1 this-line))
1548                       ))
1549             (if (string-match
1550                  "noweb-line-number-skip-lines:[ \t]*\\([^\t ]*\\)" this-line)
1551                 (setq noweb-line-number-skip-lines
1552                       (string-to-number
1553                       (if (featurep 'xemacs)
1554                           (match-string 1 this-line)
1555                         (match-string-no-properties 1 this-line)))))
1556             (if (string-match
1557                  "noweb-tab-width:[ \t]*\\([^\t ]*\\)" this-line)
1558                 (setq noweb-tab-width
1559                       (string-to-number
1560                       (if (featurep 'xemacs)
1561                           (match-string 1 this-line)
1562                         (match-string-no-properties 1 this-line)))))
1563             (beginning-of-line 2)))))))
1564
1565 (defun noweb-reset-thread-local-variables ()
1566   "Resets the thread-local variables to their default values"
1567   (setq noweb-tab-width noweb-default-tab-width)
1568   (setq noweb-line-number-format noweb-default-line-number-format)
1569   (setq noweb-line-number-skip-lines noweb-default-line-number-skip-lines))
1570
1571 (defun noweb-write-line-number (line-number-format buffer)
1572   (if line-number-format
1573       (progn
1574         (let ((this-line (count-lines (point-min)(point))))
1575           (while (string-match ".*\\(%L\\).*" line-number-format)
1576             (setq line-number-format
1577                   (replace-match
1578                    (format "%d" this-line) t t line-number-format 1)))
1579           (while (string-match ".*\\(%F\\).*" line-number-format)
1580             (setq line-number-format
1581                   (replace-match
1582                    (format "%s" (buffer-file-name)) t t line-number-format 1)))
1583           (while (string-match ".*\\(%N\\).*" line-number-format)
1584             (setq line-number-format
1585                   (replace-match "\n" t t line-number-format 1)))
1586           (save-excursion
1587             (set-buffer buffer)
1588             (insert line-number-format))))))
1589
1590
1591 (defun noweb-tangle-chunk ( &optional buffer prefix-string)
1592   "Generate the code produced by this chunk, & any threads used in this chunk."
1593   (interactive)
1594   (save-excursion
1595     (noweb-reset-thread-local-variables)
1596     (noweb-get-thread-local-variables)
1597     (noweb-update-chunk-vector)
1598     (let*
1599         ((chunk-end (progn
1600                       (end-of-line)
1601                       (re-search-forward "^@" nil t)
1602                       (beginning-of-line)
1603                       (point)))
1604          ;;get name and start point of this chunk
1605          (chunk-start (progn
1606                         (re-search-backward "^<<\\([^>]*\\)>>=$" nil t)
1607                         (beginning-of-line 2)
1608                         (point)))
1609          (chunk-name (buffer-substring-no-properties
1610                       (match-end 1)
1611                       (match-beginning 1)))
1612          ;; get end of this chunk
1613          ;; Get information we need about this thread
1614          (thread-info (assoc chunk-name noweb-thread-alist))
1615          (thread-tabs (nth 4 thread-info))
1616          (line-number-format (nth 3 thread-info))
1617          (thread-name-re) (post-chunk) (pre-chunk)
1618          (first-line t)
1619          (tangle-buffer (generate-new-buffer "Tangle Buffer")))
1620
1621         (progn
1622           (goto-char chunk-start)
1623           ;; If this is a mode-line, ignore it
1624           (while (looking-at ".*-\\*-.*-\\*-")
1625             (beginning-of-line 2))
1626           ;; If we want to include line numbers, write one
1627           (if line-number-format
1628               (while (> noweb-line-number-skip-lines 0)
1629                 (append-to-buffer tangle-buffer
1630                                   (point)
1631                                   (save-excursion
1632                                     (progn
1633                                       (end-of-line)
1634                                       (point))))
1635                 (beginning-of-line 2)
1636                 (1- noweb-line-number-skip-lines))
1637             (noweb-write-line-number line-number-format buffer))
1638           (message "Now at %d" (point))
1639
1640           (while (< (point) chunk-end)
1641             (untabify (point) (save-excursion (beginning-of-line 2)(point)))
1642             ;; This RE gave me trouble. Without the `\"', it
1643             ;; recognised itself and so could not copy itself
1644             ;; correctly.
1645             (if (looking-at
1646                  "\\([^\n\"@]*\\)<<\\(.*\\)\\(>>\\)\\([^\n\"]*\\)$")
1647                 (progn
1648                   (save-restriction
1649                     (save-excursion
1650                       (setq thread-name-re
1651                             (concat "<<"
1652                                     (match-string 2)
1653                                     ">>="))
1654                       (setq pre-chunk (match-string 1))
1655                       (if prefix-string
1656                           (setq pre-chunk (concat prefix-string
1657                                                   pre-chunk)))
1658                       (setq post-chunk (match-string 4))
1659                       (widen)
1660                       (goto-char (point-min))
1661                       (while (re-search-forward thread-name-re nil t)
1662                         (noweb-tangle-chunk tangle-buffer pre-chunk)
1663                         (next-line 1)))
1664                     (if post-chunk
1665                         (save-excursion
1666                           (set-buffer tangle-buffer)
1667                           (backward-char)
1668                           (insert post-chunk)
1669                           (beginning-of-line 2)))))
1670
1671                 ;; Otherwise, just copy this line
1672                 (setq pre-chunk
1673                       (buffer-substring
1674                        (point)
1675                        (save-excursion
1676                          (beginning-of-line 2)
1677                          (point))))
1678                 ;; Add a prefix if necessary
1679                 (if (and prefix-string
1680                          (> (length pre-chunk) 1))
1681                     (setq pre-chunk (concat prefix-string
1682                                             pre-chunk)))
1683                 ;; And copy it to the buffer
1684                 (save-excursion
1685                   (set-buffer tangle-buffer)
1686                   (insert pre-chunk)))
1687             ;; If this is the first line of the chunk, we need to change
1688             ;; prefix-string to consist solely of spaces
1689             (if (and first-line
1690                      prefix-string)
1691                 (progn
1692                   (setq prefix-string
1693                         (make-string (length prefix-string) ?\  ))
1694                   (setq first-line nil)))
1695             ;; Either way, go to the next line
1696             (beginning-of-line 2))
1697
1698           (save-excursion
1699             (set-buffer tangle-buffer)
1700             (goto-char (point-min))
1701             (while (re-search-forward "\@\<<" nil t)
1702               (replace-match "<<" nil nil)
1703               (forward-char 3))
1704             (if thread-tabs
1705               (progn
1706                   (setq tab-width thread-tabs)
1707                   (tabify (point-min)(point-max)))
1708               (untabify (point-min)(point-max))))
1709
1710           (if buffer
1711               (save-excursion
1712                 (set-buffer buffer)
1713                 (insert-buffer-substring tangle-buffer)
1714                 (kill-buffer tangle-buffer)))
1715 ))))
1716
1717 (defun noweb-tangle-thread ( name &optional buffer)
1718   "Given the name of a thread, tangles the thread to buffer.
1719 If no buffer is given, create a new one with the same name as the
1720 thread."
1721   (interactive "sWhich thread ? ")
1722   (if (not buffer)
1723       (progn
1724         (setq buffer (get-buffer-create name))
1725         (save-excursion
1726           (set-buffer buffer)
1727           (erase-buffer))))
1728   (save-excursion
1729     (goto-char (point-min))
1730     (let ((chunk-counter 0))
1731       (while (re-search-forward
1732               "^<<\\(.*\\)>>=[\t ]*" nil t)
1733         (if (string= (match-string 1)
1734                      name)
1735             (progn
1736               (setq chunk-counter (1+ chunk-counter))
1737               (message "Found %d chunks" chunk-counter)
1738               (noweb-tangle-chunk buffer)))))))
1739
1740 (defun noweb-tangle-current-thread ( &optional buffer)
1741   (interactive)
1742   (save-excursion
1743     (let* ((chunk-start
1744             (progn
1745               (re-search-backward "^<<\\([^>]*\\)>>=[\t ]*$"
1746                                   nil t)
1747               (beginning-of-line 2)
1748               (point)))
1749            (chunk-name (buffer-substring-no-properties
1750                         (match-end 1)
1751                         (match-beginning 1))))
1752       (noweb-tangle-thread chunk-name buffer))))
1753 ;menu functions
1754
1755 \f
1756 ;;; Finale
1757
1758 (run-hooks 'noweb-mode-load-hook)
1759 (provide 'noweb-mode)
1760
1761 ;; Changes made by Mark Lunt (mark.lunt@mrc-bsu.cam.ac.uk) 22/03/1999
1762
1763 ;; The possibility of having code chunks using more than one language
1764 ;; was added. This was first developed by Adnan Yaqub
1765 ;; (AYaqub@orga.com) for syntax highlighting, but even people who hate
1766 ;; highlighting may like to maintain their Makefile with their code,
1767 ;; or test-scripts with their programs, or even user documentation as
1768 ;; latex-mode code chunks.
1769 ;; This required quite a few changes to noweb-mode:
1770 ;; 1) A new variable `noweb-default-code-mode' was create to do the job
1771 ;;    `noweb-code-mode' used to.
1772 ;; 2) noweb-code-mode now contains the code-mode of the current chunk
1773 ;; 3) Each chunk can now have its own mode-line to tell emacs what
1774 ;;    mode to use to edit it. The function `noweb-in-mode-line'
1775 ;;    recognises such mode-lines, and the function
1776 ;;    `noweb-set-this-code-mode' sets the code mode for the current
1777 ;;    chunk and adds a mode-line if necessary. If several chunks have
1778 ;;    the same name, the mode-line must appear in the first chunk with
1779 ;;    that name.
1780 ;; 4) The mechanism for deciding whether to change mode was altered,
1781 ;;    since the old method assumed a single code mode. Now,
1782 ;;    `noweb-last-chunk-index' keeps track of which chunk we were in
1783 ;;    last. If we have moved to a different chunk, we have to check
1784 ;;    which mode we should be in, and change if necessary.
1785
1786 ;; The keymap and menu-map handling was changed. Easymenu was used to
1787 ;; define the menu, and it the keymap was attached to the 'official'
1788 ;; minor-modes-keymaps list. This means that
1789 ;; 1) It was automatically loaded when noweb-mode was active and
1790 ;;    unloaded when it was inactive.
1791 ;; 2) There was no need to worry about the major mode map clobbering
1792 ;;    it , since it takes precedence over the major mode
1793 ;;    map. `noweb-setup-keymap' is therefore now superfluous
1794 ;; The menu was also reorganised to make it less cluttered, so there
1795 ;; would be room for adding tangling and weaving commands (one day).
1796
1797 ;; Mouse navigation (at least under Emacs (AJR)) is supported, in so
1798 ;; far as clicking mouse-1 on the '<<' of a chunk name moves to the
1799 ;; previous instance of that chunk name, and clicking in the '>>'
1800 ;; moves to the next instance. They are not mouse-hightlighted,
1801 ;; though: too much hassle for zero added functionality.
1802
1803 ;; noweb-doc-mode has been given its own syntax-table. It is the same
1804 ;; as the current doc-mode syntax-table, except that [[ is a comment
1805 ;; start and ]] a comment end. Fixes some ugliness in LaTeX-mode if
1806 ;; `$' or `%' appear in quoted code (or even `<<', which happens often
1807 ;; in C++).
1808 ;; (This should make noweb-hide-code-quotes and
1809 ;; noweb-restore-code-quotes unnecessary, but I have not yet removed
1810 ;; them, nor the calls to them).
1811
1812 ;; A new function `noweb-indent-line' was defined and bound by default
1813 ;; to the tab key. This should indent the current line correctly in
1814 ;; whichever mode we are currently in. Previously, c-mode in
1815 ;; particular did not behave well with indentation (although
1816 ;; `noweb-fill-chunk' worked fine). Indentation is only accurate
1817 ;; within the chunk: it does not know the syntax at the end of the
1818 ;; previous chunk, so it does not know where to start indenting in
1819 ;; this chunk. However, provided the indentation within each chunk is correct,
1820 ;; notangle will correctly indented code.
1821
1822 ;; (I think it would be good to separate filling and indenting,
1823 ;; though, since `indent-region' and `fill-region' have completely
1824 ;; different meanings in LaTeX-mode (and both are useful))
1825
1826 ;; noweb-mode and noweb-minor-mode were given an optional argument, so
1827 ;; that (noweb-mode -1) turns it off, (noweb-mode 1) turns it on, and
1828 ;; (noweb-mode) toggles it. This is considered normal for minor modes.
1829
1830 ;; buffer-substring changed to buffer-substring-no-properties:
1831 ;; comparisons with buffer-substring can be unreliable if highlighting
1832 ;; is used.
1833
1834 ;; New functions `noweb-in-code-chunk' & `noweb-chunk-is-code' created
1835 ;; to replace (if (stringp (car (noweb-find-chunk)))) and
1836 ;; (if (stringp (car (noweb-chunk-vector-aref index)))).
1837
1838 ;; `noweb-insert-mode-line' was renamed
1839 ;; `noweb-insert-default-mode-line' and modified to put the mode-line
1840 ;; at the start of the file and remove any existing mode-line.
1841
1842 ;; a '<=' in `noweb-find-chunk-index' changed to '<', so we get the
1843 ;; right answer if point is on the first character in a chunk
1844
1845 ;; The name of `noweb-post-command-hook' changed to
1846 ;; `noweb-post-command-function', since it is a function.
1847
1848 ;; All the highlighting code moved to a separate file:
1849 ;; (noweb-font-lock-mode.el)
1850
1851 ;; Menu driven tangling is in the process of being added. It can
1852 ;; currently tangle a single chunk or a series of  chunks with the
1853 ;; same name (which I refer to as a thread) into a separate
1854 ;; buffer. This buffer can then be saved to a file, sent to an
1855 ;; interpreter, whatever. I haven't tested using line-numbers as yet.