Function: simula-context

simula-context is a byte-compiled function defined in simula.el.gz.

Signature

(simula-context)

Documentation

Return value according to syntactic SIMULA context of point.

    0 point inside COMMENT comment
    1 point on SIMULA-compiler directive line
    2 point inside END comment
    3 point inside string
    4 point inside character constant
  nil otherwise.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/simula.el.gz
(defun simula-context ()
  "Return value according to syntactic SIMULA context of point.
    0    point inside COMMENT comment
    1    point on SIMULA-compiler directive line
    2    point inside END comment
    3    point inside string
    4    point inside character constant
  nil    otherwise."
  ;; first, find out if this is a compiler directive line
  (if (save-excursion
	(beginning-of-line)
	(eq (following-char) ?%))
      ;; YES - return 1
      1
    (save-excursion
      ;; The current line is NOT a compiler directive line.
      ;; Now, the strategy is to search backward to find a semicolon
      ;; that is NOT inside a string. The point after semicolon MUST be
      ;; outside a comment, since semicolons are comment-ending and
      ;; comments are non-recursive. We take advantage of the fact
      ;; that strings MUST end on the same line as they started, so
      ;; that we can easily decide whether we are inside a string or not.
      (let (return-value (origin (point)))
	(skip-chars-backward "^;" (point-min))
	;; found semicolon or beginning of buffer
	(let (loopvalue (saved-point origin))
	  (while (and (not (bobp))
		      (if (progn
			    (beginning-of-line)
			    ;; compiler directive line? If so, cont searching..
			    (eq (following-char) ?%))
			  t
			(while (< (point) saved-point)
			  (skip-chars-forward "^;\"'")
			  (forward-char 1)
			  (cond
			   ((eq (preceding-char) ?\;)
			    (setq saved-point (point)))
			   ((eq (preceding-char) ?\")
			    (skip-chars-forward "^\";")
			    (if (eq (following-char) ?\;)
				(setq saved-point (point) loopvalue t)
			      (forward-char 1)))
			   (t
			    (if (eq (following-char) ?')
				(forward-char 1))
			    (skip-chars-forward "^';")
			    (if (eq (following-char) ?\;)
				(setq saved-point (point) loopvalue t)
			      (forward-char 1)))))
			loopvalue))
	    (backward-char 1)
	    (skip-chars-backward "^;")
	    (setq saved-point (point) loopvalue nil)))
	;; Now we are CERTAIN that we are outside comments and strings.
	;; The job now is to search forward again towards the origin
	;; skipping directives, comments and strings correctly,
	;; so that we know what context we are in when we find the origin.
	(while (and
		(< (point) origin)
		(re-search-forward
		 "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>" origin 'move))
	  (cond
	   ((memq (preceding-char) '(?d ?D))
	    (setq return-value 2)
	    (while (and (re-search-forward
			 ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
			 origin 'move)
			;; found another END?
			(or (memq (preceding-char) '(?d ?D))
			    ;; if directive, skip line
			    (and (eq (preceding-char) ?%)
				 (beginning-of-line 2))
			    ;; found other keyword, out of END comment
			    (setq return-value nil))))
	    (if (and (eq (char-syntax (preceding-char)) ?w)
		     (eq (char-syntax (following-char)) ?w))
		(save-excursion
		  (backward-word-strictly 1)
		  (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
		      (setq return-value nil)))))
	   ((memq (preceding-char) '(?! ?t ?T))
	    ; skip comment
	    (setq return-value 0)
	    (skip-chars-forward "^%;" origin)
	    (while (and return-value (< (point) origin))
	      (if (eq (following-char) ?\;)
		  (setq return-value nil)
		(if (bolp)
		    (beginning-of-line 2)	; skip directive inside comment
		  (forward-char 1))		; or single '%'
		(skip-chars-forward "^%;" origin))))
	   ((eq (preceding-char) ?\")
	    (if (not (search-forward "\"" origin 'move))
		(setq return-value 3)))
	   ((eq (preceding-char) ?\')
	    (if (or (eq (point) origin) (eobp))
		(setq return-value 4)
	      (forward-char 1)
	      (if (not (search-forward "'" origin 'move))
		  (setq return-value 4))))
	   ;; compiler directive line - skip
	   (t (beginning-of-line 2))))
	return-value)
      )))