home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-highlight-2.0 / tek-src-highlight.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  7.8 KB  |  222 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    tek-src-highlight.el
  4. ;;
  5. ;; Copyright (C) 1992  Rod Whitby
  6. ;;
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11. ;;
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16. ;;
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program; if not, write to the Free Software
  19. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ;;
  21. ;; Modified by:        Rod Whitby, <rwhitby@research.canon.oz.au>
  22. ;; Author:        Ken Wood, <kwood@austek.oz.au>
  23. ;;
  24. ;; Description:    Highlight comments in source code buffers. Highlighting is
  25. ;;        updated on find-file and save-buffer.
  26. ;;
  27. ;;        Button styles may be customised by means of X11 resources.
  28. ;;        The resource name to use is "src-comment".
  29. ;;        See the file tek-style-utils.el for details.
  30. ;;
  31. ;;        You may need to modify the variable
  32. ;;        tek-highlight-merge-comments if you change the highlighting
  33. ;;        style away from the default. See the documentation for this
  34. ;;        variable for further details.
  35. ;;
  36. ;;        See the INSTALL file that comes with this package for
  37. ;;        installation details.
  38. ;;
  39. ;;*****************************************************************************
  40.  
  41. ;; $Id: tek-src-highlight.el,v 1.8 1992/08/18 04:14:20 rwhitby Rel $
  42.  
  43. ;; Put the whole thing inside a test to get it to compile under emacs.
  44. (if (boundp 'epoch::version)
  45.     (progn
  46.       
  47.       (require 'tek-style-utils)
  48.  
  49.       (defvar tek-src-comment-foreground "blue3"
  50.     "\
  51. Foreground color used to highlight comments if no value is defined in
  52. the X11 resources and the display device supports color. On monochrome
  53. screens a different font is used in place of the different color.")
  54.       
  55.       (defvar tek-src-comment-styleorattribute
  56.     ;; If the display supports multiple colors and a default color
  57.     ;; is specified, define the style to use a different color.
  58.     (if (and (> (number-of-colors) 2) tek-src-comment-foreground)
  59.         (tek-build-style "src-comment"
  60.                  nil nil
  61.                  tek-src-comment-foreground (background)
  62.                  (background) (foreground))
  63.       ;; Otherwise, define the style to use a different font.
  64.       (tek-build-style "src-comment" nil
  65.                (or tek-italic-bold-fixed-font
  66.                    tek-bold-fixed-font
  67.                    tek-italic-fixed-font)
  68.                (foreground) (background)
  69.                (background) (foreground)))
  70.     "\
  71. Style or attribute used to display characters in source code comments.")
  72.  
  73.  
  74.       ;; Select V3 or V4 zone behaviour
  75.       (if tek-highlight-use-attributes
  76.       (progn
  77.         ;; Do things the old way - using attributes.
  78.       
  79.         (defvar tek-src-comment-style tek-src-comment-styleorattribute
  80.           "\
  81. Style used for displaying comments in source code when attributes are
  82. used to mark zones.")
  83.  
  84.         ;; Modify the variable used with add-zone to be an attribute
  85.         (setq tek-src-comment-styleorattribute (reserve-attribute))
  86.       
  87.         ;;Bind the comment style to the comment attribute
  88.         (set-attribute-style tek-src-comment-styleorattribute
  89.                  tek-src-comment-style)
  90.  
  91.         ))
  92.  
  93.  
  94.       (defvar tek-highlight-done-this-buffer nil
  95.     "\
  96. Buffer-local variable indicating whether any comments have been
  97. highlighted in this buffer or not.")
  98.  
  99.       (defvar tek-highlight-comment-continue-regexp nil
  100.     "\
  101. Buffer-local variable used to decide when adjacent comments may be
  102. considered a single block. A search string which allows only
  103. whitespace between comments.")
  104.  
  105.       (make-variable-buffer-local 'tek-highlight-done-this-buffer)
  106.       (make-variable-buffer-local 'tek-highlight-comment-continue-regexp)
  107.  
  108.  
  109.       (defvar tek-highlight-merge-comments t
  110.     "\
  111. *If non-nil then adjacent comments which are separated only by
  112. whitespace may be merged, i.e. highlighted by a single zone which
  113. runs from the start of the first comment to the end of the last
  114. comment. This variable is t by default, as this results in a
  115. significant speedup in syntaxes which have newline-terminated
  116. comments. It should be set to nil if the comment highlighting style
  117. makes whitespace visible. Underlining and changing the background
  118. color are two things that do this.")
  119.  
  120.  
  121.       ;;
  122.       ;; Function which does the actual highlighting
  123.       ;;
  124.       (defun tek-highlight-comments ()
  125.     "\
  126. Actual source code highlighting function. Called by
  127. tek-highlight-comments-on-find and tek-highlight-comments-on-write."
  128.     (interactive)
  129.     ;; Silently do nothing if there are no regexps to search with.
  130.     (if (and syndecode-comment-start-regexp
  131.          syndecode-comment-end-regexp)
  132.         (let ((starting-point (point-min))
  133.           comment-start-begin
  134.           comment-start-end
  135.           comment-end-end)
  136.           (save-excursion
  137.         (goto-char (point-min))
  138.         ;; Algorithm is: search for start of a comment,
  139.         ;; make sure it really is a comment; then highlight
  140.         ;; from there to the end of the comment.
  141.         ;;
  142.         ;; First, find a comment-start sequence.
  143.         (while (re-search-forward syndecode-comment-start-regexp
  144.                       nil t)
  145.           (progn
  146.             (setq comment-start-begin (match-beginning 0))
  147.             (setq comment-start-end (match-end 0))
  148.             ;; Check that the comment start sequence really does
  149.             ;; indicate the start of a comment, and that it's not
  150.             ;; inside a string etc.
  151.             (setq state (parse-partial-sexp
  152.                  starting-point comment-start-end))
  153.             (if (nth 4 state)
  154.             ;; Yes, this is really the start of a comment
  155.             (progn
  156.               (goto-char comment-start-end)
  157.               ;; Find the end of the comment by searching
  158.               ;; for a comment terminating sequence
  159.               (re-search-forward syndecode-comment-end-regexp
  160.                          nil t)
  161.               (setq comment-end-end (point))
  162.               ;; Now, searches are faster than adding zones,
  163.               ;; so see if we can extend this zone to cover any
  164.               ;; following comments.
  165.               (while (and tek-highlight-merge-comments
  166.                       (looking-at
  167.                        tek-highlight-comment-continue-regexp))
  168.                 (progn (re-search-forward
  169.                     tek-highlight-comment-continue-regexp
  170.                     nil t)
  171.                    (re-search-forward
  172.                     syndecode-comment-end-regexp
  173.                     nil t)
  174.                    (setq comment-end-end (point))))
  175.               ;; Highlight the comment
  176.               (add-zone comment-start-begin comment-end-end
  177.                       tek-src-comment-styleorattribute)
  178.               ;; Start the next syntax parse at the end of the
  179.               ;; comment just processed.
  180.               (setq starting-point comment-end-end)
  181.               )))))
  182.           ;; Set a flag to indicate there are highlighted comments in
  183.           ;; this buffer.
  184.           (setq tek-highlight-done-this-buffer t)
  185.           ))) ;; end of defun
  186.  
  187.  
  188.       ;; Function to be called by find-file-hooks.
  189.       (defun tek-highlight-comments-on-find ()
  190.     "\
  191. Function to highlight all the comments in the current buffer. Intended
  192. to be called by find-file-hooks."
  193.     ;; Extract comment details from the current syntax table. This will
  194.     ;; do nothing if this function has already been run in this buffer.
  195.     (decode-syntax-table)
  196.     (if syndecode-comment-start-regexp
  197.         (setq tek-highlight-comment-continue-regexp
  198.           (concat "[ \t\n]*\\(" syndecode-comment-start-regexp
  199.               "\\)")))
  200.     (tek-highlight-comments))
  201.  
  202.  
  203.       ;; Function to be called by write-file-hooks.
  204.       (defun tek-highlight-comments-on-write ()
  205.     "\
  206. Function to highlight all the comments in the current buffer. Intended
  207. to be called by write-file-hooks."
  208.     ;; Check to see if there is any highlighting currently in effect
  209.     (if tek-highlight-done-this-buffer
  210.         ;; If so, remove & redo highlighting.
  211.         (progn
  212.           ;; Clean up first - saves memory
  213.           (clear-zones)
  214.           (tek-highlight-comments)))
  215.     ;; Have to return nil or write-file-hooks will get stuffed up.
  216.     nil)
  217.  
  218.  
  219.       )) ;; end: running-epoch test
  220.  
  221. (provide 'tek-src-highlight)
  222.