home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / bison-mode.el < prev    next >
Encoding:
Text File  |  1990-03-21  |  44.6 KB  |  1,364 lines
  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!NCoast.ORG!allbery Thu Dec 21 23:01:34 EST 1989
  2. ;Article 863 of gnu.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!NCoast.ORG!allbery
  4. ;>From: allbery@NCoast.ORG
  5. ;Newsgroups: gnu.emacs
  6. ;Subject: Bison mode for Gnu Emacs
  7. ;Message-ID: <8912212039.AA08451@NCoast.ORG>
  8. ;Date: 21 Dec 89 20:39:31 GMT
  9. ;Sender: daemon@tut.cis.ohio-state.edu
  10. ;Distribution: gnu
  11. ;Organization: GNUs Not Usenet
  12. ;Lines: 671
  13. ;
  14. ;Well, having given up on finding my original "yacc mode" code and needing to
  15. ;do some major hacking on yacc / bison sources, I bit the bullet and started
  16. ;from scratch.  But this time, I did it right.  All of the original warts in
  17. ;the old yacc-mode have been avoided, and the result is actually useful.  It is
  18. ;also more complete as a major mode, and takes pains to retain the user's
  19. ;environment while switching modes to deal with code blocks.
  20. ;
  21. ;I leave it to the FSF to decide whether this should become part of GNU Emacs.
  22. ;
  23. ;++Brandon
  24. ;--
  25. ;Brandon S. Allbery    allbery@NCoast.ORG, BALLBERY (MCI Mail), ALLBERY (Delphi)
  26. ;uunet!hal.cwru.edu!ncoast!allbery ncoast!allbery@hal.cwru.edu bsa@telotech.uucp
  27.  
  28. ;; Bison (or Yacc) mode for Gnu Emacs
  29. ;; Brandon S. Allbery, allbery@NCoast.ORG; buggestions welcome
  30.  
  31. ;; This file is not (yet) part of GNU Emacs.
  32.  
  33. ;; GNU Emacs is distributed in the hope that it will be useful,
  34. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  35. ;; accepts responsibility to anyone for the consequences of using it
  36. ;; or for whether it serves any particular purpose or works at all,
  37. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  38. ;; License for full details.
  39.  
  40. ;; Everyone is granted permission to copy, modify and redistribute
  41. ;; GNU Emacs, but only under the conditions described in the
  42. ;; GNU Emacs General Public License.   A copy of this license is
  43. ;; supposed to have been given to you along with GNU Emacs so you
  44. ;; can know your rights and responsibilities.  It should be in a
  45. ;; file named COPYING.  Among other things, the copyright notice
  46. ;; and this notice must be preserved on all copies.
  47.  
  48. ;; Bison, Yacc, and similar parser compilers all are unusual in that
  49. ;; parts of the file are in C mode instead of the parser language mode.
  50. ;; This requires some interesting hackery on the part of Emacs; when
  51. ;; switching from one part of the file to another, the state of the buffer
  52. ;; is saved on an alist and the buffer's mode is changed.  This is
  53. ;; arranged such that each buffer has its own saved state for both Bison
  54. ;; and Bison-Block (aka C) modes; much work is done to avoid losing
  55. ;; buffer-local information in either major mode while not confusing the
  56. ;; two.
  57.  
  58. ;; Bison mode knows quite a bit about C mode, and uses the known values
  59. ;; of c-indent-level and c-auto-newline, among others.  Unfortunately,
  60. ;; it does not properly handle all such combinations of C-mode settings.
  61. ;; It does support both my old coding style and my current style, which
  62. ;; is sufficient for my purposes.
  63.  
  64. ;; Also included is an "auto-fill" mode which continues definition lines
  65. ;; (%token, %left, etc.) and wraps long token sequences to the proper
  66. ;; column automagically.  This is disabled by default; see the function
  67. ;; (bison-auto-continuation-mode) for more information.
  68.  
  69. ;; The code has survived mostly intact my most recent go at updating USP
  70. ;; (see comp.sources.misc), and I therefore consider it (mostly) stable.
  71. ;; No doubt someone will find something that needs to be fixed; send mail
  72. ;; to allbery@ncoast.org in that case.  I intend to keep Bison mode up to
  73. ;; date, since it makes my life a lot easier.  (Now if I could use gcc and
  74. ;; Bison without running into collisions between the GPL and other license
  75. ;; agreements....)
  76.  
  77. (defvar bison-buffer-local-alist nil
  78.   "Alist of bison mode buffers, and saved local variables thereto.")
  79.  
  80. (defconst bison-colon-column 16 "\
  81. *The column in which to place a colon separating a token from its definition.")
  82.  
  83. (defconst bison-percent-column 41 "\
  84. *The column in which to place a percent introducing a modifier (e.g. %prec).")
  85.  
  86. (defvar bison-mode-abbrev-table nil
  87.   "Abbrev table used in bison-mode buffers.")
  88. (define-abbrev-table 'bison-mode-abbrev-table ())
  89.  
  90. (defvar bison-mode-map ()
  91.   "Keymap used in bison mode.")
  92. (if bison-mode-map
  93.     ()
  94.   (setq bison-mode-map (make-sparse-keymap))
  95.   (define-key bison-mode-map "{" 'bison-insert-edit-code-block)
  96.   (define-key bison-mode-map ";" 'electric-bison-semi)
  97.   (define-key bison-mode-map ":" 'electric-bison-colon)
  98.   (define-key bison-mode-map "|" 'electric-bison-colon)
  99.   (define-key bison-mode-map "%" 'electric-bison-per)
  100.   (define-key bison-mode-map "\C-c%" 'bison-edit-c-division)
  101.   (define-key bison-mode-map "\177" 'backward-delete-char-untabify)
  102.   (define-key bison-mode-map "\t" 'bison-indent-command))
  103.  
  104. (defvar bison-mode-syntax-table nil
  105.   "Syntax table in use in bison-mode buffers.")
  106. (if bison-mode-syntax-table
  107.     ()
  108.   (setq bison-mode-syntax-table (make-syntax-table))
  109.   (modify-syntax-entry ?/ ". 14" bison-mode-syntax-table)
  110.   (modify-syntax-entry ?* ". 23" bison-mode-syntax-table)
  111.   (modify-syntax-entry ?{ "(}  " bison-mode-syntax-table)
  112.   (modify-syntax-entry ?} "){  " bison-mode-syntax-table)
  113.   (modify-syntax-entry ?\\ "\\  " bison-mode-syntax-table)
  114.   (modify-syntax-entry ?\' "\"   " bison-mode-syntax-table)
  115.   (modify-syntax-entry ?\: "(;  " bison-mode-syntax-table)
  116.   (modify-syntax-entry ?\; "):  " bison-mode-syntax-table))
  117.  
  118. (fset 'F:local-map (symbol-function 'use-local-map))
  119. (fset 'F:syntax-table (symbol-function 'set-syntax-table))
  120.  
  121. (defun bison-mode ()
  122.   "Major mode for editing Bison or Yacc code for a C target.
  123. Blocks of C code are replaced with ellipses unless expanded, which causes the
  124. buffer to be narrowed and switched to C mode; the C and Bison environments are
  125. preserved when not active.  { inserts a new block if necessary.
  126. \\{bison-mode-map}
  127. Turning on Bison mode calls the value of the variable bison-mode-hook with
  128. no args if it is non-nil.  The first time the buffer is narrowed to a block,
  129. the value of c-mode-hook will be called with no args within the narrowed
  130. environment if it is non-nil."
  131.   (interactive)
  132.   (kill-all-local-variables)
  133.   ;; anyone got a better way to do this?
  134.   (let ((elt (if bison-buffer-local-alist
  135.          (assoc (current-buffer) bison-buffer-local-alist))))
  136.     (and elt
  137.      (setcdr elt nil)))
  138.   (use-local-map bison-mode-map)
  139.   (setq major-mode 'bison-mode)
  140.   (setq mode-name "Bison")
  141.   (setq local-abbrev-table bison-mode-abbrev-table)
  142.   (set-syntax-table bison-mode-syntax-table)
  143.   (make-local-variable 'paragraph-start)
  144.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  145.   (make-local-variable 'paragraph-separate)
  146.   (setq paragraph-separate paragraph-start)
  147.   (make-local-variable 'paragraph-ignore-fill-prefix)
  148.   (setq paragraph-ignore-fill-prefix t)
  149.   (make-local-variable 'indent-line-function)
  150.   (setq indent-line-function 'bison-indent-line)
  151.   (make-local-variable 'require-final-newline)
  152.   (setq require-final-newline t)
  153.   (make-local-variable 'comment-start)
  154.   (setq comment-start "/* ")
  155.   (make-local-variable 'comment-end)
  156.   (setq comment-end " */")
  157.   (make-local-variable 'comment-column)
  158.   (setq comment-column 40)
  159.   (make-local-variable 'comment-start-skip)
  160.   (setq comment-start-skip "/\\*+ *")
  161.   (make-local-variable 'comment-indent-hook)
  162.   (setq comment-indent-hook 'c-comment-indent)
  163.   (make-local-variable 'parse-sexp-ignore-comments)
  164.   (setq parse-sexp-ignore-comments t)
  165.   (make-local-variable 'selective-display)
  166.   (setq selective-display t)
  167.   (make-local-variable 'selective-display-ellipses)
  168.   (setq selective-display-ellipses t)
  169.   (make-local-variable 'block-indent-level)
  170.   (make-local-variable 'auto-fill-hook)
  171.   (bison-hide-code-blocks)
  172.   (run-hooks 'bison-mode-hook 'c-mode-hook))
  173.  
  174. (defun electric-bison-colon (arg)
  175.   "Insert character and correct line's indentation."
  176.   (interactive "P")
  177.   (let ((state (parse-partial-sexp
  178.         (save-excursion
  179.           (if (re-search-backward
  180.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  181.                nil 'move)
  182.               (- (match-end 0) 1)
  183.             (point-min)))
  184.         (point))))
  185.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  186.     (self-insert-command (prefix-numeric-value arg))
  187.       (if (and (not arg) (eolp))
  188.       (progn
  189.         (bison-indent-line)
  190.         (and c-auto-newline
  191.          (eq last-command-char ?\|)
  192.          (save-excursion
  193.            (beginning-of-line)
  194.            (not (looking-at "[ \t]*$")))
  195.          (newline))
  196.         (delete-horizontal-space)
  197.         (indent-to bison-colon-column)
  198.         (insert last-command-char)
  199.         (insert " "))
  200.     (self-insert-command (prefix-numeric-value arg))))))
  201.  
  202. (defun electric-bison-semi (arg)
  203.   "Insert character and correct line's indentation."
  204.   (interactive "P")
  205.   (if c-auto-newline
  206.       (electric-bison-terminator arg)
  207.     (self-insert-command (prefix-numeric-value arg))))
  208.  
  209. (defun electric-bison-per (arg)
  210.   "Insert character and correct line's indentation."
  211.   (interactive "P")
  212.   (let ((state (parse-partial-sexp
  213.         (save-excursion
  214.           (if (re-search-backward
  215.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  216.                nil 'move)
  217.               (- (match-end 0) 1)
  218.             (point-min)))
  219.         (point))))
  220.     (if (and (not arg)
  221.          (eolp)
  222.          (not (eq (preceding-char) ?%))
  223.          (not (or (nth 3 state) (nth 4 state) (nth 5 state))))
  224.     (if (not (save-excursion
  225.            (skip-chars-backward " \t")
  226.            (bolp)))
  227.         (indent-to bison-percent-column)
  228.       (delete-region (save-excursion
  229.                (beginning-of-line)
  230.                (point))
  231.              (point))))
  232.     (self-insert-command (prefix-numeric-value arg))))
  233.  
  234. (defun electric-bison-terminator (arg)
  235.   "Insert character and correct line's indentation."
  236.   (interactive "P")
  237.   (let ((state (parse-partial-sexp
  238.         (save-excursion
  239.           (if (re-search-backward
  240.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  241.                nil 'move)
  242.               (- (match-end 0) 1)
  243.             (point-min)))
  244.         (point)))
  245.     insertpos)
  246.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  247.     (self-insert-command (prefix-numeric-value arg))
  248.       (if (and (not arg) (eolp)
  249.            (not (save-excursion
  250.               (beginning-of-line)
  251.               (skip-chars-forward " \t")
  252.               (= (following-char) ?%))))
  253.       (progn
  254.         (and c-auto-newline
  255.          (progn
  256.            (if (save-excursion
  257.              (beginning-of-line)
  258.              (not (looking-at "[ \t]*$")))
  259.                (newline))
  260.            (bison-indent-line)
  261.            (backward-delete-char-untabify 2)))
  262.         (insert last-command-char)
  263.         (bison-indent-line)
  264.         (and c-auto-newline
  265.          (progn
  266.            (newline)
  267.            (setq insertpos (- (point) 2))
  268.            (bison-indent-line)))
  269.         (save-excursion
  270.           (if insertpos (goto-char (1+ insertpos)))
  271.           (delete-char -1))))
  272.       (if insertpos
  273.       (save-excursion
  274.         (goto-char insertpos)
  275.         (self-insert-command (prefix-numeric-value arg)))
  276.     (self-insert-command (prefix-numeric-value arg))))))
  277.  
  278. (defun bison-indent-command (&optional whole-exp)
  279.   "Indent current line as Bison code, or in some cases insert a tab character.
  280. If c-tab-always-indent is non-nil (the default), always indent current line.
  281. Otherwise, indent the current line only if point is at the left margin
  282. or in the line's indentation; otherwise insert a tab.
  283.  
  284. A numeric argument, regardless of its value,
  285. means indent rigidly all the lines of the expression starting after point
  286. so that this line becomes properly indented.
  287. The relative indentation among the lines of the expression are preserved."
  288.   (interactive "P")
  289.   (if whole-exp
  290.       (let ((shift-amount (bison-indent-line))
  291.         beg end)
  292.     (save-excursion
  293.       (if c-tab-always-indent
  294.           (beginning-of-line))
  295.       (setq beg (point))
  296.       (re-search-forward ";\\|^%%" nil 'move)
  297.       (if (save-excursion
  298.         (beginning-of-line)
  299.         (looking-at "%%"))
  300.           (progn
  301.         (forward-line -1)
  302.         (end-of-line)))
  303.       (setq end (point))
  304.       (goto-char beg)
  305.       (forward-line 1)
  306.       (setq beg (point)))
  307.     (if (> end beg)
  308.         (indent-code-rigidly beg end shift-amount "%")))
  309.     (if (and (not c-tab-always-indent)
  310.          (save-excursion
  311.            (skip-chars-backward " \t")
  312.            (not (bolp))))
  313.     (insert-tab)
  314.       (bison-indent-line))))
  315.  
  316. (defun bison-indent-line ()
  317.   "Indent current line as Bison code.
  318. Return the amount the indentation changed by."
  319.   ;; Lines are indented if and only if a colon is found before a semicolon
  320.   ;; while searching backward.  String-quoted characters are ignored.
  321.   (let (indent)
  322.     (save-excursion
  323.       (cond
  324.        ((save-excursion
  325.       (let ((limit (point))
  326.         state)
  327.         (goto-char (point-min))
  328.         (not (and (re-search-forward "^%%" limit t)
  329.               (progn
  330.             (parse-partial-sexp
  331.              (save-excursion
  332.                (if (re-search-backward
  333.                 "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  334.                 nil 'move)
  335.                    (- (match-end 0) 1)
  336.                  (point-min)))
  337.              (point))
  338.             (not (or (nth 3 state)
  339.                  (nth 4 state)
  340.                  (nth 5 state))))))))
  341.     (setq indent 0))
  342.        ((save-excursion
  343.       (beginning-of-line)
  344.       (looking-at "[ \t]*%"))
  345.     (setq indent 0))
  346.        ((save-excursion
  347.       (skip-chars-backward " \t\n\f")
  348.       (eq (preceding-char) ?\;))
  349.     (setq indent 0))
  350.        (t
  351.     (beginning-of-line)
  352.     (while (not (or (bobp)
  353.             (looking-at "[ \t]*\\(\sw\\|\s_\\)*[ \t]*[|:]")
  354.             (eq (following-char) ?%)))
  355.       (forward-line -1))
  356.     (skip-chars-forward "^:|")
  357.     (skip-chars-forward ":| \t")
  358.     (setq indent (current-column)))))
  359.     (indent-to indent)
  360.     indent))
  361.  
  362. (defun bison-insert-edit-code-block (arg)
  363.   "Edit the code block associated with the current line of parser description.
  364. If no such block is found, create one."
  365.   (interactive "P")
  366.   (cond
  367.    ((let ((state (parse-partial-sexp
  368.           (save-excursion
  369.             (if (re-search-backward
  370.              "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  371.              nil 'move)
  372.             (- (match-end 0) 1)
  373.               (point-min)))
  374.           (point))))
  375.       (or (nth 3 state) (nth 4 state) (nth 5 state)))
  376.     (self-insert-command (prefix-numeric-value arg)))
  377.    ((eq (preceding-char) ?%)
  378.     (insert "{\n\n%}\n")
  379.     (forward-line -2)
  380.     (indent-to c-indent-level)
  381.     (bison-edit-code-block))
  382.    ((and (eolp)
  383.      (save-excursion
  384.        (beginning-of-line)
  385.        (looking-at "%[ \t]*union[ \t]*$")))
  386.     (and c-auto-newline
  387.      (insert "\n"))
  388.     (insert "{\n\n}\n")
  389.     (forward-line -2)
  390.     (indent-to c-indent-level)
  391.     (skip-chars-backward "^{")
  392.     (forward-char -1)
  393.     (bison-edit-code-block))
  394.    ((looking-at "[^\n]*\\(\n[ \t]*\\)?{")
  395.     (bison-edit-code-block))
  396.    (t
  397.     (let (indent)
  398.       (end-of-line)
  399.       (if c-auto-newline
  400.       (progn
  401.         (newline)
  402.         (setq indent (bison-indent-line))
  403.         (delete-horizontal-space)
  404.         (indent-to (+ indent c-indent-level))))
  405.       (insert "{\n\n")
  406.       (indent-to (+ indent c-indent-level))
  407.       (insert "}")
  408.       (if (eolp)
  409.       (forward-line 1)
  410.     (insert "\n"))
  411.       (forward-line -2)
  412.       (indent-to (+ indent c-indent-level c-indent-level))
  413.       (skip-chars-backward "^{")
  414.       (forward-char -1))
  415.     (bison-edit-code-block))))
  416.  
  417. (defun bison-edit-code-block ()
  418.   "Edit the code block associated with the current line of parser description."
  419.   (interactive)
  420.   (or (looking-at "[^\n]*\\(\n[ \t]*\\)?{")
  421.       (error "No code block attached to this parser description."))
  422.   (while (let (state)
  423.        (skip-chars-forward "^{")
  424.        (setq state (parse-partial-sexp
  425.             (save-excursion
  426.               (if (re-search-backward
  427.                    "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  428.                    nil 'move)
  429.                   (- (match-end 0) 1)
  430.                 (point-min)))
  431.             (point)))
  432.        (or (nth 3 state) (nth 4 state) (nth 5 state)))
  433.     (forward-char 1))
  434.   (narrow-to-region (point)
  435.             (save-excursion
  436.               (bison-forward-list)
  437.               (point)))
  438.   (bison-reveal-code-blocks)
  439.   (forward-line 1)
  440.   (skip-chars-forward " \t")
  441.   (setq block-indent-level (current-column))
  442.   (let ((modp (buffer-modified-p))
  443.     indent block)
  444.     (setq block block-indent-level)
  445.     (bison-swap-to-mode 'bison-block-mode)
  446.     (setq bison-block-is-division nil)
  447.     (goto-char (point-min))
  448.     (forward-char 1)
  449.     (if (looking-at "[ \t]*\n")
  450.     (forward-line 1))
  451.     (while (not (eobp))
  452.       (delete-region (point) (save-excursion
  453.                    (skip-chars-forward " \t")
  454.                    (setq indent (current-column))
  455.                    (point)))
  456.       (if (not (or (eq (following-char) ?\n)
  457.            (and (eq (following-char) ?}) (save-excursion
  458.                            (forward-char 1)
  459.                            (eobp)))))
  460.       (indent-to (- indent (- c-indent-level) block)))
  461.       (forward-line 1))
  462.     (set-buffer-modified-p modp))
  463.   (goto-char (+ (point-min) 1))
  464.   (and (eolp)
  465.        (forward-char 1))
  466.   (skip-chars-forward " \t")
  467.   (message (if (eq (key-binding "\C-c\C-c") 'bison-widen)
  468.            "Enter C-c C-c to return to Bison mode."
  469.          (substitute-command-keys
  470.           "Enter \\[bison-widen] to return to Bison mode."))))
  471.  
  472. (defun bison-swap-to-mode (mode-def)
  473.   "Restore the saved alternate mode, or create it by funcall-ing MODE-DEF."
  474.   (let ((elt (assoc (current-buffer) bison-buffer-local-alist))
  475.     state)
  476.     (setq state (append
  477.          (buffer-local-variables)
  478.          (list (cons 'F:local-map (current-local-map)))
  479.          (list (cons 'F:syntax-table (syntax-table)))))
  480.     (if elt
  481.     (progn
  482.       (kill-all-local-variables)
  483.       (mapcar (function (lambda (arg)
  484.                   (if (string-match "^F:" (symbol-name (car arg)))
  485.                   (funcall (car arg) (cdr arg))
  486.                 (make-local-variable (car arg))
  487.                 (set (car arg) (cdr arg)))))
  488.           (cdr elt))
  489.       (setcdr elt state))
  490.       (if mode-def
  491.       (funcall mode-def)
  492.     (error "No saved buffer modes for this buffer."))
  493.       (setq bison-buffer-local-alist (cons (cons (current-buffer) state)
  494.                        bison-buffer-local-alist)))))
  495.  
  496. (defun bison-hide-code-blocks ()
  497.   "Hide all blocks of C code (balanced {} expressions) within the buffer."
  498.   (message "Prefrobnicating...")
  499.   (let ((modp (buffer-modified-p))
  500.     (selective-display nil)
  501.     (divisions 1)
  502.     state end c-division)
  503.     (save-excursion
  504.       (goto-char (point-min))
  505.       (while (and (< divisions 3)
  506.           (re-search-forward "^%%\\|{" nil 'move))
  507.     (if (progn
  508.           (setq state (parse-partial-sexp
  509.                (save-excursion
  510.                  (if (re-search-backward
  511.                   "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  512.                   nil 'move)
  513.                  (- (match-end 0) 1)
  514.                    (point-min)))
  515.                (point)))
  516.           (or (nth 3 state) (nth 4 state) (nth 5 state)))
  517.         (forward-line 1)
  518.       (if (save-excursion
  519.         (beginning-of-line)
  520.         (looking-at "^%%"))
  521.           (progn
  522.         (if (= (setq divisions (1+ divisions)) 3)
  523.             (save-excursion
  524.               (forward-line 1)
  525.               (setq c-division (point))))
  526.         (forward-char 1))
  527.         (or (bobp) (forward-char -1))
  528.         (if (save-excursion
  529.           (beginning-of-line)
  530.           (and (not (bobp)) (looking-at "[ \t]*{")))
  531.         (progn
  532.           (beginning-of-line)
  533.           (forward-char -1)))
  534.         (setq end (save-excursion
  535.             (bison-forward-list)
  536.             (point)))
  537.         (while (search-forward "\n" end 'move)
  538.           (delete-char -1)
  539.           (insert "\r")))))
  540.       (if (= divisions 3)
  541.       (progn
  542.         (goto-char c-division)
  543.         (narrow-to-region (point-min) (point)))))
  544.     (set-buffer-modified-p modp))
  545.   (message "Prefrobnicating... done."))
  546.  
  547. (defun bison-reveal-code-blocks ()
  548.   "Un-hide code blocks in the current restriction of the buffer."
  549.   (let ((modp (buffer-modified-p)))
  550.     (save-excursion
  551.       (goto-char (point-min))
  552.       (replace-string "\r" "\n"))
  553.     (set-buffer-modified-p modp)))
  554.  
  555. (defun bison-forward-list ()
  556.   "Skip forward over a valid C-mode list."
  557.   (let ((syntax (syntax-table)))
  558.     (set-syntax-table c-mode-syntax-table)
  559.     (forward-sexp)
  560.     (set-syntax-table syntax)))
  561.  
  562. (defun bison-block-mode ()
  563.   "Major mode (actually, submode) for editing blocks of C code within a Bison
  564. file.  See the documentation for C mode for details.
  565. \\{c-mode-map}"
  566.   (interactive)
  567.   (let (c-mode-hook)
  568.     (c-mode))
  569.   (setq mode-name "Bison Block")
  570.   (setq major-mode 'bison-block-mode)
  571.   (make-variable-buffer-local 'bison-block-is-division)
  572.   (setq bison-block-is-division nil)
  573.   (local-set-key "\C-c\C-c" 'bison-widen)
  574.   (local-set-key "\C-xw" 'bison-widen)
  575.   (run-hooks 'c-mode-hook 'bison-block-mode-hook))
  576.  
  577. (defun bison-edit-c-division ()
  578.   "Switch to editing the third division of the Bison buffer, creating it if
  579. it doesn't exist.  The buffer is placed in Bison Block mode."
  580.   (interactive)
  581.   (let ((divisions 1)
  582.     (endpoint (point-max))
  583.     state)
  584.     (widen)
  585.     (save-excursion
  586.       (goto-char (point-min))
  587.       (while (and (< divisions 3)
  588.           (re-search-forward "^%%" nil t)
  589.           (progn
  590.             (setq state (parse-partial-sexp
  591.                  (save-excursion
  592.                    (if (re-search-backward
  593.                     "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  594.                     nil 'move)
  595.                        (- (match-end 0) 1)
  596.                      (point-min)))
  597.                  (point)))
  598.             (not (or (nth 3 state) (nth 4 state) (nth 5 state)))))
  599.     (setq divisions (1+ divisions))))
  600.     (goto-char endpoint)
  601.     (if (not (eq (preceding-char) ?\n))
  602.     (insert "\n"))
  603.     (while (< divisions 3)
  604.       (insert "%%\n\n")
  605.       (and (= (setq divisions (1+ divisions)) 3)
  606.        (forward-char -1)))
  607.     (narrow-to-region (point) (point-max))
  608.     (bison-swap-to-mode 'bison-block-mode)
  609.     (setq bison-block-is-division t)
  610.     (message (if (eq (key-binding "\C-c\C-c") 'bison-widen)
  611.          "Enter C-c C-c to return to Bison mode."
  612.            (substitute-command-keys
  613.         "Enter \\[bison-widen] to return to Bison mode.")))))
  614.  
  615. (defun bison-widen ()
  616.   "Save the current block of embedded C code and return to Bison mode."
  617.   (interactive)
  618.   (if (and (boundp 'bison-block-is-division)
  619.        bison-block-is-division)
  620.       ()
  621.     (let ((indent (assoc 'block-indent-level
  622.              (assoc (current-buffer) bison-buffer-local-alist))))
  623.       (setq indent (if indent (cdr indent) 0))
  624.       (goto-char (point-min))
  625.       (forward-line 1)
  626.       (while (not (eobp))
  627.     (skip-chars-forward " \t")
  628.     (if (looking-at "[ \t]*\n")
  629.         (delete-region (save-excursion
  630.                  (beginning-of-line)
  631.                  (point))
  632.                (point))
  633.       (indent-to (+ (current-column) (- c-indent-level) indent)))
  634.     (forward-line 1))))
  635.   (goto-char (point-min))
  636.   (save-excursion
  637.     (widen)
  638.     (bison-hide-code-blocks)
  639.     (bison-swap-to-mode nil))
  640.   (if (save-excursion
  641.     (beginning-of-line)
  642.     (looking-at "[ \t]*{"))
  643.       (beginning-of-line))
  644.   (or (bobp)
  645.       (forward-char -1)))
  646.  
  647. (defun bison-auto-continuation-mode (&optional arg)
  648.   "Arrange for definition lines to continue themselves."
  649.   (interactive)
  650.   (setq auto-fill-hook
  651.     (if (or (and (numberp arg)
  652.              (> arg 0))
  653.         (not (eq auto-fill-hook 'bison-auto-continue)))
  654.         'bison-auto-continue
  655.       nil)))
  656.  
  657. (defun bison-auto-continue ()
  658.   "Copy the current line's prefix to a new line, iff it starts with %.
  659. Otherwise, indent past bison-colon-column."
  660.   (let ((state (parse-partial-sexp
  661.         (save-excursion
  662.           (if (re-search-backward
  663.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  664.                nil 'move)
  665.               (- (match-end 0) 1)
  666.             (point-min)))
  667.         (point))))
  668.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  669.     ()
  670.       (if (save-excursion
  671.         (beginning-of-line)
  672.         (looking-at "%[ \t]*[^u%{}]"))
  673.       (let ((prefix (save-excursion
  674.               (beginning-of-line)
  675.               (buffer-substring (point)
  676.                         (save-excursion
  677.                           (skip-chars-forward "^ \t\n<")
  678.                           (point))))))
  679.         (insert "\n" prefix)
  680.         (or (eq (preceding-char) ?\ )
  681.         (eq (preceding-char) ?\t)
  682.         (insert " ")))
  683.     (insert "\n")
  684.     (indent-to (+ bison-colon-column 2))))))
  685.  
  686.  
  687. From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!NCoast.ORG!allbery Thu Dec 21 23:02:57 EST 1989
  688. Article 865 of gnu.emacs:
  689. Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!NCoast.ORG!allbery
  690. >From: allbery@NCoast.ORG
  691. Newsgroups: gnu.emacs
  692. Subject: Bison mode for Gnu Emacs (repost)
  693. Message-ID: <8912220033.AA11027@NCoast.ORG>
  694. Date: 22 Dec 89 00:32:57 GMT
  695. Sender: daemon@tut.cis.ohio-state.edu
  696. Distribution: gnu
  697. Organization: GNUs Not Usenet
  698. Lines: 664
  699.  
  700. I screwed up on the copyright in the previous post.  Wipe the previous copy
  701. and use this instead.
  702.  
  703. ++Brandon
  704.  
  705. ;; Bison (or Yacc) mode for Gnu Emacs
  706. ;; Brandon S. Allbery, allbery@NCoast.ORG; buggestions welcome
  707.  
  708. ;; Copyright (C) 1989 Brandon S. Allbery
  709.  
  710. ;; This file is part of GNU Emacs.
  711.  
  712. ;; GNU Emacs is distributed in the hope that it will be useful,
  713. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  714. ;; accepts responsibility to anyone for the consequences of using it
  715. ;; or for whether it serves any particular purpose or works at all,
  716. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  717. ;; License for full details.
  718.  
  719. ;; Everyone is granted permission to copy, modify and redistribute
  720. ;; GNU Emacs, but only under the conditions described in the
  721. ;; GNU Emacs General Public License.   A copy of this license is
  722. ;; supposed to have been given to you along with GNU Emacs so you
  723. ;; can know your rights and responsibilities.  It should be in a
  724. ;; file named COPYING.  Among other things, the copyright notice
  725. ;; and this notice must be preserved on all copies.
  726.  
  727. ;; Bison, Yacc, and similar parser compilers all are unusual in that
  728. ;; parts of the file are in C mode instead of the parser language mode.
  729. ;; This requires some interesting hackery on the part of Emacs; when
  730. ;; switching from one part of the file to another, the state of the buffer
  731. ;; is saved on an alist and the buffer's mode is changed.  This is
  732. ;; arranged such that each buffer has its own saved state for both Bison
  733. ;; and Bison-Block (aka C) modes; much work is done to avoid losing
  734. ;; buffer-local information in either major mode while not confusing the
  735. ;; two.
  736.  
  737. ;; Bison mode knows quite a bit about C mode, and uses the known values
  738. ;; of c-indent-level and c-auto-newline, among others.  Unfortunately,
  739. ;; it does not properly handle all such combinations of C-mode settings.
  740. ;; It does support both my old coding style and my current style, which
  741. ;; is sufficient for my purposes.
  742.  
  743. ;; Also included is an "auto-fill" mode which continues definition lines
  744. ;; (%token, %left, etc.) and wraps long token sequences to the proper
  745. ;; column automagically.  This is disabled by default; see the function
  746. ;; (bison-auto-continuation-mode) for more information.
  747.  
  748. ;; The code has survived mostly intact my most recent go at updating USP
  749. ;; (see comp.sources.misc), and I therefore consider it (mostly) stable.
  750. ;; No doubt someone will find something that needs to be fixed; send mail
  751. ;; to allbery@ncoast.org in that case.  I intend to keep Bison mode up to
  752. ;; date, since it makes my life a lot easier.  (Now if I could use gcc and
  753. ;; Bison without running into collisions between the GPL and other license
  754. ;; agreements....)
  755.  
  756. (defvar bison-buffer-local-alist nil
  757.   "Alist of bison mode buffers, and saved local variables thereto.")
  758.  
  759. (defconst bison-colon-column 16 "\
  760. *The column in which to place a colon separating a token from its definition.")
  761.  
  762. (defconst bison-percent-column 41 "\
  763. *The column in which to place a percent introducing a modifier (e.g. %prec).")
  764.  
  765. (defvar bison-mode-abbrev-table nil
  766.   "Abbrev table used in bison-mode buffers.")
  767. (define-abbrev-table 'bison-mode-abbrev-table ())
  768.  
  769. (defvar bison-mode-map ()
  770.   "Keymap used in bison mode.")
  771. (if bison-mode-map
  772.     ()
  773.   (setq bison-mode-map (make-sparse-keymap))
  774.   (define-key bison-mode-map "{" 'bison-insert-edit-code-block)
  775.   (define-key bison-mode-map ";" 'electric-bison-semi)
  776.   (define-key bison-mode-map ":" 'electric-bison-colon)
  777.   (define-key bison-mode-map "|" 'electric-bison-colon)
  778.   (define-key bison-mode-map "%" 'electric-bison-per)
  779.   (define-key bison-mode-map "\C-c%" 'bison-edit-c-division)
  780.   (define-key bison-mode-map "\177" 'backward-delete-char-untabify)
  781.   (define-key bison-mode-map "\t" 'bison-indent-command))
  782.  
  783. (defvar bison-mode-syntax-table nil
  784.   "Syntax table in use in bison-mode buffers.")
  785. (if bison-mode-syntax-table
  786.     ()
  787.   (setq bison-mode-syntax-table (make-syntax-table))
  788.   (modify-syntax-entry ?/ ". 14" bison-mode-syntax-table)
  789.   (modify-syntax-entry ?* ". 23" bison-mode-syntax-table)
  790.   (modify-syntax-entry ?{ "(}  " bison-mode-syntax-table)
  791.   (modify-syntax-entry ?} "){  " bison-mode-syntax-table)
  792.   (modify-syntax-entry ?\\ "\\  " bison-mode-syntax-table)
  793.   (modify-syntax-entry ?\' "\"   " bison-mode-syntax-table)
  794.   (modify-syntax-entry ?\: "(;  " bison-mode-syntax-table)
  795.   (modify-syntax-entry ?\; "):  " bison-mode-syntax-table))
  796.  
  797. (fset 'F:local-map (symbol-function 'use-local-map))
  798. (fset 'F:syntax-table (symbol-function 'set-syntax-table))
  799.  
  800. (defun bison-mode ()
  801.   "Major mode for editing Bison or Yacc code for a C target.
  802. Blocks of C code are replaced with ellipses unless expanded, which causes the
  803. buffer to be narrowed and switched to C mode; the C and Bison environments are
  804. preserved when not active.  { inserts a new block if necessary.
  805. \\{bison-mode-map}
  806. Turning on Bison mode calls the value of the variable bison-mode-hook with
  807. no args if it is non-nil.  The first time the buffer is narrowed to a block,
  808. the value of c-mode-hook will be called with no args within the narrowed
  809. environment if it is non-nil."
  810.   (interactive)
  811.   (kill-all-local-variables)
  812.   ;; anyone got a better way to do this?
  813.   (let ((elt (if bison-buffer-local-alist
  814.          (assoc (current-buffer) bison-buffer-local-alist))))
  815.     (and elt
  816.      (setcdr elt nil)))
  817.   (use-local-map bison-mode-map)
  818.   (setq major-mode 'bison-mode)
  819.   (setq mode-name "Bison")
  820.   (setq local-abbrev-table bison-mode-abbrev-table)
  821.   (set-syntax-table bison-mode-syntax-table)
  822.   (make-local-variable 'paragraph-start)
  823.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  824.   (make-local-variable 'paragraph-separate)
  825.   (setq paragraph-separate paragraph-start)
  826.   (make-local-variable 'paragraph-ignore-fill-prefix)
  827.   (setq paragraph-ignore-fill-prefix t)
  828.   (make-local-variable 'indent-line-function)
  829.   (setq indent-line-function 'bison-indent-line)
  830.   (make-local-variable 'require-final-newline)
  831.   (setq require-final-newline t)
  832.   (make-local-variable 'comment-start)
  833.   (setq comment-start "/* ")
  834.   (make-local-variable 'comment-end)
  835.   (setq comment-end " */")
  836.   (make-local-variable 'comment-column)
  837.   (setq comment-column 40)
  838.   (make-local-variable 'comment-start-skip)
  839.   (setq comment-start-skip "/\\*+ *")
  840.   (make-local-variable 'comment-indent-hook)
  841.   (setq comment-indent-hook 'c-comment-indent)
  842.   (make-local-variable 'parse-sexp-ignore-comments)
  843.   (setq parse-sexp-ignore-comments t)
  844.   (make-local-variable 'selective-display)
  845.   (setq selective-display t)
  846.   (make-local-variable 'selective-display-ellipses)
  847.   (setq selective-display-ellipses t)
  848.   (make-local-variable 'block-indent-level)
  849.   (make-local-variable 'auto-fill-hook)
  850.   (bison-hide-code-blocks)
  851.   (run-hooks 'bison-mode-hook 'c-mode-hook))
  852.  
  853. (defun electric-bison-colon (arg)
  854.   "Insert character and correct line's indentation."
  855.   (interactive "P")
  856.   (let ((state (parse-partial-sexp
  857.         (save-excursion
  858.           (if (re-search-backward
  859.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  860.                nil 'move)
  861.               (- (match-end 0) 1)
  862.             (point-min)))
  863.         (point))))
  864.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  865.     (self-insert-command (prefix-numeric-value arg))
  866.       (if (and (not arg) (eolp))
  867.       (progn
  868.         (bison-indent-line)
  869.         (and c-auto-newline
  870.          (eq last-command-char ?\|)
  871.          (save-excursion
  872.            (beginning-of-line)
  873.            (not (looking-at "[ \t]*$")))
  874.          (newline))
  875.         (delete-horizontal-space)
  876.         (indent-to bison-colon-column)
  877.         (insert last-command-char)
  878.         (insert " "))
  879.     (self-insert-command (prefix-numeric-value arg))))))
  880.  
  881. (defun electric-bison-semi (arg)
  882.   "Insert character and correct line's indentation."
  883.   (interactive "P")
  884.   (if c-auto-newline
  885.       (electric-bison-terminator arg)
  886.     (self-insert-command (prefix-numeric-value arg))))
  887.  
  888. (defun electric-bison-per (arg)
  889.   "Insert character and correct line's indentation."
  890.   (interactive "P")
  891.   (let ((state (parse-partial-sexp
  892.         (save-excursion
  893.           (if (re-search-backward
  894.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  895.                nil 'move)
  896.               (- (match-end 0) 1)
  897.             (point-min)))
  898.         (point))))
  899.     (if (and (not arg)
  900.          (eolp)
  901.          (not (eq (preceding-char) ?%))
  902.          (not (or (nth 3 state) (nth 4 state) (nth 5 state))))
  903.     (if (not (save-excursion
  904.            (skip-chars-backward " \t")
  905.            (bolp)))
  906.         (indent-to bison-percent-column)
  907.       (delete-region (save-excursion
  908.                (beginning-of-line)
  909.                (point))
  910.              (point))))
  911.     (self-insert-command (prefix-numeric-value arg))))
  912.  
  913. (defun electric-bison-terminator (arg)
  914.   "Insert character and correct line's indentation."
  915.   (interactive "P")
  916.   (let ((state (parse-partial-sexp
  917.         (save-excursion
  918.           (if (re-search-backward
  919.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  920.                nil 'move)
  921.               (- (match-end 0) 1)
  922.             (point-min)))
  923.         (point)))
  924.     insertpos)
  925.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  926.     (self-insert-command (prefix-numeric-value arg))
  927.       (if (and (not arg) (eolp)
  928.            (not (save-excursion
  929.               (beginning-of-line)
  930.               (skip-chars-forward " \t")
  931.               (= (following-char) ?%))))
  932.       (progn
  933.         (and c-auto-newline
  934.          (progn
  935.            (if (save-excursion
  936.              (beginning-of-line)
  937.              (not (looking-at "[ \t]*$")))
  938.                (newline))
  939.            (bison-indent-line)
  940.            (backward-delete-char-untabify 2)))
  941.         (insert last-command-char)
  942.         (bison-indent-line)
  943.         (and c-auto-newline
  944.          (progn
  945.            (newline)
  946.            (setq insertpos (- (point) 2))
  947.            (bison-indent-line)))
  948.         (save-excursion
  949.           (if insertpos (goto-char (1+ insertpos)))
  950.           (delete-char -1))))
  951.       (if insertpos
  952.       (save-excursion
  953.         (goto-char insertpos)
  954.         (self-insert-command (prefix-numeric-value arg)))
  955.     (self-insert-command (prefix-numeric-value arg))))))
  956.  
  957. (defun bison-indent-command (&optional whole-exp)
  958.   "Indent current line as Bison code, or in some cases insert a tab character.
  959. If c-tab-always-indent is non-nil (the default), always indent current line.
  960. Otherwise, indent the current line only if point is at the left margin
  961. or in the line's indentation; otherwise insert a tab.
  962.  
  963. A numeric argument, regardless of its value,
  964. means indent rigidly all the lines of the expression starting after point
  965. so that this line becomes properly indented.
  966. The relative indentation among the lines of the expression are preserved."
  967.   (interactive "P")
  968.   (if whole-exp
  969.       (let ((shift-amount (bison-indent-line))
  970.         beg end)
  971.     (save-excursion
  972.       (if c-tab-always-indent
  973.           (beginning-of-line))
  974.       (setq beg (point))
  975.       (re-search-forward ";\\|^%%" nil 'move)
  976.       (if (save-excursion
  977.         (beginning-of-line)
  978.         (looking-at "%%"))
  979.           (progn
  980.         (forward-line -1)
  981.         (end-of-line)))
  982.       (setq end (point))
  983.       (goto-char beg)
  984.       (forward-line 1)
  985.       (setq beg (point)))
  986.     (if (> end beg)
  987.         (indent-code-rigidly beg end shift-amount "%")))
  988.     (if (and (not c-tab-always-indent)
  989.          (save-excursion
  990.            (skip-chars-backward " \t")
  991.            (not (bolp))))
  992.     (insert-tab)
  993.       (bison-indent-line))))
  994.  
  995. (defun bison-indent-line ()
  996.   "Indent current line as Bison code.
  997. Return the amount the indentation changed by."
  998.   ;; Lines are indented if and only if a colon is found before a semicolon
  999.   ;; while searching backward.  String-quoted characters are ignored.
  1000.   (let (indent)
  1001.     (save-excursion
  1002.       (cond
  1003.        ((save-excursion
  1004.       (let ((limit (point))
  1005.         state)
  1006.         (goto-char (point-min))
  1007.         (not (and (re-search-forward "^%%" limit t)
  1008.               (progn
  1009.             (parse-partial-sexp
  1010.              (save-excursion
  1011.                (if (re-search-backward
  1012.                 "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1013.                 nil 'move)
  1014.                    (- (match-end 0) 1)
  1015.                  (point-min)))
  1016.              (point))
  1017.             (not (or (nth 3 state)
  1018.                  (nth 4 state)
  1019.                  (nth 5 state))))))))
  1020.     (setq indent 0))
  1021.        ((save-excursion
  1022.       (beginning-of-line)
  1023.       (looking-at "[ \t]*%"))
  1024.     (setq indent 0))
  1025.        ((save-excursion
  1026.       (skip-chars-backward " \t\n\f")
  1027.       (eq (preceding-char) ?\;))
  1028.     (setq indent 0))
  1029.        (t
  1030.     (beginning-of-line)
  1031.     (while (not (or (bobp)
  1032.             (looking-at "[ \t]*\\(\sw\\|\s_\\)*[ \t]*[|:]")
  1033.             (eq (following-char) ?%)))
  1034.       (forward-line -1))
  1035.     (skip-chars-forward "^:|")
  1036.     (skip-chars-forward ":| \t")
  1037.     (setq indent (current-column)))))
  1038.     (indent-to indent)
  1039.     indent))
  1040.  
  1041. (defun bison-insert-edit-code-block (arg)
  1042.   "Edit the code block associated with the current line of parser description.
  1043. If no such block is found, create one."
  1044.   (interactive "P")
  1045.   (cond
  1046.    ((let ((state (parse-partial-sexp
  1047.           (save-excursion
  1048.             (if (re-search-backward
  1049.              "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1050.              nil 'move)
  1051.             (- (match-end 0) 1)
  1052.               (point-min)))
  1053.           (point))))
  1054.       (or (nth 3 state) (nth 4 state) (nth 5 state)))
  1055.     (self-insert-command (prefix-numeric-value arg)))
  1056.    ((eq (preceding-char) ?%)
  1057.     (insert "{\n\n%}\n")
  1058.     (forward-line -2)
  1059.     (indent-to c-indent-level)
  1060.     (bison-edit-code-block))
  1061.    ((and (eolp)
  1062.      (save-excursion
  1063.        (beginning-of-line)
  1064.        (looking-at "%[ \t]*union[ \t]*$")))
  1065.     (and c-auto-newline
  1066.      (insert "\n"))
  1067.     (insert "{\n\n}\n")
  1068.     (forward-line -2)
  1069.     (indent-to c-indent-level)
  1070.     (skip-chars-backward "^{")
  1071.     (forward-char -1)
  1072.     (bison-edit-code-block))
  1073.    ((looking-at "[^\n]*\\(\n[ \t]*\\)?{")
  1074.     (bison-edit-code-block))
  1075.    (t
  1076.     (let (indent)
  1077.       (end-of-line)
  1078.       (if c-auto-newline
  1079.       (progn
  1080.         (newline)
  1081.         (setq indent (bison-indent-line))
  1082.         (delete-horizontal-space)
  1083.         (indent-to (+ indent c-indent-level))))
  1084.       (insert "{\n\n")
  1085.       (indent-to (+ indent c-indent-level))
  1086.       (insert "}")
  1087.       (if (eolp)
  1088.       (forward-line 1)
  1089.     (insert "\n"))
  1090.       (forward-line -2)
  1091.       (indent-to (+ indent c-indent-level c-indent-level))
  1092.       (skip-chars-backward "^{")
  1093.       (forward-char -1))
  1094.     (bison-edit-code-block))))
  1095.  
  1096. (defun bison-edit-code-block ()
  1097.   "Edit the code block associated with the current line of parser description."
  1098.   (interactive)
  1099.   (or (looking-at "[^\n]*\\(\n[ \t]*\\)?{")
  1100.       (error "No code block attached to this parser description."))
  1101.   (while (let (state)
  1102.        (skip-chars-forward "^{")
  1103.        (setq state (parse-partial-sexp
  1104.             (save-excursion
  1105.               (if (re-search-backward
  1106.                    "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1107.                    nil 'move)
  1108.                   (- (match-end 0) 1)
  1109.                 (point-min)))
  1110.             (point)))
  1111.        (or (nth 3 state) (nth 4 state) (nth 5 state)))
  1112.     (forward-char 1))
  1113.   (narrow-to-region (point)
  1114.             (save-excursion
  1115.               (bison-forward-list)
  1116.               (point)))
  1117.   (bison-reveal-code-blocks)
  1118.   (forward-line 1)
  1119.   (skip-chars-forward " \t")
  1120.   (setq block-indent-level (current-column))
  1121.   (let ((modp (buffer-modified-p))
  1122.     indent block)
  1123.     (setq block block-indent-level)
  1124.     (bison-swap-to-mode 'bison-block-mode)
  1125.     (setq bison-block-is-division nil)
  1126.     (goto-char (point-min))
  1127.     (forward-char 1)
  1128.     (if (looking-at "[ \t]*\n")
  1129.     (forward-line 1))
  1130.     (while (not (eobp))
  1131.       (delete-region (point) (save-excursion
  1132.                    (skip-chars-forward " \t")
  1133.                    (setq indent (current-column))
  1134.                    (point)))
  1135.       (if (not (or (eq (following-char) ?\n)
  1136.            (and (eq (following-char) ?}) (save-excursion
  1137.                            (forward-char 1)
  1138.                            (eobp)))))
  1139.       (indent-to (- indent (- c-indent-level) block)))
  1140.       (forward-line 1))
  1141.     (set-buffer-modified-p modp))
  1142.   (goto-char (+ (point-min) 1))
  1143.   (and (eolp)
  1144.        (forward-char 1))
  1145.   (skip-chars-forward " \t")
  1146.   (message (if (eq (key-binding "\C-c\C-c") 'bison-widen)
  1147.            "Enter C-c C-c to return to Bison mode."
  1148.          (substitute-command-keys
  1149.           "Enter \\[bison-widen] to return to Bison mode."))))
  1150.  
  1151. (defun bison-swap-to-mode (mode-def)
  1152.   "Restore the saved alternate mode, or create it by funcall-ing MODE-DEF."
  1153.   (let ((elt (assoc (current-buffer) bison-buffer-local-alist))
  1154.     state)
  1155.     (setq state (append
  1156.          (buffer-local-variables)
  1157.          (list (cons 'F:local-map (current-local-map)))
  1158.          (list (cons 'F:syntax-table (syntax-table)))))
  1159.     (if elt
  1160.     (progn
  1161.       (kill-all-local-variables)
  1162.       (mapcar (function (lambda (arg)
  1163.                   (if (string-match "^F:" (symbol-name (car arg)))
  1164.                   (funcall (car arg) (cdr arg))
  1165.                 (make-local-variable (car arg))
  1166.                 (set (car arg) (cdr arg)))))
  1167.           (cdr elt))
  1168.       (setcdr elt state))
  1169.       (if mode-def
  1170.       (funcall mode-def)
  1171.     (error "No saved buffer modes for this buffer."))
  1172.       (setq bison-buffer-local-alist (cons (cons (current-buffer) state)
  1173.                        bison-buffer-local-alist)))))
  1174.  
  1175. (defun bison-hide-code-blocks ()
  1176.   "Hide all blocks of C code (balanced {} expressions) within the buffer."
  1177.   (message "Prefrobnicating...")
  1178.   (let ((modp (buffer-modified-p))
  1179.     (selective-display nil)
  1180.     (divisions 1)
  1181.     state end c-division)
  1182.     (save-excursion
  1183.       (goto-char (point-min))
  1184.       (while (and (< divisions 3)
  1185.           (re-search-forward "^%%\\|{" nil 'move))
  1186.     (if (progn
  1187.           (setq state (parse-partial-sexp
  1188.                (save-excursion
  1189.                  (if (re-search-backward
  1190.                   "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1191.                   nil 'move)
  1192.                  (- (match-end 0) 1)
  1193.                    (point-min)))
  1194.                (point)))
  1195.           (or (nth 3 state) (nth 4 state) (nth 5 state)))
  1196.         (forward-line 1)
  1197.       (if (save-excursion
  1198.         (beginning-of-line)
  1199.         (looking-at "^%%"))
  1200.           (progn
  1201.         (if (= (setq divisions (1+ divisions)) 3)
  1202.             (save-excursion
  1203.               (forward-line 1)
  1204.               (setq c-division (point))))
  1205.         (forward-char 1))
  1206.         (or (bobp) (forward-char -1))
  1207.         (if (save-excursion
  1208.           (beginning-of-line)
  1209.           (and (not (bobp)) (looking-at "[ \t]*{")))
  1210.         (progn
  1211.           (beginning-of-line)
  1212.           (forward-char -1)))
  1213.         (setq end (save-excursion
  1214.             (bison-forward-list)
  1215.             (point)))
  1216.         (while (search-forward "\n" end 'move)
  1217.           (delete-char -1)
  1218.           (insert "\r")))))
  1219.       (if (= divisions 3)
  1220.       (progn
  1221.         (goto-char c-division)
  1222.         (narrow-to-region (point-min) (point)))))
  1223.     (set-buffer-modified-p modp))
  1224.   (message "Prefrobnicating... done."))
  1225.  
  1226. (defun bison-reveal-code-blocks ()
  1227.   "Un-hide code blocks in the current restriction of the buffer."
  1228.   (let ((modp (buffer-modified-p)))
  1229.     (save-excursion
  1230.       (goto-char (point-min))
  1231.       (replace-string "\r" "\n"))
  1232.     (set-buffer-modified-p modp)))
  1233.  
  1234. (defun bison-forward-list ()
  1235.   "Skip forward over a valid C-mode list."
  1236.   (let ((syntax (syntax-table)))
  1237.     (set-syntax-table c-mode-syntax-table)
  1238.     (forward-sexp)
  1239.     (set-syntax-table syntax)))
  1240.  
  1241. (defun bison-block-mode ()
  1242.   "Major mode (actually, submode) for editing blocks of C code within a Bison
  1243. file.  See the documentation for C mode for details.
  1244. \\{c-mode-map}"
  1245.   (interactive)
  1246.   (let (c-mode-hook)
  1247.     (c-mode))
  1248.   (setq mode-name "Bison Block")
  1249.   (setq major-mode 'bison-block-mode)
  1250.   (make-variable-buffer-local 'bison-block-is-division)
  1251.   (setq bison-block-is-division nil)
  1252.   (local-set-key "\C-c\C-c" 'bison-widen)
  1253.   (local-set-key "\C-xw" 'bison-widen)
  1254.   (run-hooks 'c-mode-hook 'bison-block-mode-hook))
  1255.  
  1256. (defun bison-edit-c-division ()
  1257.   "Switch to editing the third division of the Bison buffer, creating it if
  1258. it doesn't exist.  The buffer is placed in Bison Block mode."
  1259.   (interactive)
  1260.   (let ((divisions 1)
  1261.     (endpoint (point-max))
  1262.     state)
  1263.     (widen)
  1264.     (save-excursion
  1265.       (goto-char (point-min))
  1266.       (while (and (< divisions 3)
  1267.           (re-search-forward "^%%" nil t)
  1268.           (progn
  1269.             (setq state (parse-partial-sexp
  1270.                  (save-excursion
  1271.                    (if (re-search-backward
  1272.                     "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1273.                     nil 'move)
  1274.                        (- (match-end 0) 1)
  1275.                      (point-min)))
  1276.                  (point)))
  1277.             (not (or (nth 3 state) (nth 4 state) (nth 5 state)))))
  1278.     (setq divisions (1+ divisions))))
  1279.     (goto-char endpoint)
  1280.     (if (not (eq (preceding-char) ?\n))
  1281.     (insert "\n"))
  1282.     (while (< divisions 3)
  1283.       (insert "%%\n\n")
  1284.       (and (= (setq divisions (1+ divisions)) 3)
  1285.        (forward-char -1)))
  1286.     (narrow-to-region (point) (point-max))
  1287.     (bison-swap-to-mode 'bison-block-mode)
  1288.     (setq bison-block-is-division t)
  1289.     (message (if (eq (key-binding "\C-c\C-c") 'bison-widen)
  1290.          "Enter C-c C-c to return to Bison mode."
  1291.            (substitute-command-keys
  1292.         "Enter \\[bison-widen] to return to Bison mode.")))))
  1293.  
  1294. (defun bison-widen ()
  1295.   "Save the current block of embedded C code and return to Bison mode."
  1296.   (interactive)
  1297.   (if (and (boundp 'bison-block-is-division)
  1298.        bison-block-is-division)
  1299.       ()
  1300.     (let ((indent (assoc 'block-indent-level
  1301.              (assoc (current-buffer) bison-buffer-local-alist))))
  1302.       (setq indent (if indent (cdr indent) 0))
  1303.       (goto-char (point-min))
  1304.       (forward-line 1)
  1305.       (while (not (eobp))
  1306.     (skip-chars-forward " \t")
  1307.     (if (looking-at "[ \t]*\n")
  1308.         (delete-region (save-excursion
  1309.                  (beginning-of-line)
  1310.                  (point))
  1311.                (point))
  1312.       (indent-to (+ (current-column) (- c-indent-level) indent)))
  1313.     (forward-line 1))))
  1314.   (goto-char (point-min))
  1315.   (save-excursion
  1316.     (widen)
  1317.     (bison-hide-code-blocks)
  1318.     (bison-swap-to-mode nil))
  1319.   (if (save-excursion
  1320.     (beginning-of-line)
  1321.     (looking-at "[ \t]*{"))
  1322.       (beginning-of-line))
  1323.   (or (bobp)
  1324.       (forward-char -1)))
  1325.  
  1326. (defun bison-auto-continuation-mode (&optional arg)
  1327.   "Arrange for definition lines to continue themselves."
  1328.   (interactive)
  1329.   (setq auto-fill-hook
  1330.     (if (or (and (numberp arg)
  1331.              (> arg 0))
  1332.         (not (eq auto-fill-hook 'bison-auto-continue)))
  1333.         'bison-auto-continue
  1334.       nil)))
  1335.  
  1336. (defun bison-auto-continue ()
  1337.   "Copy the current line's prefix to a new line, iff it starts with %.
  1338. Otherwise, indent past bison-colon-column."
  1339.   (let ((state (parse-partial-sexp
  1340.         (save-excursion
  1341.           (if (re-search-backward
  1342.                "^[ \t]*\\(\\s_\\|\\sw\\)+[ \t]*:"
  1343.                nil 'move)
  1344.               (- (match-end 0) 1)
  1345.             (point-min)))
  1346.         (point))))
  1347.     (if (or (nth 3 state) (nth 4 state) (nth 5 state))
  1348.     ()
  1349.       (if (save-excursion
  1350.         (beginning-of-line)
  1351.         (looking-at "%[ \t]*[^u%{}]"))
  1352.       (let ((prefix (save-excursion
  1353.               (beginning-of-line)
  1354.               (buffer-substring (point)
  1355.                         (save-excursion
  1356.                           (skip-chars-forward "^ \t\n<")
  1357.                           (point))))))
  1358.         (insert "\n" prefix)
  1359.         (or (eq (preceding-char) ?\ )
  1360.         (eq (preceding-char) ?\t)
  1361.         (insert " ")))
  1362.     (insert "\n")
  1363.     (indent-to (+ bison-colon-column 2))))))
  1364.