;;; -*- Mode:Common-Lisp; Package:ZWEI; Fonts:(MEDFNB HL12BI HL12B); Base:8; Patch-File:T -*-

;Ï1;;---------------------------------------------------------------------------------------------Ï*
;Ï1;;                      C mode for Zmacs Interpreted from GNU EmacsÏ*
;Ï1;;---------------------------------------------------------------------------------------------Ï*

;Ï1;; This file implements a C mode for Zmacs plus contains functions to indent the C code.Ï*
;Ï1;; The functionality of the mode and functions are similar to the functionality defined in GNUÏ*
;Ï1;; Emacs.  Ï*

;;; Change history:
;;;
;;;  Date      Author	Description
;;; -------------------------------------------------------------------------------------
;;;  6/19/87    KWS     Author.Ï1    Ï*
;;;  7/08/87    TWE	Updated *FILE-TYPE-MODE-ALIST* so that header and c files are put
;;;			into C mode by default for Zmacs.
;;;  7/21/87    pf      Don't set char-syntax of / to list-comment, since it causes
;;;			more problems than it solves.  Still need a way to exclude parens
;;;			in comments from matching, but this isn't it.
;;;  8/13/87    pf      Change the list-syntax of | to be alphabetic, so it won't be
;;;			a string delimiter and thus screw up paren-blinking.
;;;  8/21/87    pf	Change the file-type-mode-alist code at the bottom to do pushnew
;;;			instead of setcdr, because the cons may be in read-only space if
;;;			created in some user's init file (like mine).
;;; 12/04/87	DNG	Modifed COM-INDENT-REGION so that additional modes can be 
;;;			defined by just defining properties instead of rewriting this 
;;;			function each time.
;;;  4/29/88    pf      Extended sectionising to crudely recognise function definitions.
;;;			When it works, it's a big win, and when it loses, it isn't any worse
;;;			than before.  See comments in front of (:property :c section-p).
;;;  9/26/88    mac     added PATCH-FILE:T to the file attribute line so
;;;                     compiles won't signal redefinition errors
;;;  9/26/88    mac     changed default of C-INDENT-LEVEL to NIL.  If it
;;;                     is NIL, tab width is taken from the :TAB-WIDTH
;;;                     attribute of the Zmacs buffer.  In this manner,
;;;                     the default indentation of the C file is 
;;;                     controlled by the TAB-WIDTH file attribute of
;;;                     each individual C source file.

;Ï1;; Commands for indentation: Tab wil indent a line, and with a *numeric-arg* indent that manyÏ*
;Ï1;; lines.  M-C-\ will indent a region, as well as indent region from a mousable window.  All otherÏ*
;Ï1;; indentation as defined in the manuals also works here.Ï*

;Ï1;; C Mode can be entered by the chord Meta-X C Mode.Ï*

