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 / syntax-decode.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  10.2 KB  |  266 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    syntax-decode.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:    Calculate regular expressions used to match comments in the
  25. ;;        current major mode. Also calculates strings that may be used
  26. ;;        to begin & end comments in the major mode.
  27. ;;
  28. ;;        The values calculated are assigned to the buffer-local
  29. ;;        variables syndecode-comment-start-regexp,
  30. ;;        syndecode-comment-end-regexp, syndecode-comment-start-string,
  31. ;;        and syndecode-comment-end-string.
  32. ;;
  33. ;;        If the function decode-syntax-table is run more than once in
  34. ;;        the same buffer, later invocations do nothing. Each time a new
  35. ;;        syntax table is decoded, its data is "cached" for use next
  36. ;;        time that mode is encountered.
  37. ;;
  38. ;;        It should prove fairly simple to extract extra features from
  39. ;;        the syntax table - drop me a line if you need something else
  40. ;;        and we can work something out.
  41. ;;
  42. ;;        To install this package so that other packages can use it,
  43. ;;        add this line to your .emacs:
  44. ;;
  45. ;;    (autoload 'decode-syntax-table "syntax-decode" "autoloadable function" t)
  46. ;;
  47. ;;*****************************************************************************
  48.  
  49. ;; $Id: syntax-decode.el,v 1.9 1992/08/18 04:16:24 rwhitby Rel $
  50.  
  51. (defvar syndecode-comment-start-regexp nil
  52.   "\
  53. Regexp to match the start of comments in the current mode. This value
  54. is more reliable than the comment-start variable, since it is
  55. determined directly from the syntax table. Will be nil if comments are
  56. not defined in the current syntax table.")
  57.  
  58. (defvar syndecode-comment-end-regexp nil
  59.   "\
  60. Regexp to match the end of comments in the current mode. This value is
  61. more reliable than the comment-end variable, since it is determined
  62. directly from the syntax table. Will be nil if comments are not
  63. defined in the current syntax table.")
  64.  
  65. (defvar syndecode-comment-start-string nil
  66.   "\
  67. Preferred string to be used to begin comments in the current mode.
  68. Will be nil if comments are not defined in the current syntax table.")
  69.  
  70. (defvar syndecode-comment-end-string nil
  71.   "\
  72. Preferred string to be used to terminate comments in the current mode.
  73. Will be nil if comments are not defined in the current syntax table or if
  74. comments can be terminated by a newline.")
  75.  
  76. (defvar syndecode-done-this-buffer nil
  77.   "\
  78. Buffer-local variable indicating whether the syntax table for this buffer
  79. has been decoded or not.")
  80.  
  81. (make-variable-buffer-local 'syndecode-comment-start-regexp)
  82. (make-variable-buffer-local 'syndecode-comment-end-regexp)
  83. (make-variable-buffer-local 'syndecode-comment-start-string)
  84. (make-variable-buffer-local 'syndecode-comment-end-string)
  85. (make-variable-buffer-local 'syndecode-done-this-buffer)
  86.  
  87. (defvar syndecode-mode-feature-alist nil
  88.   "\
  89. Alist of major modes and their associated comment data as extracted
  90. from the syntax table. Acts as a cache when syntax-decode is run
  91. under the same major mode more than once.")
  92.  
  93.  
  94. ;; ***** decode-syntax-table *****
  95. (defun decode-syntax-table ()
  96.   "\
  97. Parse the syntax table for the current mode and figure set the variables
  98. `syndecode-comment-start-regexp', `syndecode-comment-end-regexp',
  99. `syndecode-comment-start-string' and `syndecode-comment-end-string'."
  100.   ;; Check to make sure this buffer hasn't already been done first.
  101.   (if (not syndecode-done-this-buffer)
  102.       ;; First check to see if the syntax table for this mode has been
  103.       ;; decoded at some time in the past, by checking in the "cache"
  104.       ;; for the previously extracted values.
  105.       (let* ((cached-syntax-list (assq major-mode
  106.                        syndecode-mode-feature-alist)))
  107.     (if cached-syntax-list
  108.         (progn
  109.           (setq cached-syntax-list (cadr cached-syntax-list))
  110.           (setq syndecode-comment-start-regexp (nth 0 cached-syntax-list))
  111.           (setq syndecode-comment-end-regexp (nth 1 cached-syntax-list))
  112.           (setq syndecode-comment-start-string (nth 2 cached-syntax-list))
  113.           (setq syndecode-comment-end-string (nth 3 cached-syntax-list))
  114.           )
  115.       ;; If not cached, then must calculate the value from the current
  116.       ;; syntax table.
  117.       (progn
  118.         ;; Iterate over the syntax table & decode each character.
  119.         (let (
  120.           (debug-on-error t)
  121.           (tmp-syntax-table (append (syntax-table) nil))
  122.           (table-index 0)
  123.           (code nil)
  124.           (stripped-code nil)
  125.           (char nil)
  126.           (comm-start-string nil)
  127.           (comm-end-string nil)
  128.           (char1-long-comm-start nil)
  129.           (char2-long-comm-start nil)
  130.           (char1-long-comm-end nil)
  131.           (char2-long-comm-end nil)
  132.           (long-comm-start-string nil)
  133.           (long-comm-end-string nil)
  134.           temp-alist-cell
  135.           )
  136.           (while (and (< table-index 255) tmp-syntax-table)
  137.         (progn
  138.           ;; Extract the current code & character
  139.           (setq code (car tmp-syntax-table))
  140.           (setq char (char-to-string table-index))
  141.           (setq stripped-code (logand code 255))
  142.           
  143.           ;; First, check if the flags for two-character comments
  144.           ;; are set
  145.           (if (/= 0 (logand (lsh code -16) 1))
  146.               (setq char1-long-comm-start char))
  147.           (if (/= 0 (logand (lsh code -17) 1))
  148.               (setq char2-long-comm-start char))
  149.           (if (/= 0 (logand (lsh code -18) 1))
  150.               (setq char1-long-comm-end char))
  151.           (if (/= 0 (logand (lsh code -19) 1))
  152.               (setq char2-long-comm-end char))
  153.           
  154.           ;; Now check for single-character comments
  155.           (if (= stripped-code 11)
  156.               (setq comm-start-string (concat comm-start-string char)))
  157.           ;; else
  158.           (if (= stripped-code 12)
  159.               (setq comm-end-string (concat comm-end-string char)))
  160.           
  161.           ;; Move to the next element of the syntax table.
  162.           (setq table-index (+ table-index 1))
  163.           (setq tmp-syntax-table (cdr tmp-syntax-table))
  164.           ))
  165.           
  166.           ;; Now, build the long (two character) comment strings, if their
  167.           ;; component variables are defined.
  168.           (if (and char1-long-comm-start char2-long-comm-start)
  169.           (progn
  170.             (setq long-comm-start-string
  171.               (concat char1-long-comm-start char2-long-comm-start))
  172.             (setq syndecode-comment-start-regexp
  173.               (concat (regexp-quote char1-long-comm-start)
  174.                   (regexp-quote char2-long-comm-start)))))
  175.           (if (and char1-long-comm-end char2-long-comm-end)
  176.           (progn
  177.             (setq long-comm-end-string (concat char1-long-comm-end
  178.                                char2-long-comm-end))
  179.             (setq syndecode-comment-end-regexp
  180.               (concat (regexp-quote char1-long-comm-end)
  181.                   (regexp-quote char2-long-comm-end)))))
  182.           
  183.           ;; Now create the comment start & end regexps from the comment
  184.           ;; start & end strings.
  185.           
  186.           ;; Extract each character from comm-start-string and add it
  187.           ;; verbatim to comment-start-regexp, a list of alternatives.
  188.           (let ((comm-start-index 0)
  189.             (comm-start-length (length comm-start-string)))
  190.         (while (< comm-start-index comm-start-length)
  191.           (progn
  192.             (if syndecode-comment-start-regexp
  193.             (setq syndecode-comment-start-regexp
  194.                   (concat syndecode-comment-start-regexp "\\|"
  195.                       (regexp-quote
  196.                        (substring comm-start-string
  197.                           comm-start-index
  198.                           (1+ comm-start-index)))))
  199.               (setq syndecode-comment-start-regexp
  200.                 (regexp-quote (substring comm-start-string
  201.                              comm-start-index
  202.                              (1+ comm-start-index)))))
  203.             (setq comm-start-index (1+ comm-start-index)))))
  204.           
  205.           ;; Extract each character from comm-end-string and add it
  206.           ;; verbatim to comment-end-regexp, a list of alternatives.
  207.           (let ((comm-end-index 0)
  208.             (comm-end-length (length comm-end-string)))
  209.         (while (< comm-end-index comm-end-length)
  210.           (progn
  211.             (if syndecode-comment-end-regexp
  212.             (setq syndecode-comment-end-regexp
  213.                   (concat syndecode-comment-end-regexp "\\|"
  214.                       (regexp-quote
  215.                        (substring comm-end-string
  216.                           comm-end-index
  217.                           (1+ comm-end-index)))))
  218.               (setq syndecode-comment-end-regexp
  219.                 (regexp-quote (substring comm-end-string
  220.                              comm-end-index
  221.                              (1+ comm-end-index)))))
  222.             (setq comm-end-index (1+ comm-end-index)))))
  223.           
  224.           ;; Set up the comment start string.
  225.           (setq syndecode-comment-start-string
  226.             ;; Prefer the two-character comment sequence
  227.             (or long-comm-start-string
  228.             ;; Failing that, use one of the single character
  229.             ;; comment starting sequences.
  230.             (if comm-start-string
  231.                 (substring comm-start-string -1))))
  232.           
  233.           ;; Now, set up the comment end string.
  234.           (setq syndecode-comment-end-string
  235.             ;; Set it to nil if newlines can terminate comments
  236.             (and (not (and comm-end-string
  237.                    (string-match "\n" comm-end-string)))
  238.              ;; Otherwise, prefer the two character comment
  239.              ;; sequence
  240.              (or long-comm-end-string
  241.                  ;; Failing that, one of the single character
  242.                  ;; comment terminators.
  243.                  (if comm-end-string
  244.                  (substring comm-end-string -1)))))
  245.           
  246.           ;; Store the newly determined syntax features into the syntax
  247.           ;; "cache" for lookup if this mode is encountered again later.
  248.           (setq temp-alist-cell
  249.             (list (list major-mode
  250.                 (list syndecode-comment-start-regexp
  251.                       syndecode-comment-end-regexp
  252.                       syndecode-comment-start-string
  253.                       syndecode-comment-end-string))))
  254.           ;; Add the current syntax features to the cache.
  255.           (if syndecode-mode-feature-alist
  256.           (setq syndecode-mode-feature-alist
  257.             (append temp-alist-cell syndecode-mode-feature-alist))
  258.         (setq syndecode-mode-feature-alist temp-alist-cell))
  259.           ))))
  260.     ;; Set a flag to indicate the syntax table in this buffer has been
  261.     ;; decoded.
  262.     (setq syndecode-done-this-buffer t)
  263.     )) ;; end of defun
  264.  
  265. (provide 'syntax-decode)
  266.