# ess / lisp / noweb-font-lock-mode.el

  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 ;; noweb-font-lock-mode.el - edit noweb files with GNU Emacs ;; Copyright (C) 1999 by Adnan Yaqub (AYaqub@orga.com) ;; and Mark Lunt (mark.lunt@mrc-bsu.cam.ac.uk ;; Copyright (C) 2002 by A.J. Rossini ;; Copyright (C) 2003--2004 A.J. Rossini, Rich M. Heiberger, Martin ;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen. ;; Maintainers: ESS-core ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; ;; ;;; Code-dependent highlighting ;; ***** ;; ;; Adding highlighting to noweb-mode.el ;; ;; Here is a description of how one can add highlighting via the ;; font-lock package to noweb buffers. It uses the hooks provided by ;; noweb-mode.el. The solution provides the following features: ;; 1) The documentation chunks are highlighted in the noweb-doc-mode ;; (e.g., LaTeX). ;; 2) The code chunks without mode comments (-*- mode -*-) are ;; highlighted in the noweb-code-mode. ;; 3) The code chunks with mode comments (-*- mode -*-) on the first ;; line of the first chunk with this name are highlighted in the mode ;; in the comment. ;; ;; For example, given the file: ;; ;; % -*- mode: Noweb; noweb-code-mode: c-mode -*- ;; ;; \begin{itemize} ;; \item a main routine written in C, ;; \item a log configuration file parser written in YACC, and ;; \item a lexical analyzer written in Lex. ;; \end{itemize} ;; ;; <>= ;; /* DO NOT EDIT ME! */ ;; /* This file was automatically generated from %W% (%G%). */ ;; @ ;; ;; <>= ;; .\" -*- nroff -*- ;; .\" DO NOT EDIT ME! ;; .\" This file was automatically generated from %W% (%G%). ;; @ ;; ;; The LaTeX list is highlighted in latex-mode (the default noweb doc ;; mode), the chunk <> is highlighted in c-mode (the ;; default noweb code mode), and the chunk <> is ;; highlighted in nroff-mode due to the "-*- nroff -*-" comment. ;; ;; Chunks are highlighted each time point moves into them from a ;; different mode. They are also fontified 'on the fly', but this is ;; less reliable, since the syntax can depend on the context. It's as ;; good as you would get outside noweb-mode, though. ;; ;; To use it, you must add ;; (require noweb-font-lock-mode) to your .emacs file. ;; Then, if you use either global-font-lock or turn-on-font-lock ;; statements, any noweb-mode buffers will be fontified ;; appropriately. (We have to redefine turn-on-font-lock, but it ;; saves breaking other packages (in particular ESS, which I use a ;; lot), that assume that turn-on-font-lock is the way to turn on ;; font locking. ;; Alternatively, you can turn noweb-font-lock-mode on and off by ;; using M-x noweb-font-lock-mode. However, turning ;; noweb-font-lock-mode off when global-font-lock-mode is t makes it ;; impossible to use font-locking in that buffer subsequently, other ;; than by turning noweb-font-lock-mode back on. ;; 2) The highlighting sometimes get confused, but this is no longer ;; a noweb problem. Highlighting should work as well within a chunk ;; as it does without noweb-mode. ;; There are some problems with, for example latex-mode: a \$' in a ;; verbatim environment with throw the font-locking out. ;; One slight blemish is that code-quotes are highlighted as comments ;; as they are being entered. They are only highlighted correctly ;; after noweb-font-lock-fontify-chunk' has been run, either as a ;; command or through changing to a different chunk and back again ;; (unless they lie on a single line, in which case they are ;; fontified correctly once they are completed). (require 'noweb-mode) (require 'font-lock) (defvar noweb-font-lock-mode nil "Buffer local variable, t iff this buffer is using noweb-font-lock-mode.") (defvar noweb-use-font-lock-mode t "DO NOT CHANGE THIS VARIABLE If you use nw-turn-on-font-lock to turn on font-locking, then turn it off again, it would come back on again of its own accord when you changed major-mode. This variable is used internally to stop it.") (defvar noweb-font-lock-mode-hook nil "Hook that is run after entering noweb-font-lock mode.") (defvar noweb-font-lock-max-initial-chunks 2 "Maximum number of chunks to fontify initially. If nil, will fontify the entire buffer when noweb-font-lock-initial-fontify-buffer is called" ) (defvar old-beginning-of-syntax nil "Stores the function used to find the beginning of syntax in the current major mode. noweb-font-lock-mode needs a different one." ) ;; (AJR) the next two lines were originally font-lock-warning-face ;; methods; XEmacs 20.4 doesn't define this, sigh... -- KLUDGE --. (defvar noweb-font-lock-doc-start-face font-lock-reference-face "Face to use to highlight the @' at the start of each doc chunk") (defvar noweb-font-lock-brackets-face font-lock-reference-face "Face to use to highlight <<', >>' [[' and ]]' ") (defvar noweb-font-lock-chunk-name-face font-lock-keyword-face "Face to use to highlight the between <<' and >>'") (defvar noweb-font-lock-code-quote-face font-lock-keyword-face "Face to use to highlight the between [[' and ]]'") ;; Now we add [[noweb-font-lock-mode]] to the list of existing minor ;; modes. The string NWFL'' will be added to the mode-line: ugly, but ;; brief. (if (not (assq 'noweb-font-lock-mode minor-mode-alist)) (setq minor-mode-alist (append minor-mode-alist (list '(noweb-font-lock-mode " NWFL"))))) ;; An ugly kludge to get around problems with global-font-lock, which ;; fontifies the entire buffer in the new major mode every time you ;; change mode, which is time-consuming and makes a pigs trotters of ;; it. Trying to stop it looks tricky, but using this function as your ;; font-lock-fontify-buffer' function stops it wasting your time (defun nwfl-donowt() "This function does nothing at all") ;; The following function is just a wrapper for noweb-font-lock-mode, ;; enabling it to be called as noweb-font-lock-minor-mode instead. (defun noweb-font-lock-minor-mode ( &optional arg) "Minor meta mode for managing syntax highlighting in noweb files. See NOWEB-FONT-LOCK-MODE." (interactive) (noweb-font-lock-mode arg)) ;; Here we get to the meat of the problem (defun noweb-font-lock-mode ( &optional arg) "Minor mode for syntax highlighting when using noweb-mode to edit noweb files. Each chunk is fontified in accordance with its own mode" (interactive "P") (if (or noweb-mode noweb-font-lock-mode) (progn ; This bit is tricky: copied almost verbatim from bib-cite-mode.el ; It seems to ensure that the variable noweb-font-lock-mode is made ; local to this buffer. It then sets noweb-font-lock-mode to t' if ; 1) It was called with a prefix argument greater than 0 ; or 2) It was called with no argument, and noweb-font-lock-mode is ; currently nil ; noweb-font-lock-mode is nil if the prefix argument was <= 0 or there ; was no prefix argument and noweb-font-lock-mode is currently t' (set (make-local-variable 'noweb-font-lock-mode) (if arg (> (prefix-numeric-value arg) 0) (not noweb-font-lock-mode))) ;; Now, if noweb-font-lock-mode is true, we want to turn ;; noweb-font-lock-mode on (cond (noweb-font-lock-mode ;Setup the minor-mode (progn (if (and (boundp 'global-font-lock-mode) global-font-lock-mode) (progn (mapcar 'noweb-make-variable-permanent-local '(font-lock-fontify-buffer-function font-lock-unfontify-buffer-function)) (setq font-lock-fontify-buffer-function 'nwfl-donowt) (setq font-lock-unfontify-buffer-function 'nwfl-donowt))) (mapcar 'noweb-make-variable-permanent-local '(noweb-font-lock-mode font-lock-beginning-of-syntax-function noweb-use-font-lock-mode after-change-functions)) (setq noweb-font-lock-mode t) (make-local-hook 'after-change-functions) (add-hook 'after-change-functions 'font-lock-after-change-function nil t) (add-hook 'noweb-font-lock-mode-hook 'noweb-font-lock-mode-fn) (add-hook 'noweb-changed-chunk-hook 'noweb-font-lock-fontify-this-chunk) (run-hooks 'noweb-font-lock-mode-hook) (message "noweb-font-lock mode: use M-x noweb-font-lock-describe-mode' for more info"))) ;; If we didn't do the above, then we want to turn noweb-font-lock-mode ;; off, no matter what (hence the condition t') (t (progn (if (and (boundp 'global-font-lock-mode) global-font-lock-mode) (progn ;; (setq font-lock-fontify-buffer-function ;; 'font-lock-default-fontify-buffer) ;; Get back our unfontify buffer function (setq font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer))) (remove-hook 'noweb-font-lock-mode-hook 'noweb-font-lock-mode-fn) (remove-hook 'noweb-changed-chunk-hook 'noweb-font-lock-fontify-this-chunk) (remove-hook 'after-change-functions 'font-lock-after-change-function ) (font-lock-default-unfontify-buffer) (setq noweb-use-font-lock-mode nil) (message "noweb-font-lock-mode removed"))))) (message "noweb-font-lock-mode can only be used with noweb-mode"))) (defun noweb-start-of-syntax () "Go to the place to start fontifying from" (interactive) (goto-char (car (noweb-chunk-region)))) (defun noweb-font-lock-fontify-chunk-by-number ( chunk-num ) "Fontify chunk chunk-num based on the current major mode." (save-excursion (font-lock-set-defaults) (setq old-beginning-of-syntax font-lock-beginning-of-syntax-function) (setq font-lock-beginning-of-syntax-function 'noweb-start-of-syntax) (setq font-lock-keywords ; (append font-lock-keywords ; '(("\$$\$\\[\$$\$$[^]]*\$*\$$\$$\\]\\]\\|\\\$$" ; (1 noweb-font-lock-brackets-face prepend ) ; (2 noweb-font-lock-code-quote-face prepend) ; (3 noweb-font-lock-brackets-face prepend)) ; ("^[ \t\n]*\$$<<\$$\$$[^>]*\$$\$$>>=?\$$" ; (1 noweb-font-lock-brackets-face prepend ) ; (2 noweb-font-lock-chunk-name-face prepend) ; (3 noweb-font-lock-brackets-face prepend)) ; ("^@[ \t\n]+" ; (0 noweb-font-lock-doc-start-face prepend ))))) (append font-lock-keywords '(("\$$\$\\[\$$\$$[^]]*\$*\$$\$$\\]\\]\\|\\\$$" (1 font-lock-reference-face prepend ) (2 font-lock-keyword-face prepend) (3 font-lock-reference-face prepend)) ("^[ \t\n]*\$$<<\$$\$$[^>]*\$$\$$>>=?\$$" (1 font-lock-reference-face prepend ) (2 font-lock-keyword-face prepend) (3 font-lock-reference-face prepend)) ("^@[ \t\n]+" (0 font-lock-reference-face prepend ))))) (let ((r (cons (marker-position (cdr (aref noweb-chunk-vector chunk-num))) (marker-position (cdr (aref noweb-chunk-vector (1+ chunk-num))))))) (font-lock-fontify-region (car r) (cdr r)) t))) (defun noweb-font-lock-fontify-this-chunk () "Fontify this chunk according to its own major mode. Since we are in the chunk, the major mode will already have been set by noweb-mode.el" (interactive) (noweb-font-lock-fontify-chunk-by-number (noweb-find-chunk-index-buffer))) (defun noweb-font-lock-initial-fontify-buffer () "Applies syntax highlighting to some or all chunks in a noweb buffer. The number of chunks is set by noweb-font-lock-max-initial-chunks: if this is nil, the entire buffer is fontified. It is intended to be called when first entering noweb-font-lock-mode. For other purposes, use noweb-font-lock-fontify-chunks." (interactive) ;; This will be tricky. It will be very slow to go throught the chunks ;; in order, switching major modes all the time. ;; So, we will do the documentation in one pass, the code in a second ;; pass. This could still be a little slow if we have to swap between ;; different code modes regularly, but it should be bearable. It should ;; only happen when the file is first read in, anyway (save-excursion (let (start-chunk end-chunk this-chunk chunk-counter) (setq this-chunk (noweb-find-chunk-index-buffer)) (if noweb-font-lock-max-initial-chunks (progn (setq start-chunk (max 0 (- this-chunk (/ noweb-font-lock-max-initial-chunks 2)))) ;; Don't you just love hairy lisp syntax ? The above means set the ;; starting chunk to the current chunk minus half of ;; noweb-font-lock-max-initial-chunks, unless that is negative in ;; which case set it to 0 (setq end-chunk (+ start-chunk noweb-font-lock-max-initial-chunks)) (if (> end-chunk (- (length noweb-chunk-vector) 2)) (setq end-chunk (- (length noweb-chunk-vector) 2)))) ;; If noweb-font-lock-max-initial-chunks is nil, do the whole buffer (progn (setq start-chunk 0) (setq end-chunk (- (length noweb-chunk-vector) 2)))) (noweb-font-lock-fontify-chunks start-chunk end-chunk)))) (defun noweb-font-lock-fontify-buffer () "This function will fontify each chunk in the buffer appropriately." (interactive) (let ((start-chunk 0) (end-chunk (- (length noweb-chunk-vector) 2))) (noweb-font-lock-fontify-chunks start-chunk end-chunk))) (defun noweb-font-lock-fontify-chunks (start-chunk end-chunk) "Fontify a noweb file from start-chunk to end-chunk" (interactive) (let (chunk-counter) (save-excursion (message "Fontifying from %d to %d" start-chunk end-chunk) ;; Want to set DOC mode for the first Doc chunk, not for the others (setq chunk-counter start-chunk) (while (stringp (car (aref noweb-chunk-vector chunk-counter))) (setq chunk-counter (+ chunk-counter 1))) (goto-char (cdr (aref noweb-chunk-vector chunk-counter))) (noweb-select-mode) ;; Now go through the chunks, fontifying the documentation ones. (while (<= chunk-counter end-chunk) (if (not (stringp (car (aref noweb-chunk-vector chunk-counter)))) (noweb-font-lock-fontify-chunk-by-number chunk-counter)) (message "Fontifying documentation chunks: chunk %d" chunk-counter) (setq chunk-counter (+ 1 chunk-counter))) ;; Go back to the start and go through the chunks, fontifying the code ones. (setq chunk-counter start-chunk) (message "About to do code chunks") (while (<= chunk-counter end-chunk) (if (stringp (car (aref noweb-chunk-vector chunk-counter))) (progn ;; It's a code chunk: goto it to set the correct code mode, then ;; fontify it. (message "Fontifying code chunks: chunk %d" chunk-counter) (goto-char (cdr (aref noweb-chunk-vector chunk-counter))) (noweb-select-mode) (noweb-font-lock-fontify-this-chunk))) (setq chunk-counter (1+ chunk-counter)))) (noweb-select-mode))) (defun noweb-font-lock-mode-fn() "Function that is intended to be attached to noweb-font-lock-mode-hook." (noweb-font-lock-initial-fontify-buffer)) ;; This is a wee bit of a hack. If people attach turn-on-font-lock' ;; to their major mode hook, it will play hell with ;; noweb-font-lock-mode. I had hoped that providing a replacement ;; nw-turn-on-font-lock' would solve the problem, but it didn't ;; (sometimes turn-on-font-lock appears in places other than ;; .emacs', such as in ESS). So rather than have it fall over if ;; turn-on-lock was around, I redefined turn-on-font-lock to do the ;; right thing. (defvar noweb-old-turn-on-font-lock nil) (defun nw-turn-on-font-lock () "Turn on font-lock mode, with due regard to whether we are in noweb-mode" (if (not noweb-mode) (noweb-old-turn-on-font-lock) (if (and (not noweb-font-lock-mode) noweb-use-font-lock-mode) (noweb-font-lock-mode )))) (if (functionp 'noweb-old-turn-on-font-lock) nil (progn (fset 'noweb-old-turn-on-font-lock (symbol-function 'turn-on-font-lock)) (fset 'turn-on-font-lock (symbol-function 'nw-turn-on-font-lock)))) (provide 'noweb-font-lock-mode) ;; ***** ;; ;; Adnan Yaqub (AYaqub@orga.com) ;; ORGA Kartensysteme GmbH // An der Kapelle 2 // D-33104 Paderborn // Germany ;; Tel. +49 5254 991-823 //Fax. +49 5254 991-749 ;; Local Variables: ;; mode:emacs-lisp ;; End: `