comparison lisp/progmodes/delphi.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

49597:e88404e8f2cf

;; one can put in .emacs:
;;
;; (add-hook 'delphi-mode-hook 'turn-on-font-lock)

;; If font-lock is not loaded by default, you might have to do:
;; 
;; (autoload 'font-lock-mode "font-lock")
;; (autoload 'turn-on-font-lock "font-lock")
;; (setq font-lock-support-mode 'lazy-lock-mode)
;;
;; Lazy lock is very necessary for faster screen updates.

;;; Code:

(provide 'delphi)

(defconst delphi-version
  (let ((revision "$Revision: 3.7 $"))
    (string-match ": \\([^ ]+\\)" revision)
    (match-string 1 revision))
  "Version of this delphi mode.")

(eval-and-compile

  :group 'delphi)

(defconst delphi-directives
  '(absolute abstract assembler automated cdecl default dispid dynamic
    export external far forward index inline message name near nodefault
    overload override pascal private protected public published read readonly 
    register reintroduce resident resourcestring safecall stdcall stored
    virtual write writeonly)
  "Delphi4 directives.")

(defconst delphi-keywords
  (append
   '(;; Keywords.
     and array as asm at begin case class const constructor contains
     destructor dispinterface div do downto else end except exports
     file finalization finally for function goto if implementation implements
     in inherited initialization interface is label library mod nil not 
     of object on or out package packed procedure program property
     raise record repeat requires result self set shl shr then threadvar 
     to try type unit uses until var while with xor

     ;; These routines should be keywords, if Borland had the balls.
     break exit)

  "Delphi binary operations.")

(defconst delphi-visibilities '(public private protected published automated)
  "Class visibilities.")

(defconst delphi-block-statements 
  '(begin try case repeat initialization finalization asm)
  "Statements that contain multiple substatements.")

(defconst delphi-mid-block-statements
  `(except finally ,@delphi-visibilities)

             (or (not (delphi-is kind delphi-strings))
                 ;; Special case: string delimiters are start/end ambiguous.
                 ;; We have an end only if there is some string content (at
                 ;; least a starting delimiter).
                 (not (delphi-is-literal-end (1- p)))))
                 
        ;; Special case: strings cannot span lines.
        (and (delphi-is kind delphi-strings) (eq ?\n (char-after (1- p)))))))

(defun delphi-is-stable-literal (p)
  ;; True if the point p marks a stable point. That is, a point outside of a

  (let ((search-start (point)))
    (cond ((not (delphi-is-literal-end search-start))
           ;; We are completing an incomplete literal.
           (let ((kind (delphi-literal-kind (1- search-start))))
             (delphi-complete-literal kind limit)
             (delphi-set-text-properties 
              search-start (point) (delphi-literal-text-properties kind))))

          ((re-search-forward
            "\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)"
            limit 'goto-limit-on-fail)

                             ((match-beginning 4) 'string)
                             ((match-beginning 5) 'double-quoted-string)))
                 (start (match-beginning 0)))
             (delphi-set-text-properties search-start start nil)
             (delphi-complete-literal kind limit)
             (delphi-set-text-properties 
              start (point) (delphi-literal-text-properties kind))))

          ;; Nothing found. Mark it as a non-literal.
          ((delphi-set-text-properties search-start limit nil)))
    (delphi-step-progress (point) "Parsing" delphi-parsing-progress-step)))

          (token nil))
      (delphi-progress-start)
      (while (< p to)
        ;; Color the token and move past it.
        (setq token (delphi-token-at p))
        (add-text-properties 
         (delphi-token-start token) (delphi-token-end token)
         (list 'face (delphi-face-of (delphi-token-kind token)) 'lazy-lock t))
        (setq p (delphi-token-end token))
        (delphi-step-progress p "Fontifying" delphi-fontifying-progress-step))
      (delphi-progress-done)))))

    (let ((delphi-ignore-changes t)) ; Prevent recursive calls.
      (delphi-save-excursion
       (delphi-progress-start)
       ;; Reparse at least from the token previous to the change to the end of
       ;; line after the change.
       (delphi-parse-region-until-stable 
        (delphi-token-start (delphi-token-at (1- change-start)))
        (progn (goto-char change-end) (end-of-line) (point)))
       (delphi-progress-done)))))

(defun delphi-group-start (from-token)

        (last-token from-token)
        (kind nil))
    (catch 'done
      (while token
        (setq kind (delphi-token-kind token))
        (cond 
         ;; Skip over ()/[] groups.
         ((eq 'close-group kind) (setq token (delphi-group-start token)))

         ;; Stop at the beginning of the line or an open group.
         ((delphi-is kind '(newline open-group)) (throw 'done nil))

        (last-token from-token)
        (kind nil))
    (catch 'done
      (while token
        (setq kind (delphi-token-kind token))
        (cond 
         ((and (eq 'colon kind)
               (delphi-is (delphi-token-kind last-token)
                          `(,@delphi-block-statements 
                            ,@delphi-expr-statements)))
          ;; We hit a label followed by a statement. Indent to the statement.
          (throw 'done nil))

         ;; Skip over ()/[] groups.

         ;; A class/record start also begins a block.
         ((delphi-composite-type-start token last-token)
          (throw 'done (if stop-on-class last-token token)))
         )
        (unless (delphi-is token-kind delphi-whitespace) 
          (setq last-token token))
        (setq token (delphi-previous-token token)))
      ;; Start not found.
      nil)))

                ((delphi-column-of (delphi-comment-content-start comment)))))))
    ))

