home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / util / edit / jade / lisp / c-mode.jl < prev    next >
Encoding:
Text File  |  1994-10-05  |  9.5 KB  |  302 lines
  1. ;;;; c-mode.jl -- Primitive mode for editing C source
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'c-mode)
  21.  
  22. (defvar c-mode-tab 4
  23.   "Size of indentation for c-mode")
  24.  
  25. (defvar c-mode-keymap (make-keylist))
  26. (bind-keys c-mode-keymap
  27.   "{" 'c-open-brace
  28.   "}" 'c-close-brace
  29.   ":" 'c-colon
  30.   "TAB" 'indent-line)
  31.  
  32. (defvar c-mode-ctrl-c-keymap (make-keylist))
  33. (bind-keys c-mode-ctrl-c-keymap
  34.   "Ctrl-\\" 'c-backslash-region)
  35.  
  36. ;;;###autoload
  37. (defun c-mode ()
  38.   "C Mode:\n
  39. Simple mode for editing C source code. Its main feature is to be able to
  40. indent lines to their (probably) correct depth.\n
  41. Special commands are,\n
  42.   `{', `}', `:'            Insert the character then indent the line
  43.   `TAB'                Indent the current line
  44.   `Ctrl-c Ctrl-\\'        Aligns backslash characters at the end
  45.                 of each line in the current block.
  46.   `ESC Ctrl-b'            Move backwards one expression.
  47.   `ESC Ctrl-f'            Move forward one expression."
  48.   (interactive)
  49.   (when major-mode-kill
  50.     (funcall major-mode-kill (current-buffer)))
  51.   (setq mode-name "C"
  52.     major-mode 'c-mode
  53.     major-mode-kill 'c-mode-kill
  54.     mode-comment-fun 'c-insert-comment
  55.     mode-indent-line 'c-indent-line
  56.     mode-forward-exp 'c-forward-exp
  57.     mode-backward-exp 'c-backward-exp
  58.     ctrl-c-keymap c-mode-ctrl-c-keymap
  59.     keymap-path (cons 'c-mode-keymap keymap-path))
  60.   (eval-hook 'c-mode-hook))
  61.  
  62. (defun c-mode-kill ()
  63.   (setq mode-name nil
  64.     major-mode nil
  65.     major-mode-kill nil
  66.     mode-comment-fun nil
  67.     mode-indent-line nil
  68.     mode-forward-exp nil
  69.     mode-backward-exp nil
  70.     ctrl-c-keymap nil
  71.     keymap-path (delq 'c-mode-keymap keymap-path)))
  72.  
  73. (defun c-open-brace ()
  74.   (interactive)
  75.   (insert "{")
  76.   (indent-line))
  77.  
  78. (defun c-close-brace ()
  79.   (interactive)
  80.   (insert "}")
  81.   (indent-line))
  82.  
  83. (defun c-colon ()
  84.   (interactive)
  85.   (insert ":")
  86.   (indent-line))
  87.  
  88. (defun c-indent-line (&optional pos)
  89.   "Indent the line at POS (or the cursor) assuming that it's C source code."
  90.   (set-indent-pos (c-indent-pos pos)))
  91.  
  92. (defun c-indent-pos (&optional line-pos)
  93.   "*Attempts* to guess the correct indentation for this line. Returns the
  94. position for the first non-space in the line."
  95.   (setq line-pos (line-start line-pos))
  96.   (let*
  97.       ((ind-pos (c-indent-pos-empty line-pos)))
  98.     (when (not (empty-line-p line-pos))
  99.       (cond
  100.        ((regexp-match-line "^[\t ]*({|}|case .*:|default *:)" line-pos)
  101.     (prev-tab 1 ind-pos c-mode-tab))
  102.        ((regexp-match-line "^[\t ]*([a-zA-Z0-9_]*:|#)" line-pos)
  103.     (set-pos-col ind-pos 0))))
  104.     ind-pos))
  105.  
  106. (defun c-indent-pos-empty (&optional line-pos)
  107.   "Returns the position for the first non-space in the line. Bases its guess
  108. upon the assumption that the line is empty.
  109. All positions depend on the indentation of the previous line(s)."
  110.   (setq line-pos (line-start line-pos))
  111.   (let*
  112.       ((p-line-pos (prev-line 1 (copy-pos line-pos))))
  113.     (while (or (empty-line-p p-line-pos)
  114.            (regexp-match-line "^([a-zA-Z0-9_]+:|#)" p-line-pos))
  115.       (unless (prev-line 1 p-line-pos)
  116.     (return)))
  117.     (let*
  118.     ((ind-pos (indent-pos p-line-pos)))
  119.       (set-pos-line ind-pos (pos-line line-pos))
  120.       (cond
  121.        ((regexp-match-line "{|case .*:|default[\t ]*:|do($| )|else|(if|for|while|switch)[\t ]*\\(.*\\)" p-line-pos)
  122.     (next-tab 1 ind-pos c-mode-tab))
  123.        ((regexp-match-line ";" p-line-pos)
  124.     (prev-line 1 p-line-pos)
  125.     (while (or (empty-line-p p-line-pos)
  126.            (regexp-match-line "^([a-zA-Z0-9_]+:|#)" p-line-pos))
  127.       (unless (prev-line 1 p-line-pos)
  128.         (return)))
  129.     (when (and (regexp-match-line
  130.             "do($| )|else|(if|for|while|switch)[\t ]*\\(.*\\)"
  131.             p-line-pos)
  132.            (not (regexp-match-line " {[\t ]*(/\\*.*\\*/|)[\t ]*$"
  133.                        p-line-pos)))
  134.       (prev-tab 1 ind-pos c-mode-tab)))
  135.        ((regexp-match-line "^[\t ]*/\\*" p-line-pos)
  136.     (unless (regexp-match-line "\\*/" p-line-pos)
  137.       (right-char 3 ind-pos)))
  138.        ((regexp-match-line "^[\t ]*\\*/ *$" p-line-pos)
  139.     (left-char 1 ind-pos))
  140.        ((regexp-match-line "\\*/" p-line-pos)
  141.     (left-char 3 ind-pos)))
  142.       ind-pos)))
  143.  
  144. ;;;###autoload
  145. (defun c-backslash-area (start end)
  146.   "Insert (or align) backslash characters at the end of each line in between
  147. START and END except for the last line."
  148.   (interactive "-m\nM")
  149.   (let
  150.       ((max-width 0)
  151.        (pos (copy-pos start))
  152.        tmp)
  153.     (while (<= pos end)
  154.       (setq tmp (char-to-glyph-pos (line-end pos)))
  155.       (when (> (pos-col tmp) max-width)
  156.     (setq max-width (pos-col tmp)))
  157.       (setq pos (next-line 1 pos)))
  158.     (setq max-width (1+ max-width))
  159.     (unless (= (% max-width tab-size) 0)
  160.       (setq max-width (* (1+ (/ max-width tab-size)) tab-size)))
  161.     (set-pos-line pos (pos-line start))
  162.     (set-pos-col pos max-width)
  163.     (while (< pos end)
  164.       (if (regexp-match-line "\\\\ *$" pos)
  165.       (progn
  166.         (setq tmp (char-to-glyph-pos (match-start)))
  167.         (cond
  168.          ((> (pos-col tmp) max-width)
  169.           (delete-area (glyph-to-char-pos pos) (match-start)))
  170.          ((< (pos-col tmp) max-width)
  171.           (goto-char (match-start))
  172.           (indent-to max-width))))
  173.     (goto-char (line-end pos))
  174.     (indent-to max-width)
  175.     (insert "\\"))
  176.       (setq pos (next-line 1 pos)))
  177.     (goto-char end)))
  178.  
  179. ;;;###autoload
  180. (defun c-insert-comment ()
  181.   (interactive)
  182.   (find-comment-pos)
  183.   (insert "/*  */")
  184.   (goto-left-char 3))
  185.  
  186.  
  187. ;; Experimental expression stuff
  188.  
  189. (defun c-forward-exp (&optional number pos)
  190.   (unless number
  191.     (setq number 1))
  192.   (while (> number 0)
  193.     ;; first, skip empty lines & comments
  194.     (while (looking-at "[\t\f ]*$|[\t\f ]*/\\*.*$" pos)
  195.       (if (looking-at "[\t\f ]*/\\*" pos)
  196.       (progn
  197.         (unless (find-next-regexp "\\*/" pos)
  198.           (error "Comment doesn't end!"))
  199.         (setq pos (match-end)))
  200.     (setq pos (next-line 1 (line-start pos)))
  201.     (when (> pos (buffer-end))
  202.       (error "End of buffer"))))
  203.     ;; Check for a cpp line
  204.     (if (regexp-match-line "^[\t ]*#" pos)
  205.     (setq pos (line-end pos))
  206.       ;; now any other whitespace
  207.       (when (looking-at "[\t\f ]+" pos)
  208.     (setq pos (match-end)))
  209.       ;; Skip weird stuff
  210.       (while (looking-at "[!*~&<>/+%?:^-]+" pos)
  211.     (setq pos (match-end))
  212.     (when (equal pos (line-end pos))
  213.       (setq pos (next-char 1 pos))))
  214.       (let
  215.       ((c (get-char pos)))
  216.     (cond
  217.      ((member c '(?\" ?\'))
  218.       ;; move over string/character
  219.       (if (setq pos (find-next-char c (next-char 1 pos)))
  220.           (while (= (get-char (prev-char 1 (copy-pos pos))) ?\\ )
  221.         (unless (setq pos (find-next-char c (next-char 1 pos)))
  222.           (error "String doesn't end!")))
  223.         (error "String doesn't end!"))
  224.       (setq pos (next-char 1 pos)))
  225.      ((member c '(?\( ?\[ ?\{))
  226.       ;; move over brackets
  227.       (unless (setq pos (match-brackets pos))
  228.         (error "Expression doesn't end!"))
  229.       (setq pos (next-char 1 pos)))
  230.      ((member c '(?, ?\; ?:))
  231.       (setq pos (next-char 1 pos)
  232.         number (1+ number)))
  233.      ((member c '(?\) ?\] ?\}))
  234.       (error "End of containing expression"))
  235.      (t
  236.       ;; a symbol?
  237.       (if (looking-at "[a-zA-Z0-9_]+" pos)
  238.           (setq pos (match-end))
  239.         (unless (setq pos (find-next-regexp "[][a-zA-Z0-9_ \t\f()<>{}'\"]"
  240.                         pos))
  241.           (error "Can't classify expression"))
  242.         (setq number (1+ number))))))
  243.       (setq number (1- number))))
  244.   pos)
  245.   
  246. (defun c-backward-exp (&optional number orig-pos no-blocks)
  247.   (unless number
  248.     (setq number 1))
  249.   (unless orig-pos 
  250.     (setq orig-pos (cursor-pos)))
  251.   (let
  252.       ((pos (copy-pos orig-pos))
  253.        tmp)
  254.     (while (> number 0)
  255.       ;; skip preceding white space
  256.       (unless (setq pos (find-prev-regexp "[^\t\f ]" (prev-char 1 pos)))
  257.     (error "No expression!"))
  258.       (setq tmp (prev-char 1 (copy-pos pos)))
  259.       (while (looking-at "\\*/" tmp)
  260.     ;; comment to skip
  261.     (unless (setq tmp (find-prev-regexp "/\\*" tmp))
  262.       (error "Comment doesn't start!"))
  263.     (unless (setq tmp (find-prev-regexp "[^\t\f ]" (prev-char 1 tmp)))
  264.       (error "Beginning of buffer"))
  265.     (setq pos tmp))
  266.       ;; Check for a cpp line
  267.       (if (regexp-match-line "^[\t ]*#" pos)
  268.       (setq pos (line-start pos))
  269.     (let
  270.         ((c (get-char pos)))
  271.       (cond
  272.        ((member c '(?\) ?\] ?\}))
  273.         (when (or (/= c ?\}) (not no-blocks))
  274.           (unless (setq pos (match-brackets pos))
  275.         (error "Brackets don't match"))))
  276.        ((member c '(?\" ?\'))
  277.         (if (setq pos (find-prev-char c (prev-char 1 pos)))
  278.         (while (= (get-char (prev-char 1 (copy-pos pos))) ?\\ )
  279.           (unless (setq pos (find-prev-char c (prev-char 1 pos)))
  280.             (error "String doesn't start!")))
  281.           (error "String doesn't start!")))
  282.        ((member c '(?\; ?: ?,))
  283.         ;; loop again
  284.         (setq number (1+ number)))
  285.        ((member c '(?\( ?\[ ?\{))
  286.         (error "Start of containing expression"))
  287.        (t
  288.         ;; a symbol?
  289.         (if (looking-at "[a-zA-Z0-9_]" pos)
  290.         (unless (setq pos (find-prev-regexp "(^#[\t ]*|)[a-zA-Z0-9_]+"
  291.                             pos))
  292.           (error "Can't classify expression"))
  293.           (unless (setq pos (find-prev-regexp "[][a-zA-Z0-9_ \t\f()<>{}'\"]"
  294.                           pos))
  295.         (error "Can't classify expression"))
  296.           (setq number (1+ number)))))
  297.       (when (member (get-char (prev-char 1 (copy-pos pos))) '(?! ?* ?- ?~))
  298.         ;; unary operator, skip over it
  299.         (setq pos (prev-char 1 pos))))
  300.     (setq number (1- number))))
  301.     pos))
  302.