Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1938 lines
77 KiB

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