(defun delphi-is-use-clause-end (at-token last-token last-colon from-kind)
  ;; True if we are after the end of a uses type clause.
  (when (and last-token 
             (not last-colon)
             (eq 'comma (delphi-token-kind at-token))
             (eq 'semicolon from-kind))
    ;; Scan for the uses statement, just to be sure.
    (let ((token (delphi-previous-token at-token))

                       (delphi-line-indent-of token delphi-indent-level))
                   ;; Indent to use clause keyword.
                   (delphi-line-indent-of token))))

         ;; Assembly sections always indent in from the asm keyword.
         ((eq token-kind 'asm) 
          (throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))

         ;; An enclosing statement delimits a previous statement.
         ;; We try to use the existing indent of the previous statement,
         ;; otherwise we calculate from the enclosing statement.

          (throw 'done
           (delphi-stmt-line-indent-of token delphi-compound-block-indent)))

         ;; An enclosing ":" means a label.
         ((and (eq 'colon token-kind)
               (delphi-is (delphi-token-kind section-token) 
                          delphi-block-statements)
               (not last-terminator)
               (not expr-delimited)
               (not (eq 'equals (delphi-token-kind last-token))))
          (throw 'done

  ;; Returns the indentation offset from the enclosing statement of the token.
  (let ((token (delphi-previous-token from-token))
        (from-kind (delphi-token-kind from-token))
        (token-kind nil)
        (stmt-start nil)
        (last-token nil)        
        (equals-encountered nil)
        (before-equals nil)
        (expr-delimited nil))
    (catch 'done
      (while token

         ((eq 'case token-kind)
          (throw 'done
                 (if stmt-start
                     ;; We are not actually indenting to the case statement,
                     ;; but are within a label expression.
                     (delphi-stmt-line-indent-of 
                      stmt-start delphi-indent-level)
                   ;; Indent from the case keyword.
                   (delphi-stmt-line-indent-of 
                    token delphi-case-label-indent))))

         ;; Body expression statements are enclosing. Indent from the
         ;; statement's keyword, unless we have a non-block statement following
         ;; it.
         ((delphi-is token-kind delphi-body-expr-statements)
          (throw 'done
                 (delphi-stmt-line-indent-of 
                  (or stmt-start token) delphi-indent-level)))

         ;; An else statement is enclosing, but it doesn't have an expression.
         ;; Thus we take into account last-token instead of stmt-start.
         ((eq 'else token-kind)

           (cond (last-token (delphi-indent-of last-token delphi-indent-level))

                 ((+ (delphi-section-indent-of token) delphi-indent-level)))))

         ;; Assembly sections always indent in from the asm keyword.
         ((eq token-kind 'asm) 
          (throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))

         ;; Stop at an enclosing statement and indent from it.
         ((delphi-is token-kind delphi-enclosing-statements)
          (throw 'done (delphi-stmt-line-indent-of

           ;;   val := Foo
           ;;      (foo, args)
           ;;          + 2;
           ;; which doesn't look right.
           ;;;; Align binary ops with the before token.
           ;;((delphi-is from-kind delphi-binary-ops) 
           ;;(throw 'done (delphi-indent-of before-equals 0)))

           ;; Assignments (:=) we skip over to get a normal indent.
           ((eq (delphi-token-kind last-token) 'equals))

           ;; Otherwise indent in from the equals.
           ((throw 'done 
                   (delphi-indent-of before-equals delphi-indent-level)))))

         ;; Remember any "=" we encounter if it has not already been processed.
         ((eq token-kind 'equals) 
          (setq equals-encountered token
                before-equals last-token))
         )
        (unless (delphi-is token-kind delphi-whitespace)
           (setq last-token token))

                   ;; Use a previous section/routine's indent.
                   (delphi-section-indent-of token))

                  ((delphi-is token-kind delphi-match-block-statements)
                   ;; Use the block's indentation.
                   (let ((block-start 
                          (delphi-block-start token 'stop-on-class)))
                     (cond
                      ;; When trailing a body statement, indent to
                      ;; the statement's keyword.
                      ((delphi-is-block-after-expr-statement block-start)

49598:0d8b17d428b5

;; one can put in .emacs:
;;
;; (add-hook 'delphi-mode-hook 'turn-on-font-lock)

;; If font-lock is not loaded by default, you might have to do:
;;
;; (autoload 'font-lock-mode "font-lock")
;; (autoload 'turn-on-font-lock "font-lock")
;; (setq font-lock-support-mode 'lazy-lock-mode)
;;
;; Lazy lock is very necessary for faster screen updates.

;;; Code:

(provide 'delphi)

(defconst delphi-version
  (let ((revision "$Revision: 3.8 $"))
    (string-match ": \\([^ ]+\\)" revision)
    (match-string 1 revision))
  "Version of this delphi mode.")

(eval-and-compile

  :group 'delphi)

(defconst delphi-directives
  '(absolute abstract assembler automated cdecl default dispid dynamic
    export external far forward index inline message name near nodefault
    overload override pascal private protected public published read readonly
    register reintroduce resident resourcestring safecall stdcall stored
    virtual write writeonly)
  "Delphi4 directives.")

(defconst delphi-keywords
  (append
   '(;; Keywords.
     and array as asm at begin case class const constructor contains
     destructor dispinterface div do downto else end except exports
     file finalization finally for function goto if implementation implements
     in inherited initialization interface is label library mod nil not
     of object on or out package packed procedure program property
     raise record repeat requires result self set shl shr then threadvar
     to try type unit uses until var while with xor

     ;; These routines should be keywords, if Borland had the balls.
     break exit)

  "Delphi binary operations.")

(defconst delphi-visibilities '(public private protected published automated)
  "Class visibilities.")

(defconst delphi-block-statements
  '(begin try case repeat initialization finalization asm)
  "Statements that contain multiple substatements.")

(defconst delphi-mid-block-statements
  `(except finally ,@delphi-visibilities)

             (or (not (delphi-is kind delphi-strings))
                 ;; Special case: string delimiters are start/end ambiguous.
                 ;; We have an end only if there is some string content (at
                 ;; least a starting delimiter).
                 (not (delphi-is-literal-end (1- p)))))

        ;; Special case: strings cannot span lines.
        (and (delphi-is kind delphi-strings) (eq ?\n (char-after (1- p)))))))

(defun delphi-is-stable-literal (p)
  ;; True if the point p marks a stable point. That is, a point outside of a

  (let ((search-start (point)))
    (cond ((not (delphi-is-literal-end search-start))
           ;; We are completing an incomplete literal.
           (let ((kind (delphi-literal-kind (1- search-start))))
             (delphi-complete-literal kind limit)
             (delphi-set-text-properties
              search-start (point) (delphi-literal-text-properties kind))))

          ((re-search-forward
            "\\(//\\)\\|\\({\\)\\|\\((\\*\\)\\|\\('\\)\\|\\(\"\\)"
            limit 'goto-limit-on-fail)

                             ((match-beginning 4) 'string)
                             ((match-beginning 5) 'double-quoted-string)))
                 (start (match-beginning 0)))
             (delphi-set-text-properties search-start start nil)
             (delphi-complete-literal kind limit)
             (delphi-set-text-properties
              start (point) (delphi-literal-text-properties kind))))

          ;; Nothing found. Mark it as a non-literal.
          ((delphi-set-text-properties search-start limit nil)))
    (delphi-step-progress (point) "Parsing" delphi-parsing-progress-step)))

          (token nil))
      (delphi-progress-start)
      (while (< p to)
        ;; Color the token and move past it.
        (setq token (delphi-token-at p))
        (add-text-properties
         (delphi-token-start token) (delphi-token-end token)
         (list 'face (delphi-face-of (delphi-token-kind token)) 'lazy-lock t))
        (setq p (delphi-token-end token))
        (delphi-step-progress p "Fontifying" delphi-fontifying-progress-step))
      (delphi-progress-done)))))

    (let ((delphi-ignore-changes t)) ; Prevent recursive calls.
      (delphi-save-excursion
       (delphi-progress-start)
       ;; Reparse at least from the token previous to the change to the end of
       ;; line after the change.
       (delphi-parse-region-until-stable
        (delphi-token-start (delphi-token-at (1- change-start)))
        (progn (goto-char change-end) (end-of-line) (point)))
       (delphi-progress-done)))))

(defun delphi-group-start (from-token)

        (last-token from-token)
        (kind nil))
    (catch 'done
      (while token
        (setq kind (delphi-token-kind token))
        (cond
         ;; Skip over ()/[] groups.
         ((eq 'close-group kind) (setq token (delphi-group-start token)))

         ;; Stop at the beginning of the line or an open group.
         ((delphi-is kind '(newline open-group)) (throw 'done nil))

        (last-token from-token)
        (kind nil))
    (catch 'done
      (while token
        (setq kind (delphi-token-kind token))
        (cond
         ((and (eq 'colon kind)
               (delphi-is (delphi-token-kind last-token)
                          `(,@delphi-block-statements
                            ,@delphi-expr-statements)))
          ;; We hit a label followed by a statement. Indent to the statement.
          (throw 'done nil))

         ;; Skip over ()/[] groups.

         ;; A class/record start also begins a block.
         ((delphi-composite-type-start token last-token)
          (throw 'done (if stop-on-class last-token token)))
         )
        (unless (delphi-is token-kind delphi-whitespace)
          (setq last-token token))
        (setq token (delphi-previous-token token)))
      ;; Start not found.
      nil)))

                ((delphi-column-of (delphi-comment-content-start comment)))))))
    ))

(defun delphi-is-use-clause-end (at-token last-token last-colon from-kind)
  ;; True if we are after the end of a uses type clause.
  (when (and last-token
             (not last-colon)
             (eq 'comma (delphi-token-kind at-token))
             (eq 'semicolon from-kind))
    ;; Scan for the uses statement, just to be sure.
    (let ((token (delphi-previous-token at-token))

                       (delphi-line-indent-of token delphi-indent-level))
                   ;; Indent to use clause keyword.
                   (delphi-line-indent-of token))))

         ;; Assembly sections always indent in from the asm keyword.
         ((eq token-kind 'asm)
          (throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))

         ;; An enclosing statement delimits a previous statement.
         ;; We try to use the existing indent of the previous statement,
         ;; otherwise we calculate from the enclosing statement.

          (throw 'done
           (delphi-stmt-line-indent-of token delphi-compound-block-indent)))

         ;; An enclosing ":" means a label.
         ((and (eq 'colon token-kind)
               (delphi-is (delphi-token-kind section-token)
                          delphi-block-statements)
               (not last-terminator)
               (not expr-delimited)
               (not (eq 'equals (delphi-token-kind last-token))))
          (throw 'done

  ;; Returns the indentation offset from the enclosing statement of the token.
  (let ((token (delphi-previous-token from-token))
        (from-kind (delphi-token-kind from-token))
        (token-kind nil)
        (stmt-start nil)
        (last-token nil)
        (equals-encountered nil)
        (before-equals nil)
        (expr-delimited nil))
    (catch 'done
      (while token

         ((eq 'case token-kind)
          (throw 'done
                 (if stmt-start
                     ;; We are not actually indenting to the case statement,
                     ;; but are within a label expression.
                     (delphi-stmt-line-indent-of
                      stmt-start delphi-indent-level)
                   ;; Indent from the case keyword.
                   (delphi-stmt-line-indent-of
                    token delphi-case-label-indent))))

         ;; Body expression statements are enclosing. Indent from the
         ;; statement's keyword, unless we have a non-block statement following
         ;; it.
         ((delphi-is token-kind delphi-body-expr-statements)
          (throw 'done
                 (delphi-stmt-line-indent-of
                  (or stmt-start token) delphi-indent-level)))

         ;; An else statement is enclosing, but it doesn't have an expression.
         ;; Thus we take into account last-token instead of stmt-start.
         ((eq 'else token-kind)

           (cond (last-token (delphi-indent-of last-token delphi-indent-level))

                 ((+ (delphi-section-indent-of token) delphi-indent-level)))))

         ;; Assembly sections always indent in from the asm keyword.
         ((eq token-kind 'asm)
          (throw 'done (delphi-stmt-line-indent-of token delphi-indent-level)))

         ;; Stop at an enclosing statement and indent from it.
         ((delphi-is token-kind delphi-enclosing-statements)
          (throw 'done (delphi-stmt-line-indent-of

           ;;   val := Foo
           ;;      (foo, args)
           ;;          + 2;
           ;; which doesn't look right.
           ;;;; Align binary ops with the before token.
           ;;((delphi-is from-kind delphi-binary-ops)
           ;;(throw 'done (delphi-indent-of before-equals 0)))

           ;; Assignments (:=) we skip over to get a normal indent.
           ((eq (delphi-token-kind last-token) 'equals))

           ;; Otherwise indent in from the equals.
           ((throw 'done
                   (delphi-indent-of before-equals delphi-indent-level)))))

         ;; Remember any "=" we encounter if it has not already been processed.
         ((eq token-kind 'equals)
          (setq equals-encountered token
                before-equals last-token))
         )
        (unless (delphi-is token-kind delphi-whitespace)
           (setq last-token token))

                   ;; Use a previous section/routine's indent.
                   (delphi-section-indent-of token))

                  ((delphi-is token-kind delphi-match-block-statements)
                   ;; Use the block's indentation.
                   (let ((block-start
                          (delphi-block-start token 'stop-on-class)))
                     (cond
                      ;; When trailing a body statement, indent to
                      ;; the statement's keyword.
                      ((delphi-is-block-after-expr-statement block-start)