;Ï1;; There are several indentation controlling variables which can be selected by the user.Ï*
;Ï1;; -- C-Indent-Level (default = nil) is the indentation of C statements with respect to aÏ*
;Ï1;;    containing block.  If nil, the indentation is  taken from the :TAB-WIDTH attribute of theÏ*
;Ï1;;     of the Zmacs buffer (i.e., controlled by the TAB-WIDTH attribute on the source fileÏ*
;Ï1;;      attribute line.Ï*
;Ï1;; -- C-Brace-Imaginary-Offset (default = 0) is the imagined indentation of a C open braceÏ*
;Ï1;;    that actually follows a statement.Ï*
;Ï1;; -- C-Brace-Offset (default = 0) is extra indentation for braces, compared with otherÏ*
;Ï1;;    text in same context.Ï*
;Ï1;; -- C-Argdecl-Indent (default = 5) is the indentation level of declarations of C functionÏ*
;Ï1;;    arguments.Ï*
;Ï1;; -- C-Label-Offset (default = -2) is the offset of C label lines and case statements relativeÏ*
;Ï1;;    to usual indentation.Ï*
;Ï1;; -- C-Continued-Statement-Offset (default = 2) is the extra indentation for lines notÏ*
;Ï1;;    starting new statements.Ï*

;Ï1;; There are also variables to change the typing needs of the user.Ï*
;Ï1;; -- C-Auto-Newline (default = nil) when non-nil implies a newline will be insertedÏ*
;Ï1;;    before and after braces, and after colons and semicolons, inserted in C code.Ï*
;Ï1;; -- C-Tab-Always-Indent (default = t) when non-nil implies a tab in C mode willÏ*
;Ï1;;    always reindent the current line, regardless of where in the line the currentÏ*
;Ï1;;    buffer point is located.Ï*

(DEFMAJOR COM-C-MODE C-MODE "C"
          "Ï2Sets things up for editing C code."Ï* ()
  (SETQ *MODE-WORD-SYNTAX-TABLE* *WORD-SYNTAX-TABLE*)
  (SET-CHAR-SYNTAX WORD-ALPHABETIC *MODE-WORD-SYNTAX-TABLE* #\_)
  (SET-CHAR-SYNTAX WORD-ALPHABETIC *MODE-WORD-SYNTAX-TABLE* #\|)
  (SET-CHAR-SYNTAX WORD-ALPHABETIC *MODE-LIST-SYNTAX-TABLE* #\;)
  (SET-CHAR-SYNTAX LIST-OPEN *MODE-LIST-SYNTAX-TABLE* #\{)
  (SET-CHAR-SYNTAX LIST-CLOSE *MODE-LIST-SYNTAX-TABLE* #\})   
;;  (SET-CHAR-SYNTAX LIST-COMMENT *MODE-LIST-SYNTAX-TABLE* #\/)
  (SET-CHAR-SYNTAX LIST-ALPHABETIC *MODE-LIST-SYNTAX-TABLE* #\|)
  (SETQ *PARAGRAPH-DELIMITER-LIST* '(#\NEWLINE))
  (SETQ *SPACE-INDENT-FLAG* T)   
  (SETQ *COMMENT-START* "/\*")                   
  (SETQ *COMMENT-BEGIN* "/\* ")                  
  (SETQ *COMMENT-END* "*/")                      
  (SETQ *COMMENT-COLUMN* (* 60. 6))
  (SET-COMTAB *MODE-COMTAB* '(#\{ COM-C-BRACE    
			      #\} COM-C-BRACE    
			      #\; COM-C-SEMI
			      #\: COM-C-TERMINATOR
			      #\TAB COM-INDENT-FOR-C
			      #\RUBOUT COM-TAB-HACKING-RUBOUT
			      #\C-RUBOUT COM-RUBOUT)))

(DEFPROP C-MODE :C EDITING-TYPE)

;Ï1 Could be variables in the user profileÏ*
(DEFPARAMETER C-INDENT-LEVEL nil
  "Ï2*Indentation of C statements with respect to containing block.  If NIL, defaults to
the TAB-WIDTH attribute of the C source file."Ï*)
(DEFPARAMETER C-BRACE-IMAGINARY-OFFSET 0
  "Ï2*Imagined indentation of a C open brace that actually follows a statement."Ï*)
(DEFPARAMETER C-BRACE-OFFSET 0
  "Ï2*Extra indentation for braces, compared with other text in same context."Ï*)
(DEFPARAMETER C-ARGDECL-INDENT 5
  Ï2"*Indentation level of declarations of C function arguments."Ï*)
(DEFPARAMETER C-LABEL-OFFSET -2  
  Ï2"*Offset of C label lines and case statements relative to usual indentation."Ï*)
(DEFPARAMETER C-CONTINUED-STATEMENT-OFFSET 2
  Ï2"*Extra indent for lines not starting new statements."Ï*)

;Ï1 Could be set up as minor modes.Ï*
(DEFPARAMETER C-AUTO-NEWLINE NIL
  Ï2"*Non-nil means automatically newline before and after braces,
    and after colons and semicolons, inserted in C code."Ï*)
(DEFPARAMETER C-TAB-ALWAYS-INDENT T
  Ï2"*Non-nil means TAB in C mode should always reindent the current line,
   regardless of where in the line point is when the TAB command is used."Ï*)


(defcom Com-C-Brace
	Ï2"Insert a character { or } and correct line's indentation. If c-auto-newline
is non-nil then will insert a newline before and after brace."Ï* ()
  (LET ((insertpos nil))
    (IF (AND (end-line-p (point))
	     ;Ï1if insertion at beginning and end of lineÏ*
	     ;Ï1then stay on this lineÏ*
	     (OR (beg-line-p (backward-over '(#\space #\tab) (point)))
		 ;Ï1or if at end and c-auto-newline set thenÏ*
		 ;Ï1indent the current line, move to new line.Ï*
		 (IF c-auto-newline   
		     (PROGN           
		       (c-indent-line)
		       (insert-moving (point) #\newline)
		       t)
		     nil)))
	(PROGN
	  ;Ï1on clean line so insert the brace, and indentÏ* Ï1this line.Ï*
	  (insert-moving (point) *last-command-char*)
	  (c-indent-line)
	  (IF c-auto-newline
	      ;Ï1also if c-auto-newline is non-nil thenÏ*
	      ;Ï1move to newline and indent it.Ï*
	      (PROGN
		(SETQ insertpos (forward-char (point) -1))
		(insert-moving (point) #\newline)
		(c-indent-line)
		))
	  ;Ï1remove previous inserted brace Ï*
	  (LET ((bp (copy-bp (point))))
	    (IF insertpos (move-bp bp (forward-char insertpos)))
	    (delete-interval (forward-char bp -1) bp))))
    ;Ï1put in brace depending on if ever inserted one.Ï*
    (IF insertpos                     
	(PROGN                        
	  (preserve-point
	    (move-bp (point) insertpos)
	    (com-self-insert))
	  dis-text)
	(com-self-insert))))

  
(defcom Com-C-Semi
	Ï2"Insert character ; and correct line's indentation. If c-auto-newline is
non-nil then will insert a newline after semi-colon."Ï* ()
  ;Ï1if null c-auto-newline then insert ;Ï*
  ;Ï1else com-c-terminator will handle it.Ï*
  (IF c-auto-newline                  
      (com-c-terminator)              
      (com-self-insert)))


(defcom Com-C-Terminator
	Ï2"Insert character and correct line's indentation.  If c-auto-newline is
non-nil then will insert a newline after the character."Ï* ()
  (LET ((insertpos nil)
	(end (copy-bp (point))))
    (IF (AND (end-line-p (point))
	     ;Ï1if at end of line and a special use of colon or normal use of semiÏ*
	     ;Ï1indent else ignore.Ï*
	     (NOT (LET ((bp1 (copy-bp (point))))
		    (move-bp bp1 (forward-over '(#\space #\tab) (beg-line bp1)))
		    (OR (looking-at bp1 "#")
			;Ï1Colon not special after a # so ignoreÏ*
			;Ï1Colon is special only after a label, or case ....Ï*
			;Ï1So quickly rule out most other uses of colonÏ*
			;Ï1and do no indentation for them.Ï*
			(AND (EQL *last-command-char* #\:)
			     (NOT (looking-at bp1 "case"))
			     (OR (bp-< (forward-word bp1 2) end)
				 (bp-= (forward-word bp1 2) end)))
			;Ï1If colon or semi in comment, string, or constant string thenÏ*
			;Ï1ignore. Ï*
		        (progn (SETQ bp1 (forward-c-function bp1 -1 t))
			       (let ((pps (c-bp-syntactic-context bp1 end)))
				 (or (nth 2 pps) (nth 3 pps) (nth 4 pps))))))))
	(PROGN
	  ;Ï1either a semi or a special case of colon in C code, so insert it and indent line.Ï*
	  (insert-moving (point) *last-command-char*)  
	  (c-indent-line)                  
	  (AND c-auto-newline
	       ;Ï1if c-auto-newline is non-nil and not inside aÏ*
	       ;Ï1a line with unbalance parens then indsert aÏ*
	       ;Ï1newline and indent the new line we are now on.Ï*
	       (not (line-opens-parens (bp-line (point))))
	       (PROGN
		 (SETQ insertpos (forward-char (point) -1))
		 (insert-moving (point) #\newline)
		 (c-indent-line)
		 ))
	  ;Ï1remove previous inserted characterÏ*
	  (LET ((bp (copy-bp (point))))             
	    (IF insertpos (move-bp bp (forward-char insertpos)))
	    (delete-interval (forward-char bp -1) bp))))
    ;Ï1put in character depending on if ever inserted one.Ï*
    (IF insertpos                     
	(PROGN                      
	  (preserve-point
	    (move-bp (point) insertpos)
	    (com-self-insert))
	  dis-text)
	(com-self-insert))))

		      
(defcom Com-Indent-For-C
	Ï2"Indent current line as C code, or in some cases insert a tab character.
If c-tab-always-indent is non-nil (the default), always indent current line.
Otherwise, indent the current line only if point is at the left margin
or in the line's indentation; otherwise insert a tab. Numeric argument is number
of lines to indent."Ï* ()
  (DO* ((time *numeric-arg* (1- time))
	(flag)
	(end (OR (beg-line (point) *numeric-arg*)
		 (insert (SETQ flag (interval-last-bp *interval*)) #\CR))))	 
       ((OR (ZEROP time) (bp-= (point) end))
        ;Ï1At end of do so go back a line and move point out of indentation. And ifÏ*
	;Ï1at end of buffer delete #\cr's put in.Ï*
	(move-bp (point) (forward-line (point) -1))
	(indent-bp-adjustment (move-bp (point) (beg-line (point))))
	(AND flag
	     (delete-interval (forward-char flag -1) flag t))
	dis-text)
     ;Ï1insert tab or indent line according to c-tab-always-indentÏ*
    (IF (AND (NOT c-tab-always-indent)
	     (NOT (beg-line-p (backward-over '(#\space #\tab) (point)))))
	(com-insert-tab)
	(c-indent-line))
    (move-bp (point) (forward-line (point)))))


(DEFUN Indent-Interval-For-C (bp1 &optional bp2 in-order-p)
  "Ï2Indent all the lines in the specified interval for C.  Specify
either an interval or two BPs.  A line is in the interval iff its beginning
is included.Ï*"
  (get-interval bp1 bp2 in-order-p)
  (interval-lines (bp1 bp2) (start-line stop-line)
    (DO ((line start-line (line-next line))
	 (parse-start)
	 (state))
	((EQ line stop-line) (move-bp (point) (beg-line (point))))
      (move-bp (point) (create-bp line 0))
      ;Ï1Save state and parse start between lines so we don't reparse.Ï*
      ;Ï1and we can tell the context we are in.Ï*
      (MULTIPLE-VALUE-SETQ (parse-start state)
	(C-Indent-Line parse-start state t)))))


(DEFUN C-Indent-Line (&optional parse-start state region)
  Ï2"Indent current line as C code and return the amount the indentation changed by if
no region, else return a new parse-start and the state after parsing the current line."Ï*
  (LET* ((indent-info (Calculate-C-Indent parse-start state))
	(indent (FIRST indent-info))
	(beg nil)
	(shift-amount nil)
	(pix (font-space-width))
	(c-indent-level (or c-indent-level
                            (send (window-interval *window*)
				  :send-if-handles :get-attribute
				  :tab-width)
			    2)))
    ;Ï1Get state from C-C-I and fix region so can have a limit on else searchÏ*
    ;Ï1plus set up return info if indenting a region.Ï*
    (SETQ state (SECOND indent-info))
    (IF region
	(SETQ state (C-Bp-Syntactic-Context (beg-line (point)) (end-line (point)) state)))
    ;Ï1now move point to check indentation.Ï*
    (move-bp (point) (beg-line (point)))
    (SETQ beg (point))
    (COND ((EQ indent nil)
	   ;Ï1inside a string so set indentation to indentation of current lineÏ*
	   (SETQ indent (line-indentation (bp-line (point)))))
	  ((EQ indent t)
	   ;Ï1inside a comment so set indentation to about opening of commentÏ*
	   (SETQ indent (Calculate-C-Indent-Within-Comment (point))))
	  ((looking-at (forward-over '(#\tab #\space) (point)) "#")
	   ;Ï1this is a preprocessor line so do not indent it.Ï*
	   (SETQ indent 0))
	  (t
	   ;Ï1we have an indentation so see if we need to alter it.Ï*
	   (move-bp (point) (forward-over '(#\tab #\space) (point)))
	   (COND ((OR (looking-at (point) "case ")
		      (AND (ALPHA-CHAR-P (bp-char (point)))
			   (EQL (bp-char (forward-word (point))) #\:)))
		  ;Ï1at case or label so add c-label-offset to indentationÏ*
		  (SETQ indent (MAX (* 1 pix)
				    (+ indent (* pix c-label-offset)))))
		 ((AND (looking-at (point) "else")
		       (NOT (looking-at (point) "else_"))
		       (NOT (looking-at (point) "else-")))
		   ;Ï1at else so find matching if and set indent to its indentationÏ*
		  (SETQ indent (bp-indentation (C-Backward-To-Start-Of-If (point)
							 (CAR (LAST (FIRST state)))))))
		 ((EQL (bp-char (point)) #\})
		  ;Ï1at close brace so subtract c-indent-level to get back toÏ*
		  ;Ï1previous level indent.Ï*
		  (SETQ indent (- indent (* pix c-indent-level))))
		 ((EQL (bp-char (point)) #\{)
		  ;Ï1at open brace so add c-brace-offset if want more indentationÏ*
		  (SETQ indent (+ indent (* pix c-brace-offset)))))))
    (SETQ shift-amount (- indent (line-indentation (bp-line (point)))))
    ;Ï1if the indentation of the line changed reindent it, else just move to its end.Ï*
    (IF (ZEROP shift-amount)
	(move-bp (point) (end-line (point)))
	(PROGN
	  (delete-interval beg (point))
	  ;Ï1be careful not to try to move past left buffer sideÏ*
	  (IF (MINUSP indent)
	      (SETQ indent 0))
	  (indent-line (point) indent)
	  (move-bp (point) (end-line (point)))))
    ;Ï1then return parse-start and state if indenting region, else just returnÏ*
    ;Ï1the shift amount.Ï*
    (IF region
	(RETURN-FROM C-Indent-Line (forward-line (point)) state)
	shift-amount)))

(DEFUN Calculate-C-Indent (&optional parse-start past-state)
  Ï2"Return a list of the appropriate indentation for current line as C code
and the state of C code.  In usual case returns and integer as first part of list:
the pixel to indent to. Returns nil if line starts inside a string, t if in a
comment. The second of the list is the state, either the one passed in, or
a new state if had to calculate one."Ï*
  (LET ((bp (copy-bp (point)))
	(ending (interval-last-bp *interval*))
	(beg-buf (interval-first-bp *interval*))
	(state past-state)
	(indent-point nil)
	(containing-sexp nil)
	(fcf nil)
	(region nil)
	(pix (font-space-width))
	(c-indent-level (or c-indent-level
                            (send (window-interval *window*)
				  :get-attribute :tab-width)
			    2)))
    ;Ï1start at beginning of the line where the indent point is.Ï*
    (SETQ bp (beg-of-line (bp-line bp)))
    (SETQ indent-point bp)
    ;Ï1if beginning start point known then go there and fix up appropriateÏ*
    ;Ï1variables.Ï*
    (IF parse-start
	(PROGN
	  (SETQ bp parse-start)
	  (SETQ parse-start (Forward-C-Function bp -1 t))
	  (SETQ containing-sexp (CAAR state))
	  (SETQ ending (SECOND state))
	  (SETQ region t))
	;Ï1else figure out parse start and go there.Ï*
	(IF (SETQ fcf (Forward-C-Function bp -1 t))
	    (SETQ bp fcf)))
    ;Ï1if no parse-start and thus no region, figure out state.Ï*
    (IF (NULL region)
	(LOOP
	  (IF (NOT (bp-< bp indent-point))
	      (RETURN))
	  (SETQ parse-start bp)
	  (SETQ state (C-Bp-Syntactic-Context bp indent-point))
	  (SETQ containing-sexp (CAAR state))
	  (SETQ ending (SECOND state))
	  (SETQ bp (SIXTH state))))
    (COND
      ((OR (nth 2 state) (nth 4 state))
       ;Ï1 Return nil or t if should not change this lineÏ*
       (LIST (NTH 4 state) state))
      ((NULL containing-sexp)
       ;Ï1 Line is at top level.  May be data of function definition,Ï*
       ;Ï1 or may be function argument declaration.Ï*
       ;Ï1 Indent like the previous top level lineÏ*
       ;Ï1 unless that ends in a closeparen without semicolon,Ï*
       ;Ï1 in which case this line is the first argument decl.Ï*
       (SETQ bp (forward-over '(#\tab #\space) indent-point))
       (IF (looking-at bp "{")
	   (LIST 0 state)     ;Ï1 Unless it starts a function bodyÏ*
 	   (PROGN (C-Backward-To-Noncomment bp (OR parse-start beg-buf))
		   ;Ï1 Look at previous line that's at column 0Ï*
		   ;Ï1 to determine wheter we are in top-level declarationsÏ*
		   ;Ï1 of function's argument declarations.  Set basic indentÏ*
		   ;Ï1 accordingly.Ï*
		  (LET ((basic-indent 0)
		        (bp1 bp)
			(search-end))
		    (LOOP
		      (IF search-end (RETURN))
		      (SETQ bp1 (beg-line bp1))
		      ;Ï1move to first line with a non-special character in col. 0.Ï*
		      (IF (NOT (bp-= beg-buf bp1))
			  (IF (bp-looking-at-list bp1 '(#\space #\ff #\tab #\newline #\#))			  
			      (SETQ bp1 (forward-line bp1 -1))
			      (SETQ search-end bp1))
			  (SETQ search-end bp1)))
		    ;Ï1Figure out if we are at top level or function definition.Ï*
		    ;Ï1but not at mode line.Ï*
		    (IF (AND (NOT (bp-= bp1 beg-buf))
			     (SETQ bp1 (zwei:search bp1 #\( nil nil nil (end-line bp1)))
			     (PROGN
			       (move-bp bp1 (forward-sexp (forward-char bp1 -1)))
			       (AND (bp-< bp1 indent-point)
				    (NOT (MEMBER (bp-char bp1) '(#\, #\;) :test #'EQL)))))
			(SETQ basic-indent c-argdecl-indent)
		        (SETQ basic-indent 0))
		    ;Ï1 Now add a little if this is a continuation line.Ï*
		    (list (* pix (+ basic-indent
				    (IF (OR (MEMBER (bp-char-before bp) '(#\) #\; #Ï1\Ï*}) :test #'EQL)
					    (bp-= bp beg-buf))
					0
					c-continued-statement-offset)))
			  state)))))
      ((NOT (looking-at containing-sexp "{"))
       ;Ï1 line is expression, not statement:Ï*
       ;Ï1 indent to just after the surrounding open.Ï*
       (SETQ bp (forward-char containing-sexp))
       (LIST (bp-indentation bp) state))
      (t
        ;Ï1 Statement level.  Is it a continuation or a new statement?Ï*
	;Ï1 Find previous non-comment character.Ï*
	 (SETQ bp indent-point)
	 (C-Backward-To-Noncomment bp containing-sexp)
	;Ï1 Back up over label lines, since they don'tÏ*
	;Ï1 affect wheter our line is a continuation.Ï*
	 (LOOP
	   (IF (NOT (OR (looking-at-backward bp ",")
			(AND (looking-at-backward bp ":")
			     (OR (looking-at (forward-char bp -2) "'")
				 (EQ (char-syntax (bp-char (forward-char bp -2))
						  *mode-word-syntax-table*)
				     word-alphabetic)))))
	       (RETURN))
	   (IF (looking-at-backward bp ",")
	       (C-Backward-To-Start-Of-Continued-Exp bp containing-sexp))
	   (SETQ bp (beg-line bp))
	   (C-Backward-To-Noncomment bp containing-sexp))
	 ;Ï1 Now we get the answer.Ï*
	 (IF (NOT (MEMBER (bp-char-before bp) '(nil #\, #\; #\} #\{) :test #'EQL))
	     ;Ï1 This line is continuation of preceding line's statement;Ï*
	     ;Ï1 indent c-continued-statement-offset more than theÏ*
	     ;Ï1 previous line of the statement.Ï*
	     (PROGN
	       (C-Backward-To-Start-Of-Continued-Exp bp containing-sexp)
	       (LIST (+ (* pix c-continued-statement-offset) (bp-indentation bp))
		     state))
	     ;Ï1 This line starts a new statement. Position following last closed paren.Ï*
	     (PROGN
	       (SETQ bp containing-sexp)
	       ;Ï1 Is line first statement after an open-brace?Ï*
	       (OR
		 ;Ï1 If no, find that first statement and indent like it.Ï*
		 (LET ((bp2 bp)
		       (colon-line-end beg-buf)
		       (colon-state)
		       (search-end))
		   (SETQ bp2 (forward-char bp2))
		   (LOOP
		     ;Ï1 If found comment, label, of preprocessor lines following open brace.Ï*
		     (IF (NOT (PROGN
				(SETQ bp2 (forward-over '(#\space #\tab #\newline) bp2))
				(OR (bp-looking-at-list bp2 '(#\# "/\*" "case"))
				    (AND (SETQ search-end (zwei:search bp2 ":" nil nil nil (end-line bp2)))
					 (SETQ colon-state (C-Bp-Syntactic-Context (beg-line bp2)
								                    search-end))
					 (NULL (THIRD colon-state)) (NULL (FOURTH colon-state))
					 (NULL (FIFTH colon-state)) (NULL (SEVENTH colon-state)))))) 
			 (RETURN))
		     ;Ï1 Skip over comments, labels, preprocessor lines following open brace.Ï*
		     (IF (looking-at bp2 "#")
			 (SETQ bp2 (forward-line bp2))
			 (IF (looking-at bp2 *comment-start*)
			     (SETQ bp2 (C-Skip-Comment bp2))
			     (PROGN
			       (SETQ colon-line-end (end-of-line (bp-line bp2)))
			       (SETQ bp2 (zwei:search bp2 ":" nil t))))))
		   ;Ï1 The first following code countsÏ*
		   ;Ï1 if it is before the line we want to indent.Ï*
		   (AND (bp-< bp2 indent-point)
                        (NOT (looking-at (forward-over '(#\tab #\space)
						        (beg-line bp2)) "{"))
			(IF (bp-< bp2 colon-line-end)
			    (LIST (- (line-indentation (bp-line bp2))(* pix c-label-offset))
			          state)
			    (LIST (bp-indentation bp2)
			          state))))
		 ;Ï1 If no previous statement, indent it relative to line brace is on.Ï*
		 ;Ï1 For open brace in column zero, don't let statement start there too.Ï*
		 ;Ï1 If c-indent-offset is zero, use c-brace-offset + c-continued-statement-offsetÏ*
		 ;Ï1 instead.   For open-braces not the first thing in a line, add inÏ*
		 ;Ï1 c-brace-imaginary-offset.Ï*
		 (LIST (+ (IF (AND (beg-line-p bp) (ZEROP c-indent-level))
			      (* pix (+ c-brace-offset c-continued-statement-offset))
			      (* pix c-indent-level))
			      ;Ï1 Move back over whitespace before the openbrace.Ï*
			      ;Ï1 If openbrace is not first nonwhite thing on the line,Ï*
			      ;Ï1 add the c-brace-imaginary-offsetÏ*
			  (IF (beg-line-p (backward-over '(#\space #\tab) bp))
			      0
			      (* pix c-brace-imaginary-offset))
			      ;Ï1 If the openbrace is preceded by a parenthesized exp,Ï*
			      ;Ï1 move to the beginning of that; possibly a different line.Ï*
			  (PROGN
			    (IF (looking-at-backward (backward-over '(#\{ #\tab #\space) bp) ")")
				(SETQ bp (forward-sexp bp -1)))
			    (line-indentation (bp-line bp))))
		       state))))))))


(DEFUN Calculate-C-Indent-Within-Comment (bp)
  Ï2"Return the indentation amount for line, assuming that
the current line is to be regarded as part of a block comment."Ï*
  (LET ((end nil)
	(search-ok nil)
	(bp1 bp))
    ;Ï1Backup to start of comment and then return indentation.Ï*
    (SETQ bp1 (backward-over '(#\space #\tab #\newline) (beg-line bp1)))
    (SETQ end bp1)
    (SETQ bp1 (forward-over '(#\space #\tab) (beg-line bp1)))
    (AND (NOT (NULL (SETQ search-ok (zwei:search bp1 *comment-start* nil nil nil end))))
	 (SETQ bp1 (forward-char search-ok -1)))
    (bp-indentation bp1)))


(DEFUN C-Backward-To-Noncomment (bp lim)
  "Ï2Move bp to start of a line that is not a comment, or a preprocessor
line, but do not move past limit.Ï*"Ï2 Ï*
  (DO ((opoint nil opoint)
       (stop nil stop))
      (stop)
    ;Ï1first skip over whitespace to a newlineÏ*
    (move-bp bp (backward-over '(#\space #\tab #\newline #\ff) bp lim))
    (SETQ opoint (copy-bp bp))
    ;Ï1return if we hit start of bufferÏ*
    (IF (bp-= bp (interval-first-bp *interval*))
	(RETURN-FROM c-backward-to-noncomment))
Ï2     Ï*;Ï1if two characters forward is not >= lim  and if we see a close commentÏ*
    (IF (AND (OR (bp-< (forward-char lim 2) bp) (bp-= (forward-char lim 2) bp))
	     (LET ((bp1 (copy-bp bp)))
	       (move-bp bp1 (forward-char bp1 -2))
	       (looking-at bp1 *comment-end*)))
	;Ï1then move to start of commentÏ*
	(move-bp bp (zwei:search bp *comment-start* t nil nil lim))
	;Ï1else move over whitespace at beginning of line.Ï*
	(PROGN (move-bp bp (beg-line bp))
	       (move-bp bp (forward-over '(#\space #\tab) bp))
	       ;Ï1if we are at a preprocessor line then set stop if we have passedÏ*
	       ;Ï1limit, else not at preprocessor line so stop and move bp.Ï*
	       (IF (looking-at bp "#")
		   (SETQ stop (OR (bp-< bp lim) (bp-= bp lim)))
		   (AND (SETQ stop t)
			(move-bp bp opoint)))))))


(DEFUN C-Backward-to-Start-Of-Continued-Exp (bp lim)
  Ï2"Move to the start of the continued expression."Ï*
  ;Ï1if we are at end of continued expression go to start.Ï*
  (IF (looking-at-backward bp ")")
      (move-bp bp (forward-sexp bp -1)))
  ;Ï1move to start of line and then over white spaceÏ*
  ;Ï1and make sure we are over limit.Ï*
  (move-bp bp (beg-line bp))
  (IF (OR (bp-< bp lim) (bp-= bp lim))
      (move-bp bp (forward-char lim)))
  (move-bp bp (forward-over '(#\space #\tab) bp)))


(DEFUN C-Backward-To-Start-Of-If (bp limit)
  Ï2"Return a bp to the start of the last ``unbalanced'' if."Ï*
  (LET ((bp1 bp))
    (DO ((if-level 1))
	((ZEROP if-level) bp1)
       ;Ï1move back to previous sexp looking for if or else.Ï*
      (SETQ bp1  (forward-sexp bp1 -1 t))
      (COND ((looking-at bp1 "else")
             ;Ï1we found an else so increase balanced if countÏ*
	     (SETQ if-level (1+ if-level)))
	    ((looking-at bp1 "if")
	     ;Ï1we found an if so decrease balanced if countÏ*
	     (SETQ if-level (1- if-level)))
	    ((bp-< bp1 limit)
	     ;Ï1neither found so if we are past limit quitÏ*
	     (SETQ if-level 0)
	     (SETQ bp1 limit))))))


(DEFUN C-Skip-Comment (bp)
  "Ï2BP should be right before the start of a comment.
Returns a (new) bp to just after the end of the comment.
We don't handle nested comments."Ï*
  (LET ((bp1 bp))
    (SETQ bp1 (forward-char bp1 2))
    (LET ((x (search bp1 *comment-end*)))
      (COND ((NULL x) (barf "Unbalanced comment."))
	    (T (SETQ bp1 x))))))


(DEFUN C-Bp-Syntactic-Context (start-bp end-bp &optional state)
  "Ï2Describe the syntactic context of a spot identified by BP.
The first value is the character address of the innermost containing list.
The second is the character address of the last }.
The third is non-NIL if that spot is in a string.
The fourth is non-NIL if that spot is in a constant string.
The fifth is non-NIL if that spot is in a comment.
The sixth is the bp where stop parsing.
The seventh is non-NIL if all characters in parse are alphabetic.
START-BP is where to parse from to compute these.  Default
is the start of the C function.
END-BP is where to end parse. Default is end of C function.
and state is a past state to initialize variables to.Ï*"
  (let ((bp start-bp))
    (do ((containing-sexp-list (OR (FIRST state) nil))
	 (ending (OR (SECOND state) (interval-first-bp *interval*)))
	 (in-string (OR (THIRD state) nil))
	 (in-constant (OR (FOURTH state) nil))
	 (in-comment (OR (FIFTH state) nil))
	 (alpha (OR (SEVENTH state) t))
	 (char (bp-char bp) (bp-char bp)))   
	((bp-= bp end-bp) (RETURN (LIST containing-sexp-list ending in-string
					in-constant in-comment bp alpha)))
      ;Ï1only check for special characters if the current character is not a alphanum.Ï*
      (SETQ char (bp-char bp))
      (IF (AND (NOT (ALPHANUMERICP char))
	       (NOT (EQL char #\space)))
	  (PROGN
	    (SETQ alpha nil)
	    (COND
	      ((AND (OR (EQL char #\{) (EQL char #\())
		    (NOT (OR in-string in-comment in-constant)))
	       ;Ï1character is start of sexp and in C code so update sexp list.Ï*
	       (SETQ containing-sexp-list (CONS (copy-bp bp) containing-sexp-list)))
	      ((AND (EQL char #\})
		    (NOT (OR in-string in-comment in-constant)))
	       ;Ï1character is end of C block so set ending and adjust sexp list. Ï*
	       (SETQ ending (copy-bp bp)) (SETQ containing-sexp-list (CDR containing-sexp-list)))
	      ((AND (EQL char #\))
		    (NOT (OR in-string in-comment in-constant)))
	       ;Ï1character is end of sexp so adjust sexp list.Ï*
	       (SETQ containing-sexp-list (CDR containing-sexp-list)))
	      ((EQL char #\")
	       ;Ï1character in is a string deleimiter so set in-string if not setÏ*
	       (IF (NULL in-string) (SETQ in-string t) (SETQ in-string nil)))
	      ((EQL char #\')
	       ;Ï1character is a character constant delimiter so set in-constantÏ*
	       ;Ï1if not already in-constant, in-comment, or in-string.Ï*
	       (IF (AND (NULL in-comment) (NULL in-string) (NULL in-constant))
		   (SETQ in-constant t) (SETQ in-constant nil)))
	      ((looking-at bp *comment-start*)
	       ;Ï1string is open comment so set in-comment if not already in one.Ï*
	       (IF (NULL in-comment) (SETQ in-comment t)))
	      ((looking-at bp *comment-end*)
	       ;Ï1string is close comment so set in-comment to nil or barf.Ï*
	       (IF (EQUAL in-comment t) (SETQ in-comment nil) (barf "Unbalanced Comment"))))))
      (SETQ bp (forward-char bp)))))


(DEFUN C-Function-Open-Brace-P (bp)
  "Ï2Return t if open brace at beginning of line, else nilÏ*"
  (AND (beg-line-p bp) (char= (bp-ch-char bp) #\{)))

(DEFUN C-Function-Close-Brace-P (bp)
  "Ï2Return t if close brace at beginning of line, else nilÏ*"
  (AND (beg-line-p bp) (char= (bp-ch-char bp) #\})))


(DEFUN Forward-C-Function (bp &optional (times 1) fixup-p &aux (direction (signum times)))
  "Ï2Return a bp which is TIMES functions forward from the bp given.
Look forward if TIMES is positive, backwards if it's negative (do nothing if it's zero).
If FIXUP-P is non-NIL, then should we run off either end of the buffer, return a bp to there,
otherwise return NIL."Ï*
  ;Ï1 don't move at all if numeric-arg=0Ï*
  (AND (ZEROP direction)
       (RETURN-FROM Forward-C-Function (copy-bp bp)))
  ;Ï1 move to col 1 and start scanning in the required direction for the braceÏ*
  (SETQ bp (IF (AND (beg-line-p bp)
		    (NOT (bp-= (interval-first-bp *interval*) bp)))
	       (beg-line bp direction)		;Ï1already in col 1, move awayÏ*
	       (beg-line bp 0)))		;Ï1else move to col 1Ï*
  (SETQ times (ABS times))
  (LOOP
    (COND ((AND (OR (bp-= bp (interval-first-bp *interval*)) Ï1 Ï*
		    (bp-= bp (interval-last-bp *interval*)))
		;Ï1return if hit bob or eob and return according to fixup-pÏ*
		(RETURN-FROM Forward-C-Function
		  (IF fixup-p
		      (copy-bp bp)
		      nil))))
	  ((C-Function-Open-Brace-P bp)
	   ;Ï1we found an open brace in col 1Ï*
	   (setq times (1- times))
	   ;Ï1iterated enough times, exitÏ*
	   (AND (zerop times)			
		(return-from forward-c-function bp))
	   ;Ï1else get off this line so we won't look at it againÏ*
	   (SETQ bp (beg-line bp direction)))	
	  ((C-Function-Close-Brace-P bp)
	   ;Ï1we found a close brace in col 1Ï*
	   (SETQ times (1- times))
	   ;Ï1iterated enough times, and in new c function, exitÏ*
	   (AND (zerop times)			
		(return-from forward-c-function (forward-char bp)))
	   ;Ï1else get off this line so we won't look at it againÏ*
	   (SETQ bp (beg-line bp direction)))	
	  (T
	   ;Ï1no brace, keep scanningÏ*
	   (SETQ bp (beg-line bp direction))))))

(DEFPROP COM-INDENT-FOR-LISP INDENT-INTERVAL-FOR-LISP INDENT-INTERVAL)
(DEFPROP COM-INDENT-FOR-C    INDENT-INTERVAL-FOR-C    INDENT-INTERVAL)

Ï1; META-CTRL-\Ï*
(DEFCOM COM-INDENT-REGION Ï2"Indent each line in the region.
With no argument, it calls the current TAB command to indent.
With an argument, makes the indentation of each line be as wide as that
many SPACEs in the current font."Ï* ()
;Ï1 This is changed in order to speed up indentation of C code.Ï*
  (LET* ((COMMAND (COMMAND-LOOKUP #\TAB *COMTAB*))
	 (INDENT-INTERVAL (GET COMMAND 'INDENT-INTERVAL)))
    (REGION (BP1 BP2)
      (IF (AND INDENT-INTERVAL (NOT *NUMERIC-ARG-P*))
	  (FUNCALL INDENT-INTERVAL BP1 BP2 T)	Ï1;Efficiency for LISP or CÏ*
	(REGION-LINES (START-LINE IGNORE)
	  (LET ((WIDTH (* *NUMERIC-ARG*
			  (FONT-SPACE-WIDTH)))
		(STOP-LINE (BP-LINE BP2))
		(POINT (POINT))
		(OLD-POINT (COPY-BP (POINT))))
	    (MOVE-BP POINT START-LINE 0)
	    (DO ()
		(NIL)
	      (AND (ZEROP (BP-INDEX BP2))
		   (EQ STOP-LINE (BP-LINE POINT))
		   (RETURN NIL))
	      (IF *NUMERIC-ARG-P*
		  (INDENT-LINE POINT WIDTH)
		(FUNCALL COMMAND))
	      (AND (NOT (ZEROP (BP-INDEX BP2)))
		   (EQ STOP-LINE (BP-LINE POINT))
		   (RETURN NIL))
	      (MOVE-BP POINT (BEG-LINE POINT 1 T)))
	    (MOVE-BP POINT OLD-POINT))))))
  DIS-TEXT)


(DEFCOM COM-MOUSE-MARK-THING "Ï2Mark the thing you are pointing at."Ï* (SM)
;Ï1 This is changed to allow for the C mode, but we use lisp marking, so youÏ*
;Ï1 can only mark words, lines, and sexps.  This marking does mark from aÏ*
;Ï1 C keyword to the end of its block.Ï*
  (DO ((POINT (POINT))
       (MARK (MARK))
       (LAST-X *MOUSE-X*)
       (LAST-Y *MOUSE-Y*)
       (X)
       (Y)
       (CHAR)
       (LINE)
       (CHAR-POS)
       (OL)
       (OCP))
      (NIL)
    (MULTIPLE-VALUE-SETQ (CHAR X Y LINE CHAR-POS)
      (MOUSE-CHAR *WINDOW* NIL LAST-X LAST-Y))	;Figure out where mouse is
    (COND ((AND CHAR (OR (NEQ LINE OL)
			 (NOT (= CHAR-POS OCP))))
	   (SETQ OL LINE
		 OCP CHAR-POS)
	   (MOVE-BP POINT LINE CHAR-POS)
	   (FUNCALL (CASE (GET *MAJOR-MODE* 'EDITING-TYPE)
			  (:LISP 'LISP-MARK-THING)
			  (:TEXT 'TEXT-MARK-THING)
			  (:C 'LISP-MARK-THING)
			  (OTHERWISE 'DEFAULT-MARK-THING))
		    POINT MARK CHAR LINE CHAR-POS)
	   (MUST-REDISPLAY *WINDOW* DIS-BPS)
	   (REDISPLAY *WINDOW* :POINT)))
    (OR (WAIT-FOR-MOUSE LAST-X LAST-Y)
	(RETURN NIL))
    (MULTIPLE-VALUE-SETQ (LAST-X LAST-Y)
      (MOUSE-POSITION)))
  DIS-NONE) 


;Ï1Sets up things so can do a Find File in Zmacs
;;
;;  Crudely sectionises C based on the assumption that a function definition consists
;;  of an atom starting in column 0, followed by optional whitespace, followed by an
;;  open-paren.  Doesn't handle typedefs (which gnuemacs does), or variables, functions
;;  whose type is on the same line, or anything else that C might do (but gnuemacs doesn't
;;  handle these either).  Also unavoidably uppercases function names, because meta-.
;;  will uppercase when clicking on a mouse-sensitive name, and uses EQ to match.Ï*
(DEFUN (:PROPERTY :C SECTION-P) (line)
   (and (plusp (length line))
	(= (list-syntax (aref line 0)) list-alphabetic)
	(char= (bp-char (forward-over *whitespace-chars* (forward-atom (create-bp line 0))))
	       #\()))

(defun (:property :c get-section-name) (line temp-bp)
   (declare (string line))
   (cond ((and (plusp (line-length line))
	       (= (list-syntax (aref line 0)) list-alphabetic))
	  ;;  Will only pick up functions.
	  (let* ((bp1 (forward-atom (move-bp temp-bp line 0)))
		 (bp2 (forward-over *whitespace-chars* bp1)))
	    (if (char= (bp-char bp2) #\()
		(let ((string (string-interval temp-bp bp1)))
		  (values (intern (string-upcase string)) string nil))
		(values nil nil t))))
	 (:else
	  (values nil nil t))))

;Ï1Sets up C Mode for using Meta-XÏ*
(PUSHNEW '("C Mode" . COM-C-MODE) 
	 (COMTAB-EXTENDED-COMMANDS *STANDARD-COMTAB*))


;;; Make it so that the .C and .H file types cause Zmacs to enter
;;; C mode by default.
(LOOP FOR C-FILE-TYPE IN '(:C :HEADER)
      DO ; (SETF (CDR (ASSOC C-FILE-TYPE FS:*FILE-TYPE-MODE-ALIST*)) :C))
         (pushnew (cons c-file-type :c) fs:*file-type-mode-alist* :test #'equal))
