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