tads2-mode-1.2/tads2-mode.el0100644000175000017500000013737007525565764015107 0ustar danieldaniel;;; tads-mode.el --- TADS mode for GNU Emacs v19 or later ;; Author: Stephen Granade ;; Created: 3 Apr 1999 ;; Version: 1.2 ;; Keywords: languages ;; LCD Archive Entry: ;; tads2-mode|Stephen Granade|sgranade@phy.duke.edu| ;; Major mode for editing TADS programs| ;; 5-Nov-1999|1.2|~/modes/tads2-mode.el.Z| ;;; Copyright: ;; Copyright (c) by Stephen Granade 1999 ;; Portions of this code were adapted from GNU Emacs C-mode, and are ;; copyright (c) 1985, 1986, 1987, 1992 by Free Software Foundation, Inc. ;; Other portions of this code were adapted from an earlier TADS mode ;; by Darin Johnson, and are copyright (c) 1994 by Darin Johnson. ;; ;; tads-mode is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; tads-mode is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;;; Commentary: ;; TADS is an adventure programming language which can be found via ;; anonymous FTP at ;; /ftp.gmd.de:/if-archive/programming/tads/ ;; ;; This major mode is based heavily on the standard EMACS C-mode. ;; Type `C-h m' within TADS mode for details. ;; ;; Special thanks to Matthew Amster-Burton and Dan Shiovitz, who tested ;; early versions of this mode, and to Dan Schmidt, who got filled ;; strings and imenu support working. ;; ;; Put this file somewhere on your load-path, and the following code in ;; your .emacs file: ;; ;; (autoload 'tads2-mode "tads2-mode" "TADS 2 editing mode." t) ;; (setq auto-mode-alist ;; (append (list (cons "\\.t$" 'tads2-mode)) ;; auto-mode-alist)) ;;; Code: ;;; General variables: -------------------------------------------------------- (defconst tads-mode-version "1.2") (defvar tads-startup-message t "*Non-nil means display a message when TADS 2 mode is loaded.") (defvar tads-no-c++-comments nil "*If t, C++-style comments \(//\) are not fontified or treated as comments.") (defvar tads-strip-trailing-whitespace t "*If t (the default), delete any trailing whitespace when ENTER is pressed.") (defvar tads-mode-abbrev-table nil) (defvar tads-mode-map nil "Keymap used in TADS 2 mode.") (if tads-mode-map nil (let ((map (make-sparse-keymap "TADS"))) (setq tads-mode-map (make-sparse-keymap)) (define-key tads-mode-map "\M-n" 'tads-next-object) (define-key tads-mode-map "\M-p" 'tads-prev-object) (define-key tads-mode-map "{" 'electric-tads-brace) (define-key tads-mode-map "}" 'electric-tads-brace) (define-key tads-mode-map ";" 'electric-tads-semi) (define-key tads-mode-map "#" 'electric-tads-sharp-sign) (define-key tads-mode-map "*" 'electric-tads-splat) (define-key tads-mode-map "\r" 'electric-tads-enter) (define-key tads-mode-map "\M-t" 'tads-inside-block-comment) (define-key tads-mode-map "\177" 'backward-delete-char-untabify) (define-key tads-mode-map "\t" 'tads-indent-command) (define-key tads-mode-map [menu-bar] (make-sparse-keymap)) (define-key tads-mode-map [menu-bar tads] (cons "TADS" map)) (define-key map [next-object] '("Next object" . tads-next-object)) (define-key map [prev-object] '("Previous object" . tads-prev-object)) (define-key map [separator1] '("--" . nil)) (define-key map [comment-region] '("Comment Out Region" . comment-region)) (put 'comment-region 'menu-enable 'mark-active) (define-key map [indent-region] '("Indent Region" . indent-region)) (put 'indent-region 'menu-enable 'mark-active) (define-key map [indent-line] '("Indent Line" . indent-for-tab-command)))) ;;; Indentation parameters: --------------------------------------------------- (defvar tads-indent-level 4 "*Indentation of lines of block relative to first line of block.") (defvar tads-label-offset -2 "*Indentation of label relative to where it should be.") (defvar tads-indent-continued-string t "*If t (the default), strings continued from the previous line are indented.") (defvar tads-continued-string-offset 1 "*How much to indent continued strings by compared to the first line of the string. This is only used if `tads-indent-continued-string' is true.") (defvar tads-continued-string-offset-from-line 2 "*How much to indent continued strings by compared to the first line of the command containing the string, if that command is not purely the string itself. This is only used if `tads-indent-continued-string' is false.") (defvar tads-brace-imaginary-offset 0 "*Imagined indentation of a TADS open brace that actually follows a statement.") (defvar tads-brace-offset 0 "*Extra indentation of braces compared to other text in the same context.") (defvar tads-continued-statement-offset 4 "*Extra indentation for lines which do not begin new statements.") (defvar tads-continued-brace-offset -4 "*Extra indentation for substatements which begin with an open brace. This is in addition to `tads-continued-statement-offset'.") (defvar tads-indent-cont-statement 4 "*Indentation of continuation relative to start of statement.") (defvar tads-auto-indent-after-newline t "*If t (the default), automatically indent the next line after RETURN is pressed.") (defvar tads-tab-always-indent t "*If t (the default), always indent the current line when tab is pressed.") (defvar tads-auto-newline nil "*If t, automatically add newlines before and after braces, and after semicolons in TADS code. If you don't want a leading newline before braces then use: (define-key tads-mode-map \"{\" 'electric-tads-semi)") ;;; Syntax variables: --------------------------------------------------------- (defvar tads-mode-syntax-table nil "Syntax table used in TADS mode.") (if tads-mode-syntax-table nil (setq tads-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" tads-mode-syntax-table) (modify-syntax-entry ?/ ". 14" tads-mode-syntax-table) (modify-syntax-entry ?* ". 23" tads-mode-syntax-table) (modify-syntax-entry ?+ "." tads-mode-syntax-table) (modify-syntax-entry ?- "." tads-mode-syntax-table) (modify-syntax-entry ?= "." tads-mode-syntax-table) (modify-syntax-entry ?% "." tads-mode-syntax-table) (modify-syntax-entry ?< "." tads-mode-syntax-table) (modify-syntax-entry ?> "." tads-mode-syntax-table) (modify-syntax-entry ?& "." tads-mode-syntax-table) (modify-syntax-entry ?| "." tads-mode-syntax-table) (modify-syntax-entry ?\' "\"" tads-mode-syntax-table) ;; any reason NOT to have _ as a word constituent? Makes things simpler. (modify-syntax-entry ?_ "w" tads-mode-syntax-table) ;; C++ style comments (if tads-no-c++-comments () (modify-syntax-entry ?/ ". 124" tads-mode-syntax-table) (modify-syntax-entry ?* ". 23b" tads-mode-syntax-table) (modify-syntax-entry ?\n ">" tads-mode-syntax-table))) ;(defvar tads-functions-list ; '("addword" "askdo" "askfile" "askio" "caps" "car" "cdr" ; "clearscreen" "cvtnum" "cvtstr" "datatype" "defined" "delword" ; "endTurn" "execCommand" "fclose" "find" "firstobj" "firstsc" "fopen" ; "fseek" "fseekof" "fwrite" "getarg" "getfuse" "gettime" "getwords" ; "incturn" "input" "inputdialog" "inputevent" "inputkey" "inputline" ; "isclass" "length" "logging" "lower" "nextobj" "nocaps" "notify" ; "objwords" "outcapture" "parseAskobjIndirect" "parseNounList" ; "parserDictLookup" "parserGetMe" "parserGetObj" "parserGetTokTypes" ; "parserReplaceCommand" "parserResolveObjects" "parserSetMe" ; "parserTokenize" "postAction" "preCommand" "proptype" "quit" "rand" ; "randomize" "reGetGroup" "remdaemon" "remfuse" "reSearch" ; "resourceExists" "restart" "restore" "rundaemons" "runfuses" "save" ; "say" "setdaemon" "setfuse" "setit" "setOutputFilter" "setscore" ; "setversion" "skipturn" "substr" "systemInfo" "timeDelay" "undo" ; "unnotify" "upper" "verbInfo" "yorn") ; "List of TADS built-in functions.") ;; A function to aid my own failing memory of how to print objects ;(defun tads-make-regexp () ; (interactive) ; (insert (make-regexp tads-functions-list))) ;(defvar tads-keywords-list ; '("abort" "argcount" "break" "continue" "delete" "do" "else" "exit" ; "exitobj" "for" "goto" "if" "inherited" "local" "modify" "new" "nil" ; "pass" "replace" "return" "self" "switch" "true" "while") ; "List of TADS keywords.") ;; The following regexps were made from the above commented lists using ;; Simon Marshall's make-regexp package (thanks, Gareth!). (eval-and-compile (defvar tads-functions-regexp "\\<\\(a\\(ddword\\|sk\\(do\\|file\\|io\\)\\)\\|c\\(a\\(ps\\|r\\)\\|dr\\|learscreen\\|vt\\(num\\|str\\)\\)\\|d\\(atatype\\|e\\(fined\\|lword\\)\\)\\|e\\(ndTurn\\|xecCommand\\)\\|f\\(close\\|i\\(nd\\|rst\\(obj\\|sc\\)\\)\\|open\\|seek\\(\\|of\\)\\|write\\)\\|get\\(arg\\|fuse\\|time\\|words\\)\\|i\\(n\\(cturn\\|put\\(\\|dialog\\|event\\|key\\|line\\)\\)\\|sclass\\)\\|l\\(ength\\|o\\(gging\\|wer\\)\\)\\|n\\(extobj\\|o\\(caps\\|tify\\)\\)\\|o\\(bjwords\\|utcapture\\)\\|p\\(arse\\(AskobjIndirect\\|NounList\\|r\\(DictLookup\\|Get\\(Me\\|Obj\\|TokTypes\\)\\|Re\\(placeCommand\\|solveObjects\\)\\|SetMe\\|Tokenize\\)\\)\\|ostAction\\|r\\(eCommand\\|optype\\)\\)\\|quit\\|r\\(and\\(\\|omize\\)\\|e\\(GetGroup\\|Search\\|m\\(daemon\\|fuse\\)\\|s\\(ourceExists\\|t\\(art\\|ore\\)\\)\\)\\|un\\(daemons\\|fuses\\)\\)\\|s\\(a\\(ve\\|y\\)\\|et\\(OutputFilter\\|daemon\\|fuse\\|it\\|score\\|version\\)\\|kipturn\\|ubstr\\|ystemInfo\\)\\|timeDelay\\|u\\(n\\(do\\|notify\\)\\|pper\\)\\|verbInfo\\|yorn\\)\\>" "Regular expression matching a TADS function") (defvar tads-keywords-regexp "\\<\\(a\\(bort\\|rgcount\\)\\|break\\|continue\\|d\\(elete\\|o\\)\\|e\\(lse\\|xit\\(\\|obj\\)\\)\\|for\\|goto\\|i\\(f\\|nherited\\)\\|local\\|modify\\|n\\(ew\\|il\\)\\|pass\\|re\\(place\\|turn\\)\\|s\\(elf\\|witch\\)\\|true\\|while\\)\\>" "Regular expression matching a TADS reserved word")) ;; A note: tads-label-regexp and tads-modified-regexp will NOT match ;; function definitions with returns between the label name and colon, like ;; bedroom_door ;; : doorway ;; I don't know of anyone who uses this syntax, but someone might. If you ;; do, remove the '\n' from tads-label-regexp and tads-modified-regexp. ;; Regexp for finding a label or class name followed by a colon ;; Note that this should *not* match "default:", nor should it match ;; ":=" (for those of you still using the Pascal-style assignment operator) (defvar tads-label-regexp "^[ \t]*\\(class \\)?\\([^:;\"!*(\n ]+ *\\):\\($\\|[^=]\\)") ;; Regexp for finding a modified object (defvar tads-modified-regexp "^[ \t]*\\(modify\\|replace\\)\\s-+\\([^:;\"!*(\n ]+\\)") ;; Regexp for some TADS special words (defvar tads-specials-regexp "^[ \t]*\\(compoundWord\\b\\|formatstring\\b\\|specialWords\\b\\)") ;; A combination of the above three regexps (defvar tads-defun-regexp (concat "\\(" tads-label-regexp "\\|" tads-modified-regexp "\\|" tads-specials-regexp "\\)")) ;; Regexp used internally to recognize labels in switch statements. (defconst tads-switch-label-regexp "\\(case[ \t'/\(][^:]+\\|default[ \t]*\\):") ;;; Font-lock keywords: ------------------------------------------------------- (defvar tads-font-lock-defaults '(tads-font-lock-keywords nil t ((?_ . "w")) tads-prev-object) "Font Lock defaults for TADS mode.") (defvar tads-font-lock-keywords (eval-when-compile (list ;; preprocessor directives as comments. '("^#[ \t]*[a-z]+" . font-lock-comment-face) '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ;; objects and non-TADS functions '("^\\(\\w+[ \t]+\\)*\\(\\w+\\) *: *\\w+" 2 font-lock-function-name-face) '("^[ \t]*modify \\(\\w+\\)" 1 font-lock-function-name-face) ;; TADS keywords. (cons (concat "\\(" tads-keywords-regexp "\\)") 'font-lock-keyword-face) ;; TADS functions. (cons (concat "\\(" tads-functions-regexp "\\)") 'font-lock-builtin-face) )) "Expressions to fontify in TADS mode.") ;;; TADS mode: ---------------------------------------------------------------- (defun tads-mode () "Major mode for editing TADS programs. * TADS syntax: Type \\[indent-for-tab-command] to indent the current line. Type \\[indent-region] to indent the region. * Navigating in a file: Type \\[tads-prev-object] to go to the previous object/class declaration. Type \\[tads-next-object] to go to the next one. * Font-lock support: Put \(add-hook 'tads-mode-hook 'turn-on-font-lock) in your .emacs file. *Key definitions: \\{tads-mode-map} * Miscellaneous user options: tads-startup-message Set to nil to inhibit the message printed the first time TADS mode is used. tads-auto-newline If true, automatically insert a newline before and after braces, and after colons and semicolons. tads-no-c++-comments Set to true to not treat C++-style comments \(//\) as comments. tads-strip-trailing-whitespace If true (the default), all whitespace at the end of a line will be removed when RETURN is pressed. tads-mode-hook The hook that is run after entering TADS mode. * User options controlling indentation style: Values in parentheses are the default indentation style. tads-indent-level \(4\) Indentation of code inside an object relative to the first line of the block. tads-brace-offset \(0\) Extra indentation for a brace as compared to text in the same context. tads-brace-imaginary-offset \(0\) Imagined indentation for an open brace that follows a statement. tads-indent-cont-statement \(4\) Indentation of continuation relative to start of statement. tads-continued-statement-offset \(4\) Extra indentation for lines which do not begin new statements tads-continued-brace-offset \(-4\) Extra indentation for substatements which start with an open brace. This is in addition to `tads-continued-statement-offset'. tads-label-offset \(-2\) Extra indentation for line that is a label, or case or default. tads-indent-continued-string \(t\) If true, strings which span more than one line are all indented the same amount. tads-continued-string-offset \(1\) How much to indent continued strings by compared to the first line of the string. This is only used if `tads-indent-continued-string' is true. tads-continued-string-offset-from-line \(2\) How much to indent continued strings by compared to the first line of the command containing the string, if that command is not purely the string itself. This is only used if `tads-indent-continued-string' is false. tads-auto-indent-after-newline \(t\) If true, then pressing RETURN also indents the new line that is created. tads-tab-always-indents \(t\) If true, TAB always indents the current line when pressed. tads-auto-newline \(nil\) If true, automatically add newlines before and after braces, and after semicolons in TADS code. If you don't want a leading newline before braces then use: (define-key tads-mode-map \"{\" 'electric-tads-semi)" (interactive) (if tads-startup-message (message "Emacs TADS mode version %s by Stephen Granade." tads-mode-version)) (kill-all-local-variables) (use-local-map tads-mode-map) (setq major-mode 'tads-mode) (setq mode-name "TADS") (setq local-abbrev-table tads-mode-abbrev-table) (set-syntax-table tads-mode-syntax-table) (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'indent-line-function) 'tads-indent-line) (set (make-local-variable 'indent-region-function) 'tads-indent-region) (set (make-local-variable 'fill-paragraph-function) 'tads-fill-paragraph) (set (make-local-variable 'imenu-extract-index-name-function) 'tads-imenu-extract-name) (set (make-local-variable 'imenu-prev-index-position-function) 'tads-prev-object) (set (make-local-variable 'require-final-newline) t) ;; The block mode comments are default (set (make-local-variable 'comment-start) "/* ") (set (make-local-variable 'comment-end) " */") (set (make-local-variable 'comment-column) 40) (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *") (set (make-local-variable 'comment-indent-function) 'tads-comment-indent) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'font-lock-defaults) tads-font-lock-defaults) (run-hooks 'tads-mode-hook)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in C code ;; based on its context. (defun tads-comment-indent () (if (looking-at "^\\(/\\*\\|//\\)") 0 ;Existing comment at bol stays there. (let ((opoint (point))) (save-excursion (beginning-of-line) (cond ((looking-at "[ \t]*}[ \t]*\\($\\|/\\*\\|//\\)") ;; A comment following a solitary close-brace ;; should have only one space. (search-forward "}") (1+ (current-column))) ((or (looking-at "^#[ \t]*endif[ \t]*") (looking-at "^#[ \t]*else[ \t]*")) 7) ;2 spaces after #endif ((progn (goto-char opoint) (skip-chars-backward " \t") (and (= comment-column 0) (bolp))) ;; If comment-column is 0, and nothing but space ;; before the comment, align it at 0 rather than 1. 0) (t (max (1+ (current-column)) ;Else indent at comment column comment-column))))))) ; except leave at least one space. (defun tads-indent-command (&optional whole-exp) "Indent current line as TADS code, or in some cases insert a tab character." (interactive "P") (if whole-exp ;; If arg, always indent this line as TADS ;; and shift remaining lines of expression the same amount. (let ((shift-amt (tads-indent-line)) beg end) (save-excursion (if tads-tab-always-indent (beginning-of-line)) ;; Find beginning of following line. (save-excursion (forward-line 1) (setq beg (point))) ;; Find first beginning-of-sexp for sexp extending past this line. (while (< (point) beg) (forward-sexp 1) (setq end (point)) (skip-chars-forward " \t\n"))) (if (> end beg) (indent-code-rigidly beg end shift-amt "#"))) ;; else just indent the one line (if (and (not tads-tab-always-indent) (save-excursion (skip-chars-backward " \t") (not (bolp)))) (insert-tab) (tads-indent-line)))) (defun tads-indent-region (start end) (save-restriction (let ((endline (progn (goto-char (max end start)) (or (bolp) (end-of-line)) (point))) linestart) (narrow-to-region (point-min) endline) (goto-char (min start end)) (forward-line 0) (while (not (eobp)) (tads-indent-line) (forward-line 1))))) (defun tads-non-indented-string-indentation () "Return indentation for the current string." (save-excursion (let ((start (1+ (re-search-backward "[^\\]\"")))) (goto-char start) (+ (current-indentation) (if (progn (skip-chars-backward " \t") (bolp)) 0 tads-continued-string-offset-from-line))))) (defun tads-indent-line () "Indent current line as TADS code. Return the amount the indentation changed by." (let ((indent (calculate-tads-indent nil)) beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) (beginning-of-line) (setq beg (point)) (cond ((eq indent nil) ;; string (setq indent (calculate-tads-indent-within-string) )) ((eq indent t) ;; comment (setq indent (calculate-tads-indent-within-comment))) ((looking-at "[ \t]*#") ;; directive (setq indent 0)) (t (if (listp indent) (setq indent (car indent)) ;; Check special cases (don't do this if indent was a list, ;; since that means we were at the top level, and these ;; cases are only for C-style code) (skip-chars-forward " \t") (cond ((or (looking-at tads-switch-label-regexp) (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":")))) (setq indent (max 1 (+ indent tads-label-offset)))) ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq indent (save-excursion (tads-backward-to-start-of-if) (current-indentation)))) ((and (looking-at "}[ \t]*else\\b") (not (looking-at "}[ \t]*else\\s_"))) (setq indent (save-excursion (forward-char) (backward-sexp) (tads-backward-to-start-of-if) (current-indentation)))) ((and (looking-at "while\\b") (not (looking-at "while\\s_")) (save-excursion (tads-backward-to-start-of-do))) ;; This is a `while' that ends a do-while. (setq indent (save-excursion (tads-backward-to-start-of-do) (current-indentation)))) ((= (following-char) ?}) (setq indent (- indent tads-indent-level))) ((= (following-char) ?{) (setq indent (+ indent tads-brace-offset))))))) (skip-chars-forward " \t") (setq shift-amt (- indent (current-column))) (if (zerop shift-amt) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos))) (delete-region beg (point)) (indent-to indent) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) shift-amt)) ;; quite different from the C-mode version (defun calculate-tads-indent (&optional parse-start) "Return appropriate indentation for current line as TADS code. In usual case returns an integer: the column to indent to. Returns nil if line starts inside a string, t if in a comment. If indent is returned inside a list, this means we are at the top level rather than being C-style code in a function body." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) state containing-sexp next-char) (if parse-start (goto-char parse-start) (tads-beginning-of-defun) (setq parse-start (point))) (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) (setq containing-sexp (car (cdr state)))) ;; Now we've got some info, figure out what's up ;; State is: (paren-depth inner-list-start last-sexp instring incomment ;; after-quote min-paren-depth) (cond ((or (nth 3 state) (nth 4 state)) (nth 4 state)) ; Comment or string ((null containing-sexp) ;; We're at the top level. (goto-char indent-point) (skip-chars-forward " \t") ;; returning a list, to flag us as top-level (setq next-char (following-char)) (list (cond ((or (= next-char ?\;) ; end of object def (tads-looking-at-defun)) 0) ((progn (tads-backward-to-noncomment parse-start) (= (preceding-char) ?=)) ; continued property def (+ (current-indentation) (if (= next-char ?{) 0 ; starting a method tads-continued-statement-offset))) ; continued propy ;; check for start of function def (already checked ;; if we're a continued property def) ((= next-char ?{) 0) ; start of function body ((and (= (current-indentation) 0) (memq (preceding-char) '(?\; ?}))) ;; just after obj def or func def 0) ((save-excursion (beginning-of-line) (tads-looking-at-defun)) ; first line after def'n tads-indent-level) (t ;; Normal, non continued line (we hope) ;; so use indentation of prev line (watching out ;; for things that could span multiple lines) (if (memq (preceding-char) '(?\} ?\" ?\')) (progn (backward-sexp 1) (skip-chars-backward " \t\n"))) (current-indentation))))) ;; Not at top level - so we go back to doing C stuff ((/= (char-after containing-sexp) ?{) ;; line is expression, not statement (i.e., we're ;; inside parens or square brackets, not curlies), ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) (current-column)) (t ;; We're part of a statement. Continuation or new statement? ;; Find previous non-comment character. (goto-char indent-point) (tads-backward-to-noncomment containing-sexp) (if (not (memq (preceding-char) '(nil ?\, ?\; ?} ?: ?\{))) ;; This line is continuation of preceding line's statement; ;; indent tads-continued-statement-offset more than the ;; previous line of the statement. (progn (tads-backward-to-start-of-continued-exp containing-sexp) (+ tads-continued-statement-offset (current-column) (if (save-excursion (goto-char indent-point) (skip-chars-forward " \t") (eq (following-char) ?{)) tads-continued-brace-offset 0))) ;; This line starts a new statement. ;; Position following last unclosed open. (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or ;; If no, find that first statement and indent like it. (save-excursion (forward-char 1) (while (progn (skip-chars-forward " \t\n") (looking-at (concat "#\\|/\\*\\|//" "\\|case[ \t].*:" "\\|[a-zA-Z0-9_$]*:"))) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) ((looking-at "/\\*") (forward-char 2) (search-forward "*/" nil 'move)) ((looking-at "//") (forward-line 1)) (t (search-forward ":")))) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (current-column))) ;; If no previous statement, ;; indent it relative to line brace is on. ;; For open brace in column zero, don't let statement ;; start there too. If tads-indent-offset is zero, ;; use tads-brace-offset + tads-continued-statement-offset ;; instead. ;; For open-braces not the first thing in a line, ;; add in tads-brace-imaginary-offset. (+ (if (and (bolp) (zerop tads-indent-level)) (+ tads-brace-offset tads-continued-statement-offset) tads-indent-level) ;; Move back over whitespace before the openbrace. ;; If openbrace is not first nonwhite thing on the line, ;; add the tads-brace-imaginary-offset. (progn (skip-chars-backward " \t") (if (bolp) 0 tads-brace-imaginary-offset)) ;; If the openbrace is preceded by a parenthesized exp, ;; move to the beginning of that; ;; possibly a different line (progn (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. (current-indentation)))))))))) (defun calculate-tads-indent-within-comment (&optional after-star) "Return the indentation amount for line inside a block comment. Optional arg AFTER-STAR means, if lines in the comment have a leading star, return the indentation of the text that would follow this star." (let (end star-start two-star) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (setq star-start (= (following-char) ?\*) two-star (looking-at "\\*\\*")) (skip-chars-backward " \t\n") (setq end (point)) (beginning-of-line) (skip-chars-forward " \t") (if after-star (and (looking-at "\\*") (re-search-forward "\\*[ \t]*"))) (and (re-search-forward "/\\*[ \t]*" end t) star-start (not after-star) (goto-char (1+ (match-beginning 0))) (if two-star (backward-char)) (sit-for 1)) (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*)) (1+ (current-column)) (current-column))))) (defun calculate-tads-indent-within-string () "Return the indentation amount for line inside a string." (if (not tads-indent-continued-string) (tads-non-indented-string-indentation) (save-excursion (let ((beg-point (point)) parse-start) (tads-beginning-of-defun) (setq parse-start (point)) (goto-char beg-point) ;; now keep searching backwards until start of string ;; (ugly) (while (nth 3 (parse-partial-sexp parse-start (point) nil)) (re-search-backward "\\s\"" nil t)) (+ (current-column) tads-continued-string-offset))))) (defun tads-backward-to-start-of-continued-exp (lim) (if (memq (preceding-char) '(?\) ?\")) (forward-sexp -1)) (beginning-of-line) (if (<= (point) lim) (goto-char (1+ lim))) (skip-chars-forward " \t")) (defun tads-backward-to-start-of-if (&optional limit) "Move to the start of the last \"unbalanced\" `if'." (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) (let ((if-level 1) (case-fold-search nil)) (while (and (not (bobp)) (not (zerop if-level))) (backward-sexp 1) (cond ((and (looking-at "else\\b") (not (looking-at "else\\s_"))) (setq if-level (1+ if-level))) ((and (looking-at "if\\b") (not (looking-at "if\\s_"))) (setq if-level (1- if-level))) ((< (point) limit) (setq if-level 0) (goto-char limit)))))) (defun tads-backward-to-start-of-do (&optional limit) "If point follows a `do' statement, move to beginning of it and return t. Otherwise return nil and don't move point." (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) (let ((first t) (startpos (point)) (done nil)) (while (not done) (let ((next-start (point))) (condition-case nil ;; Move back one token or one brace or paren group. (backward-sexp 1) ;; If we find an open-brace, we lose. (error (setq done 'fail))) (if done nil ;; If we reached a `do', we win. (if (looking-at "do\\b") (setq done 'succeed) ;; Otherwise, if we skipped a semicolon, we lose. ;; (Exception: we can skip one semicolon before getting ;; to a the last token of the statement, unless that token ;; is a close brace.) (if (save-excursion (forward-sexp 1) (or (and (not first) (= (preceding-char) ?})) (search-forward ";" next-start t (if (and first (/= (preceding-char) ?})) 2 1)))) (setq done 'fail) (setq first nil) ;; If we go too far back in the buffer, we lose. (if (< (point) limit) (setq done 'fail))))))) (if (eq done 'succeed) t (goto-char startpos) nil))) (defun tads-beginning-of-defun () (interactive) "Move either to what we think is start of TADS function or object, or, if not found, to the start of the buffer." (beginning-of-line) (while (not (or (tads-looking-at-defun) (= (point) (point-min)))) (and (re-search-backward (concat "^" tads-defun-regexp) nil 'move) (goto-char (match-beginning 0))))) (defun tads-backward-to-noncomment (lim) (let (opoint stop) (while (not stop) (skip-chars-backward " \t\n\r\f" lim) (setq opoint (point)) (cond ((and (>= (point) (+ 2 lim)) (save-excursion (forward-char -2) (looking-at "\\*/"))) (search-backward "/*" lim 'move)) ((search-backward "//" (max lim (save-excursion (beginning-of-line) (point))) 'move)) (t (beginning-of-line) (skip-chars-forward " \t") (if (looking-at "#") (setq stop (<= (point) lim)) (setq stop t) (goto-char opoint))))))) ;; tells if we're at top level (or inside braces) (defun tads-top-level () (save-excursion (beginning-of-line) (let ((opoint (point)) state) (tads-beginning-of-defun) (while (< (point) opoint) (setq state (parse-partial-sexp (point) opoint 0))) (null (car (cdr state)))))) ;; fill a comment or a string (defun tads-fill-paragraph (&optional arg) "Like \\[fill-paragraph] but handle C comments. If any of the current line is a comment or within a comment, fill the comment or the paragraph of it that point is in, preserving the comment indentation or line-starting decorations." (interactive "P") (let* (comment-start-place (first-line ;; Check for obvious entry to comment. (save-excursion (beginning-of-line) (skip-chars-forward " \t\n") (and (looking-at comment-start-skip) (setq comment-start-place (point)))))) (if (save-excursion (beginning-of-line) (looking-at ".*//")) ;; handle c++-style comments (let (fill-prefix (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))) (save-excursion (beginning-of-line) ;; Move up to first line of this comment. (while (and (not (bobp)) (looking-at "[ \t]*//")) (forward-line -1)) (if (not (looking-at ".*//")) (forward-line 1)) ;; Find the comment start in this line. (re-search-forward "[ \t]*//[ \t]*") ;; Set the fill-prefix to be what all lines except the first ;; should start with. (let ((endcol (current-column))) (skip-chars-backward " \t") (setq fill-prefix (concat (make-string (- (current-column) 2) ?\ ) "//" (make-string (- endcol (current-column)) ?\ )))) (save-restriction ;; Narrow down to just the lines of this comment. (narrow-to-region (point) (save-excursion (forward-line 1) (while (looking-at "[ \t]*//") (forward-line 1)) (point))) (insert fill-prefix) (fill-paragraph arg) (delete-region (point-min) (+ (point-min) (length fill-prefix)))))) (if (or first-line ;; t if we enter a comment between start of function and ;; this line. (eq (calculate-tads-indent) t) ;; t if this line contains a comment starter. (setq first-line (save-excursion (beginning-of-line) (prog1 (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) (setq comment-start-place (point)))))) ;; Inside a comment: fill one comment paragraph. (let ((fill-prefix ;; The prefix for each line of this paragraph ;; is the appropriate part of the start of this line, ;; up to the column at which text should be indented. (save-excursion (beginning-of-line) (if (looking-at "[ \t]*/\\*.*\\*/") (progn (re-search-forward comment-start-skip) (make-string (current-column) ?\ )) (if first-line (forward-line 1)) (let ((line-width (progn (end-of-line) (current-column)))) (beginning-of-line) (prog1 (buffer-substring (point) ;; How shall we decide where the end of the ;; fill-prefix is? ;; calculate-tads-indent-within-comment ;; bases its value on the indentation of ;; previous lines; if they're indented ;; specially, it could return a column ;; that's well into the current line's ;; text. So we'll take at most that many ;; space, tab, or * characters, and use ;; that as our fill prefix. (let ((max-prefix-end (progn (move-to-column (calculate-tads-indent-within-comment t) t) (point)))) (beginning-of-line) (skip-chars-forward " \t*" max-prefix-end) ;; Don't include part of comment terminator ;; in the fill-prefix. (and (eq (following-char) ?/) (eq (preceding-char) ?*) (backward-char 1)) (point))) ;; If the comment is only one line followed ;; by a blank line, calling move-to-column ;; above may have added some spaces and tabs ;; to the end of the line; the fill-paragraph ;; function will then delete it and the ;; newline following it, so we'll lose a ;; blank line when we shouldn't. So delete ;; anything move-to-column added to the end ;; of the line. We record the line width ;; instead of the position of the old line ;; end because move-to-column might break a ;; tab into spaces, and the new characters ;; introduced there shouldn't be deleted. ;; If you can see a better way to do this, ;; please make the change. This seems very ;; messy to me. (delete-region (progn (move-to-column line-width) (point)) (progn (end-of-line) (point)))))))) (paragraph-start ;; Lines containing just a comment start or just an end ;; should not be filled into paragraphs they are next to. (concat paragraph-start "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (paragraph-separate (concat paragraph-separate "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")) (chars-to-delete 0)) (save-restriction ;; Don't fill the comment together with the code ;; following it. So temporarily exclude everything ;; before the comment start, and everything after the ;; line where the comment ends. If comment-start-place ;; is non-nil, the comment starter is there. Otherwise, ;; point is inside the comment. (narrow-to-region (save-excursion (if comment-start-place (goto-char comment-start-place) (search-backward "/*")) ;; Protect text before the comment start ;; by excluding it. Add spaces to bring back ;; proper indentation of that point. (let ((column (current-column))) (prog1 (point) (setq chars-to-delete column) (insert-char ?\ column)))) (save-excursion (if comment-start-place (goto-char (+ comment-start-place 2))) (search-forward "*/" nil 'move) (forward-line 1) (point))) (save-excursion (goto-char (point-max)) (forward-line -1) ;; And comment terminator was on a separate line before, ;; keep it that way. ;; This also avoids another problem: ;; if the fill-prefix ends in a *, it could eat up ;; the * of the comment terminator. (if (looking-at "[ \t]*\\*/") (narrow-to-region (point-min) (point)))) (fill-paragraph arg) (save-excursion ;; Delete the chars we inserted to avoid clobbering ;; the stuff before the comment start. (goto-char (point-min)) (if (> chars-to-delete 0) (delete-region (point) (+ (point) chars-to-delete))) ;; Find the comment ender (should be on last line of buffer, ;; given the narrowing) and don't leave it on its own line. ;; Do this with a fill command, so as to preserve sentence ;; boundaries. (goto-char (point-max)) (forward-line -1) (search-forward "*/" nil 'move) (beginning-of-line) (if (looking-at "[ \t]*\\*/") (let ((fill-column (+ fill-column 9999))) (forward-line -1) (fill-region-as-paragraph (point) (point-max))))))) ;; Outside of comments: do ordinary filling. (tads-fill-string-paragraph arg))) t)) ;; To do : don't kill off double spacing ;; don't get rid of returns before/after '\n' or '\b' ;; calculate-tads-indent can get fooled by backslashes ;; ;; Largely hacked from Gareth Rees' inform-fill-paragraph by ;; Dan Schmidt ;; (defun tads-fill-string-paragraph (&optional arg) "Fill a string according to our standards for string indentation." (interactive "P") (let* ((case-fold-search t) indent-type) (insert ?\n) (setq indent-type (calculate-tads-indent)) (delete-backward-char 1) (if (eq indent-type nil) ;; string (let* ((indent-col (prog2 (insert ?\n) (calculate-tads-indent-within-string) (delete-backward-char 1))) (start (1+ (re-search-backward "[^\\]\""))) (end (progn (forward-char 1) (re-search-forward "[^\\]\""))) (fill-column (- fill-column 2)) linebeg) (save-restriction (narrow-to-region (point-min) end) ;; Fold all the lines together, removing multiple spaces ;; as we go. (subst-char-in-region start end ?\n ? ) (subst-char-in-region start end ?\t ? ) (goto-char start) (while (re-search-forward " +" end t) (delete-region (match-beginning 0) (1- (match-end 0)))) ;; Split this line; reindent after first split, ;; otherwise indent to point where first split ended ;; up. (goto-char start) (setq linebeg start) (while (not (eobp)) (move-to-column (1+ fill-column)) (if (eobp) nil (skip-chars-backward "^ " linebeg) (if (eq (point) linebeg) (progn (skip-chars-forward "^ ") (skip-chars-forward " ")) (while (= (preceding-char) ?\ ) ; Get rid of any (delete-backward-char 1))) ; trailing spaces (insert ?\n) (indent-to-column indent-col 1) (setq linebeg (point))))) ;; Return T so that `fill-paragaph' doesn't try anything. t)))) ;;; Miscellaneous: ------------------------------------------------------------ (defun tads-next-object (&optional arg) "Go to the next object or class declaration in the file. With a prefix arg, go forward that many declarations. With a negative prefix arg, search backwards." (interactive "P") (let* ((fun 're-search-forward) (errstring "more") (n (prefix-numeric-value arg)) (forward-or-backward (if (< n 0) -1 1)) (additional-n (if (and (tads-looking-at-defun) (not (< n 0))) 1 0)) success ; did re-search-forward actually work? flag) (if (< n 0) (setq fun 're-search-backward errstring "previous" n (- n))) ; loop until we're looking at a label which is *not* part of a switch (while (and ;; do the actual move, and put the cursor at column 0 (setq success (prog1 (funcall fun tads-defun-regexp nil 'move (+ n additional-n)) (forward-line 0))) (looking-at (concat "^[ \t]*" tads-switch-label-regexp))) ;; This was really a switch label, keep going (forward-line forward-or-backward) (setq additional-n 0)) ;; Return whether we succeeded success)) ;; This function doubles as an `imenu-prev-name' function, so when ;; called noninteractively it must return non-NIL if it was successful and ;; NIL if not. Argument NIL must correspond to moving backwards by 1. (defun tads-prev-object (&optional arg) "Go to the previous object or class declaration in the file. With a prefix arg, go back many declarations. With a negative prefix arg, go forwards." (interactive "P") (tads-next-object (- (prefix-numeric-value arg)))) (defun tads-imenu-extract-name () (cond ((looking-at "^\\(\\w+\\)\\s-*:\\s-*function\\(;\\)?") (if (not (match-string 2)) ; If it's a forward declaration, don't bite (concat "Function " (buffer-substring-no-properties (match-beginning 1) (match-end 1))))) ((looking-at "^\\(\\w+\\)\\s-*:") (buffer-substring-no-properties (match-beginning 1) (match-end 1))) ((looking-at "^\\(modify\\|replace\\)\\s-+\\(\\w+\\)") (concat (buffer-substring-no-properties (match-beginning 2) (match-end 2)) "*")) ((looking-at "^class\\s-+\\(\\w+\\)\\s-*:") (concat "Class " (buffer-substring-no-properties (match-beginning 1) (match-end 1)))))) (defun tads-inside-comment () (interactive) (save-excursion (beginning-of-line) (let ((opoint (point)) state) (tads-beginning-of-defun) (while (< (point) opoint) (setq state (parse-partial-sexp (point) opoint))) (nth 4 state)))) (defun tads-inside-parens-p () (condition-case () (save-excursion (save-restriction (narrow-to-region (point) (progn (beginning-of-defun) (point))) (goto-char (point-max)) (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\())) (error nil))) ;; This function exists because it's very hard to come up with a regexp ;; which means, "match any label except 'default:'". (defun tads-looking-at-defun () (and (looking-at tads-defun-regexp) (not (looking-at "[ \t]*default[ \t]*:")))) ;;; Electric commands: -------------------------------------------------------- (defun electric-tads-brace (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos) (if (and (not arg) (eolp) (or (save-excursion (skip-chars-backward " \t") (bolp)) (if tads-auto-newline (progn (tads-indent-line) (newline) t) nil))) (progn (insert last-command-char) (tads-indent-line) (if tads-auto-newline (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (tads-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) (defun electric-tads-splat (arg) "Insert character and correct line's indentation, if in a comment." (interactive "P") (self-insert-command (prefix-numeric-value arg)) (if (tads-inside-comment) (tads-indent-line))) (defun electric-tads-sharp-sign (arg) "Insert character and correct line's indentation." (interactive "P") (if (save-excursion (skip-chars-backward " \t") (bolp)) (let ((tads-auto-newline nil)) (electric-tads-terminator arg)) (self-insert-command (prefix-numeric-value arg)))) (defun electric-tads-semi (arg) "Insert character and correct line's indentation." (interactive "P") (if tads-auto-newline (electric-tads-terminator arg) (self-insert-command (prefix-numeric-value arg)) (if (tads-top-level) (tads-indent-line)))) (defun electric-tads-enter (arg) (interactive "P") (if tads-strip-trailing-whitespace (delete-backward-char (- (save-excursion (skip-chars-backward " \t"))))) (newline) (if tads-auto-indent-after-newline (tads-indent-line))) (defun electric-tads-terminator (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos (end (point))) (if (and (not arg) (eolp) (not (save-excursion (beginning-of-line) (skip-chars-forward " \t") (or (= (following-char) ?#) ;; Colon is special only after a label, or case .... ;; So quickly rule out most other uses of colon ;; and do no indentation for them. (and (eq last-command-char ?:) (not (looking-at tads-switch-label-regexp)) (save-excursion (skip-chars-forward "a-zA-Z0-9_$") (skip-chars-forward " \t") (< (point) end))) (progn (tads-beginning-of-defun) (let ((pps (parse-partial-sexp (point) end))) (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) (progn (insert last-command-char) (tads-indent-line) (and tads-auto-newline (not (tads-inside-parens-p)) (progn (newline) ;; (newline) may have done auto-fill (setq insertpos (- (point) 2)) (tads-indent-line))) (save-excursion (if insertpos (goto-char (1+ insertpos))) (delete-char -1)))) (if insertpos (save-excursion (goto-char insertpos) (self-insert-command (prefix-numeric-value arg))) (self-insert-command (prefix-numeric-value arg))))) ;;; tads-mode.el ends here