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