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