home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-epoch-stuff / syntax-decode.el < prev    next >
Encoding:
Text File  |  1991-10-22  |  10.1 KB  |  263 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. ; $Id: syntax-decode.el,v 1.7 1991/10/23 02:16:57 kwood Exp $
  51.  
  52. (provide 'syntax-decode)
  53.  
  54. (defvar syndecode-comment-start-regexp nil
  55.   "\
  56. Regexp to match the start of comments in the current mode. This value
  57. is more reliable than the comment-start variable, since it is
  58. determined directly from the syntax table. Will be nil if comments are
  59. not defined in the current syntax table.")
  60.  
  61. (defvar syndecode-comment-end-regexp nil
  62.   "\
  63. Regexp to match the end of comments in the current mode. This value is
  64. more reliable than the comment-end variable, since it is determined
  65. directly from the syntax table. Will be nil if comments are not
  66. defined in the current syntax table.")
  67.  
  68. (defvar syndecode-comment-start-string nil
  69.   "\
  70. Preferred string to be used to begin comments in the current mode.
  71. Will be nil if comments are not defined in the current syntax table.")
  72.  
  73. (defvar syndecode-comment-end-string nil
  74.   "\
  75. Preferred string to be used to terminate comments in the current mode.
  76. Will be nil if comments are not defined in the current syntax table or if
  77. comments can be terminated by a newline.")
  78.  
  79. (defvar syndecode-done-this-buffer nil
  80.   "\
  81. Buffer-local variable indicating whether the syntax table for this buffer
  82. has been decoded or not.")
  83.  
  84. (make-variable-buffer-local 'syndecode-comment-start-regexp)
  85. (make-variable-buffer-local 'syndecode-comment-end-regexp)
  86. (make-variable-buffer-local 'syndecode-comment-start-string)
  87. (make-variable-buffer-local 'syndecode-comment-end-string)
  88. (make-variable-buffer-local 'syndecode-done-this-buffer)
  89.  
  90. (defvar syndecode-mode-feature-alist nil
  91.   "\
  92. Alist of major modes and their associated comment data as extracted
  93. from the syntax table. Acts as a cache when syntax-decode is run
  94. under the same major mode more than once.")
  95.  
  96.  
  97. ; ***** decode-syntax-table *****
  98. (defun decode-syntax-table ()
  99.   "\
  100. Parse the syntax table for the current mode and figure set the variables
  101. `syndecode-comment-start-regexp', `syndecode-comment-end-regexp',
  102. `syndecode-comment-start-string' and `syndecode-comment-end-string'."
  103.   ; Check to make sure this buffer hasn't already been done first.
  104.   (if (not syndecode-done-this-buffer)
  105.       ; First check to see if the syntax table for this mode has been
  106.       ; decoded at some time in the past, by checking in the "cache"
  107.       ; for the previously extracted values.
  108.       (let* ((cached-syntax-list (assq major-mode
  109.                        syndecode-mode-feature-alist)))
  110.     (if cached-syntax-list
  111.         (progn
  112.           (setq cached-syntax-list (cadr cached-syntax-list))
  113.           (setq syndecode-comment-start-regexp (nth 0 cached-syntax-list))
  114.           (setq syndecode-comment-end-regexp (nth 1 cached-syntax-list))
  115.           (setq syndecode-comment-start-string (nth 2 cached-syntax-list))
  116.           (setq syndecode-comment-end-string (nth 3 cached-syntax-list))
  117.           )
  118.       ; If not cached, then must calculate the value from the current
  119.       ; syntax table.
  120.       (progn
  121.         ; Iterate over the syntax table & decode each character.
  122.         (let (
  123.           (debug-on-error t)
  124.           (tmp-syntax-table (append (syntax-table) nil))
  125.           (table-index 0)
  126.           (code nil)
  127.           (stripped-code nil)
  128.           (char nil)
  129.           (comm-start-string nil)
  130.           (comm-end-string nil)
  131.           (char1-long-comm-start nil)
  132.           (char2-long-comm-start nil)
  133.           (char1-long-comm-end nil)
  134.           (char2-long-comm-end nil)
  135.           (long-comm-start-string nil)
  136.           (long-comm-end-string nil)
  137.           temp-alist-cell
  138.           )
  139.           (while (and (< table-index 255) tmp-syntax-table)
  140.         (progn
  141.           ; Extract the current code & character
  142.           (setq code (car tmp-syntax-table))
  143.           (setq char (char-to-string table-index))
  144.           (setq stripped-code (logand code 255))
  145.  
  146.           ; First, check if the flags for two-character comments are set
  147.           (if (/= 0 (logand (lsh code -16) 1))
  148.               (setq char1-long-comm-start char))
  149.           (if (/= 0 (logand (lsh code -17) 1))
  150.               (setq char2-long-comm-start char))
  151.           (if (/= 0 (logand (lsh code -18) 1))
  152.               (setq char1-long-comm-end char))
  153.           (if (/= 0 (logand (lsh code -19) 1))
  154.               (setq char2-long-comm-end char))
  155.  
  156.           ; Now check for single-character comments
  157.           (if (= stripped-code 11)
  158.               (setq comm-start-string (concat comm-start-string char)))
  159.           ; else
  160.           (if (= stripped-code 12)
  161.               (setq comm-end-string (concat comm-end-string char)))
  162.  
  163.           ; Move to the next element of the syntax table.
  164.           (setq table-index (+ table-index 1))
  165.           (setq tmp-syntax-table (cdr tmp-syntax-table))
  166.           ))
  167.  
  168.           ; Now, build the long (two character) comment strings, if their
  169.           ; component variables are defined.
  170.           (if (and char1-long-comm-start char2-long-comm-start)
  171.           (progn
  172.             (setq long-comm-start-string (concat char1-long-comm-start
  173.                              char2-long-comm-start))
  174.             (setq syndecode-comment-start-regexp
  175.               (concat (regexp-quote char1-long-comm-start)
  176.                   (regexp-quote char2-long-comm-start)))))
  177.           (if (and char1-long-comm-end char2-long-comm-end)
  178.           (progn
  179.             (setq long-comm-end-string (concat char1-long-comm-end
  180.                                char2-long-comm-end))
  181.             (setq syndecode-comment-end-regexp
  182.               (concat (regexp-quote char1-long-comm-end)
  183.                   (regexp-quote char2-long-comm-end)))))
  184.  
  185.           ; Now create the comment start & end regexps from the comment start &
  186.           ; end strings.
  187.  
  188.           ; Extract each character from comm-start-string and add it
  189.           ; verbatim to comment-start-regexp, a list of alternatives.
  190.           (let ((comm-start-index 0)
  191.             (comm-start-length (length comm-start-string)))
  192.         (while (< comm-start-index comm-start-length)
  193.           (progn
  194.             (if syndecode-comment-start-regexp
  195.             (setq syndecode-comment-start-regexp
  196.                   (concat syndecode-comment-start-regexp "\\|"
  197.                       (regexp-quote (substring comm-start-string
  198.                                    comm-start-index
  199.                                    (1+ comm-start-index)))))
  200.               (setq syndecode-comment-start-regexp
  201.                 (regexp-quote (substring comm-start-string
  202.                              comm-start-index
  203.                              (1+ comm-start-index)))))
  204.             (setq comm-start-index (1+ comm-start-index)))))
  205.  
  206.           ; Extract each character from comm-end-string and add it
  207.           ; verbatim to comment-end-regexp, a list of alternatives.
  208.           (let ((comm-end-index 0)
  209.             (comm-end-length (length comm-end-string)))
  210.         (while (< comm-end-index comm-end-length)
  211.           (progn
  212.             (if syndecode-comment-end-regexp
  213.             (setq syndecode-comment-end-regexp
  214.                   (concat syndecode-comment-end-regexp "\\|"
  215.                       (regexp-quote (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 comment starting
  229.             ; 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 sequence
  239.              (or long-comm-end-string
  240.                  ; Failing that, one of the single character comment
  241.                  ; terminators.
  242.                  (if comm-end-string
  243.                  (substring comm-end-string -1)))))
  244.  
  245.           ; Store the newly determined syntax features into the syntax
  246.           ; "cache" for lookup if this mode is encountered again later.
  247.           (setq temp-alist-cell
  248.             (list (list major-mode
  249.                 (list syndecode-comment-start-regexp
  250.                       syndecode-comment-end-regexp
  251.                       syndecode-comment-start-string
  252.                       syndecode-comment-end-string))))
  253.           ; Add the current syntax features to the cache.
  254.           (if syndecode-mode-feature-alist
  255.           (setq syndecode-mode-feature-alist
  256.             (append temp-alist-cell syndecode-mode-feature-alist))
  257.         (setq syndecode-mode-feature-alist temp-alist-cell))
  258.           ))))
  259.     ; Set a flag to indicate the syntax table in this buffer has been
  260.     ; decoded.
  261.     (setq syndecode-done-this-buffer t)
  262.     )) ; end of defun
  263.