Annotation of OpenXM_contrib2/windows/post-msg-asirgui/asir-mode.el, Revision 1.3
1.1 takayama 1: ;; -*- mode: emacs-lisp -*-
2: ;;
3: ;; asir-mode.el -- asir mode
4: ;;
1.3 ! ohara 5: ;; $OpenXM: OpenXM_contrib2/windows/post-msg-asirgui/asir-mode.el,v 1.2 2013/08/29 17:39:29 ohara Exp $
1.1 takayama 6:
7: ;; This program is free software: you can redistribute it and/or modify
8: ;; it under the terms of the GNU General Public License as published by
9: ;; the Free Software Foundation, either version 3 of the License, or
10: ;; (at your option) any later version.
11:
12: ;;;; AsirGUI for Windows
1.3 ! ohara 13: (defvar asir-exec-path '("~/Desktop/asir/bin" "c:/Program Files/asir/bin" "c:/Program Files (x64)/asir/bin" "c:/asir/bin")
! 14: "Default search path for asir binary in Windows")
1.1 takayama 15:
1.3 ! ohara 16: (defun asir-effective-exec-path ()
1.1 takayama 17: "Search path for command"
18: (let* ((dir (getenv "ASIR_ROOTDIR"))
19: (path (append asir-exec-path exec-path)))
20: (if dir (cons (concat dir "/bin") path) path)))
21:
1.3 ! ohara 22: (defun asir-executable-find (command)
1.1 takayama 23: "Search for command"
24: (let* ((exec-path (asir-effective-exec-path)))
25: (executable-find command)))
26:
1.3 ! ohara 27: ;;;; Asir for UNIX
! 28: (defvar asir-cmd-buffer-name "*asir-cmd*")
! 29:
! 30: (defun asir-cmd-load (filename)
! 31: "Send `load' command to running asir process"
! 32: (if (eq system-type 'windows-nt)
! 33: (let ((exec-path (asir-effective-exec-path)))
! 34: (start-process "asir-proc-cmdasir" nil "cmdasir" filename))
! 35: (save-excursion
! 36: (if (get-buffer asir-cmd-buffer-name)
! 37: (progn
! 38: (set-buffer asir-cmd-buffer-name)
! 39: (goto-char (point-max))
! 40: (insert (format "load(\"%s\");" filename))
! 41: (comint-send-input))))))
! 42:
! 43: (defun asir-start ()
! 44: "Start asir process"
1.1 takayama 45: (interactive)
1.3 ! ohara 46: (if (eq system-type 'windows-nt)
! 47: ;; for Windows
! 48: (let ((exec-path (asir-effective-exec-path)))
! 49: (start-process "asir-proc-asirgui" nil "asirgui"))
! 50: ;; for UNIX
! 51: (save-excursion
! 52: (if (not (get-buffer asir-cmd-buffer-name))
! 53: (let ((current-frame (selected-frame)))
! 54: (or (not window-system)
! 55: (select-frame (make-frame)))
! 56: (shell (get-buffer-create asir-cmd-buffer-name)) ;; Switch to new buffer automatically
! 57: (sleep-for 1)
! 58: (goto-char (point-max))
! 59: (insert "asir")
! 60: (comint-send-input)
! 61: (select-frame current-frame))))))
1.1 takayama 62:
1.3 ! ohara 63: (defun asir-terminate ()
! 64: "Terminate asir process"
1.1 takayama 65: (interactive)
1.3 ! ohara 66: (if (eq system-type 'windows-nt)
! 67: ;; for Windows
! 68: (let ((exec-path (asir-effective-exec-path)))
! 69: (start-process "asir-proc-cmdasir" nil "cmdasir" "--quit"))
! 70: ;; for UNIX
! 71: (if (get-buffer asir-cmd-buffer-name)
! 72: (if (not window-system)
! 73: (let ((asir-cmd-window (get-buffer-window asir-cmd-buffer-name)))
! 74: (and (kill-buffer asir-cmd-buffer-name)
! 75: (or (not asir-cmd-window) (delete-window asir-cmd-window))))
! 76: (let ((asir-cmd-frame (window-frame (get-buffer-window asir-cmd-buffer-name 0))))
! 77: (and (kill-buffer asir-cmd-buffer-name)
! 78: (delete-frame asir-cmd-frame)))))))
1.1 takayama 79:
1.3 ! ohara 80: (defun asir-execute-current-buffer ()
1.1 takayama 81: "Execute the current buffer on asir"
82: (interactive)
83: (let ((exec-path (asir-effective-exec-path)))
1.3 ! ohara 84: (asir-cmd-load (buffer-file-name))))
1.1 takayama 85:
1.3 ! ohara 86: (defun asir-execute-region ()
1.1 takayama 87: "Execute the region on asir"
88: (interactive)
89: (save-excursion
90: (if mark-active
1.3 ! ohara 91: (let ((temp-file (make-temp-file (format "%s/cmdasir-" (or (getenv "TEMP") "/var/tmp"))))
! 92: (temp-buffer (generate-new-buffer " *asir-temp*")))
1.1 takayama 93: (write-region (region-beginning) (region-end) temp-file)
1.3 ! ohara 94: (set-buffer temp-buffer)
! 95: (insert " end$")
! 96: (write-region (point-min) (point-max) temp-file t) ;; append
! 97: (kill-buffer temp-buffer)
! 98: (asir-cmd-load temp-file)))))
1.1 takayama 99:
100: ;;;; Extension for CC-mode.
101:
102: (require 'cc-mode)
103:
104: (eval-when-compile
105: (require 'cc-langs)
106: (require 'cc-engine)
107: (require 'cc-fonts))
108:
109: (eval-and-compile
110: ;; Make our mode known to the language constant system. Use Java
111: ;; mode as the fallback for the constants we don't change here.
112: ;; This needs to be done also at compile time since the language
113: ;; constants are evaluated then.
114: (c-add-language 'asir-mode 'c++-mode))
115:
116: (c-lang-defconst c-stmt-delim-chars asir "^;${}?:")
117: (c-lang-defconst c-stmt-delim-chars-with-comma asir "^;$,{}?:")
118: (c-lang-defconst c-other-op-syntax-tokens
119: asir (cons "$" (c-lang-const c-other-op-syntax-tokens c)))
120: (c-lang-defconst c-identifier-syntax-modifications
121: asir (remove '(?$ . "w") (c-lang-const c-identifier-syntax-modifications c)))
122: (c-lang-defconst c-symbol-chars asir (concat c-alnum "_"))
123:
124: (c-lang-defconst c-primitive-type-kwds asir '("def" "extern" "static" "localf" "function"))
125: (c-lang-defconst c-primitive-type-prefix-kwds asir nil)
126: (c-lang-defconst c-type-list-kwds asir nil)
127: (c-lang-defconst c-class-decl-kwds asir '("module"))
128: (c-lang-defconst c-othe-decl-kwds asir '("endmodule" "end"))
129: (c-lang-defconst c-type-modifier-kwds asir nil)
130: (c-lang-defconst c-modifier-kwds asir nil)
131:
132: (c-lang-defconst c-mode-menu
133: asir
134: (append (c-lang-const c-mode-menu c)
135: '("----"
1.3 ! ohara 136: ["Start Asir" asir-start t]
! 137: ["Terminate Asir" asir-terminate t]
! 138: ["Execute Current Buffer on Asir" asir-execute-current-buffer (buffer-file-name)]
! 139: ["Execute Region on Asir" asir-execute-region mark-active]
1.1 takayama 140: )))
141:
142: (defvar asir-font-lock-extra-types nil
143: "*List of extra types (aside from the type keywords) to recognize in asir mode.
144: Each list item should be a regexp matching a single identifier.")
145:
146: (defconst asir-font-lock-keywords-1 (c-lang-const c-matchers-1 asir)
147: "Minimal highlighting for asir mode.")
148:
149: (defconst asir-font-lock-keywords-2 (c-lang-const c-matchers-2 asir)
150: "Fast normal highlighting for asir mode.")
151:
152: (defconst asir-font-lock-keywords-3 (c-lang-const c-matchers-3 asir)
153: "Accurate normal highlighting for asir mode.")
154:
155: (defvar asir-font-lock-keywords asir-font-lock-keywords-3
156: "Default expressions to highlight in asir mode.")
157:
158: (defvar asir-mode-syntax-table nil
159: "Syntax table used in asir-mode buffers.")
160: (or asir-mode-syntax-table
161: (setq asir-mode-syntax-table
162: (funcall (c-lang-const c-make-mode-syntax-table asir))))
163:
164: (defvar asir-mode-abbrev-table nil
165: "Abbreviation table used in asir-mode buffers.")
166:
167: (defvar asir-mode-map (let ((map (c-make-inherited-keymap)))
168: ;; Add bindings which are only useful for asir
169: map)
170: "Keymap used in asir-mode buffers.")
171:
1.2 ohara 172: ;; Key binding for asir-mode
1.3 ! ohara 173: (define-key asir-mode-map (kbd "C-c s") 'asir-start)
! 174: (define-key asir-mode-map (kbd "C-c t") 'asir-terminate)
! 175: (define-key asir-mode-map (kbd "C-c l") 'asir-execute-current-buffer)
! 176: (define-key asir-mode-map (kbd "C-c r") 'asir-execute-region)
1.2 ohara 177:
1.1 takayama 178: (easy-menu-define asir-menu asir-mode-map "asir Mode Commands"
179: ;; Can use `asir' as the language for `c-mode-menu'
180: ;; since its definition covers any language. In
181: ;; this case the language is used to adapt to the
182: ;; nonexistence of a cpp pass and thus removing some
183: ;; irrelevant menu alternatives.
184: (cons "Asir" (c-lang-const c-mode-menu asir)))
185:
186: (defun asir-mode ()
187: "Major mode for editing asir code.
188: This is a simple example of a separate mode derived from CC Mode to
189: support a language with syntax similar to C/C++/ObjC/Java/IDL/Pike.
190:
191: The hook `c-mode-common-hook' is run with no args at mode
192: initialization, then `asir-mode-hook'.
193:
194: Key bindings:
195: \\{asir-mode-map}"
196: (interactive)
197: (kill-all-local-variables)
198: (c-initialize-cc-mode t)
199: (set-syntax-table asir-mode-syntax-table)
200: (setq major-mode 'asir-mode
201: mode-name "asir"
202: local-abbrev-table asir-mode-abbrev-table
203: abbrev-mode t)
204: (use-local-map asir-mode-map)
205: ;; `c-init-language-vars' is a macro that is expanded at compile
206: ;; time to a large `setq' with all the language variables and their
207: ;; customized values for our language.
208: (c-init-language-vars asir-mode)
209: ;; `c-common-init' initializes most of the components of a CC Mode
210: ;; buffer, including setup of the mode menu, font-lock, etc.
211: ;; There's also a lower level routine `c-basic-common-init' that
212: ;; only makes the necessary initialization to get the syntactic
213: ;; analysis and similar things working.
214: (c-common-init 'asir-mode)
215: ;;(easy-menu-add asir-menu)
216: (run-hooks 'c-mode-common-hook)
217: (run-hooks 'asir-mode-hook)
218: (c-update-modeline))
219:
220: (if (fboundp 'asir-backup:c-guess-basic-syntax)
221: nil
222: (fset 'asir-backup:c-guess-basic-syntax (symbol-function 'c-guess-basic-syntax))
223: (defun c-guess-basic-syntax ()
224: "A modified c-guess-basic-syntax for asir-mode"
225: (if (eq major-mode 'asir-mode)
226: (asir-c-guess-basic-syntax)
227: (asir-backup:c-guess-basic-syntax))))
228:
229: ;; Meadow 3 does not have `c-brace-anchor-point'
230: ;; This function was copied from cc-engine.el of Emacs 23.4
231: (if (and (featurep 'meadow) (not (fboundp 'c-brace-anchor-point)))
232: (defun c-brace-anchor-point (bracepos)
233: ;; BRACEPOS is the position of a brace in a construct like "namespace
234: ;; Bar {". Return the anchor point in this construct; this is the
235: ;; earliest symbol on the brace's line which isn't earlier than
236: ;; "namespace".
237: ;;
238: ;; Currently (2007-08-17), "like namespace" means "matches
239: ;; c-other-block-decl-kwds". It doesn't work with "class" or "struct"
240: ;; or anything like that.
241: (save-excursion
242: (let ((boi (c-point 'boi bracepos)))
243: (goto-char bracepos)
244: (while (and (> (point) boi)
245: (not (looking-at c-other-decl-block-key)))
246: (c-backward-token-2))
247: (if (> (point) boi) (point) boi))))
248: )
249:
250: ;; The function `c-guess-basic-syntax' was copied from cc-engine.el of Emacs 23.4 and
251: ;; was modified for Risa/Asir.
252: ;; CASE 5D, 5J, 18 are corrected.
253:
254: ;;;; Beginning of `asir-c-guess-basic-syntax'
255: (defun asir-c-guess-basic-syntax ()
256: "Return the syntactic context of the current line."
257: (save-excursion
258: (beginning-of-line)
259: (c-save-buffer-state
260: ((indent-point (point))
261: (case-fold-search nil)
262: ;; A whole ugly bunch of various temporary variables. Have
263: ;; to declare them here since it's not possible to declare
264: ;; a variable with only the scope of a cond test and the
265: ;; following result clauses, and most of this function is a
266: ;; single gigantic cond. :P
267: literal char-before-ip before-ws-ip char-after-ip macro-start
268: in-macro-expr c-syntactic-context placeholder c-in-literal-cache
269: step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos
270: containing-<
271: ;; The following record some positions for the containing
272: ;; declaration block if we're directly within one:
273: ;; `containing-decl-open' is the position of the open
274: ;; brace. `containing-decl-start' is the start of the
275: ;; declaration. `containing-decl-kwd' is the keyword
276: ;; symbol of the keyword that tells what kind of block it
277: ;; is.
278: containing-decl-open
279: containing-decl-start
280: containing-decl-kwd
281: ;; The open paren of the closest surrounding sexp or nil if
282: ;; there is none.
283: containing-sexp
284: ;; The position after the closest preceding brace sexp
285: ;; (nested sexps are ignored), or the position after
286: ;; `containing-sexp' if there is none, or (point-min) if
287: ;; `containing-sexp' is nil.
288: lim
289: ;; The paren state outside `containing-sexp', or at
290: ;; `indent-point' if `containing-sexp' is nil.
291: (paren-state (c-parse-state))
292: ;; There's always at most one syntactic element which got
293: ;; an anchor pos. It's stored in syntactic-relpos.
294: syntactic-relpos
295: (c-stmt-delim-chars c-stmt-delim-chars))
296:
297: ;; Check if we're directly inside an enclosing declaration
298: ;; level block.
299: (when (and (setq containing-sexp
300: (c-most-enclosing-brace paren-state))
301: (progn
302: (goto-char containing-sexp)
303: (eq (char-after) ?{))
304: (setq placeholder
305: (c-looking-at-decl-block
306: (c-most-enclosing-brace paren-state
307: containing-sexp)
308: t)))
309: (setq containing-decl-open containing-sexp
310: containing-decl-start (point)
311: containing-sexp nil)
312: (goto-char placeholder)
313: (setq containing-decl-kwd (and (looking-at c-keywords-regexp)
314: (c-keyword-sym (match-string 1)))))
315:
316: ;; Init some position variables.
317: (if c-state-cache
318: (progn
319: (setq containing-sexp (car paren-state)
320: paren-state (cdr paren-state))
321: (if (consp containing-sexp)
322: (progn
323: (setq lim (cdr containing-sexp))
324: (if (cdr c-state-cache)
325: ;; Ignore balanced paren. The next entry
326: ;; can't be another one.
327: (setq containing-sexp (car (cdr c-state-cache))
328: paren-state (cdr paren-state))
329: ;; If there is no surrounding open paren then
330: ;; put the last balanced pair back on paren-state.
331: (setq paren-state (cons containing-sexp paren-state)
332: containing-sexp nil)))
333: (setq lim (1+ containing-sexp))))
334: (setq lim (point-min)))
335:
336: ;; If we're in a parenthesis list then ',' delimits the
337: ;; "statements" rather than being an operator (with the
338: ;; exception of the "for" clause). This difference is
339: ;; typically only noticeable when statements are used in macro
340: ;; arglists.
341: (when (and containing-sexp
342: (eq (char-after containing-sexp) ?\())
343: (setq c-stmt-delim-chars c-stmt-delim-chars-with-comma))
344:
345: ;; cache char before and after indent point, and move point to
346: ;; the most likely position to perform the majority of tests
347: (goto-char indent-point)
348: (c-backward-syntactic-ws lim)
349: (setq before-ws-ip (point)
350: char-before-ip (char-before))
351: (goto-char indent-point)
352: (skip-chars-forward " \t")
353: (setq char-after-ip (char-after))
354:
355: ;; are we in a literal?
356: (setq literal (c-in-literal lim))
357:
358: ;; now figure out syntactic qualities of the current line
359: (cond
360:
361: ;; CASE 1: in a string.
362: ((eq literal 'string)
363: (c-add-syntax 'string (c-point 'bopl)))
364:
365: ;; CASE 2: in a C or C++ style comment.
366: ((and (memq literal '(c c++))
367: ;; This is a kludge for XEmacs where we use
368: ;; `buffer-syntactic-context', which doesn't correctly
369: ;; recognize "\*/" to end a block comment.
370: ;; `parse-partial-sexp' which is used by
371: ;; `c-literal-limits' will however do that in most
372: ;; versions, which results in that we get nil from
373: ;; `c-literal-limits' even when `c-in-literal' claims
374: ;; we're inside a comment.
375: (setq placeholder (c-literal-limits lim)))
376: (c-add-syntax literal (car placeholder)))
377:
378: ;; CASE 3: in a cpp preprocessor macro continuation.
379: ((and (save-excursion
380: (when (c-beginning-of-macro)
381: (setq macro-start (point))))
382: (/= macro-start (c-point 'boi))
383: (progn
384: (setq tmpsymbol 'cpp-macro-cont)
385: (or (not c-syntactic-indentation-in-macros)
386: (save-excursion
387: (goto-char macro-start)
388: ;; If at the beginning of the body of a #define
389: ;; directive then analyze as cpp-define-intro
390: ;; only. Go on with the syntactic analysis
391: ;; otherwise. in-macro-expr is set if we're in a
392: ;; cpp expression, i.e. before the #define body
393: ;; or anywhere in a non-#define directive.
394: (if (c-forward-to-cpp-define-body)
395: (let ((indent-boi (c-point 'boi indent-point)))
396: (setq in-macro-expr (> (point) indent-boi)
397: tmpsymbol 'cpp-define-intro)
398: (= (point) indent-boi))
399: (setq in-macro-expr t)
400: nil)))))
401: (c-add-syntax tmpsymbol macro-start)
402: (setq macro-start nil))
403:
404: ;; CASE 11: an else clause?
405: ((looking-at "else\\>[^_]")
406: (c-beginning-of-statement-1 containing-sexp)
407: (c-add-stmt-syntax 'else-clause nil t
408: containing-sexp paren-state))
409:
410: ;; CASE 12: while closure of a do/while construct?
411: ((and (looking-at "while\\>[^_]")
412: (save-excursion
413: (prog1 (eq (c-beginning-of-statement-1 containing-sexp)
414: 'beginning)
415: (setq placeholder (point)))))
416: (goto-char placeholder)
417: (c-add-stmt-syntax 'do-while-closure nil t
418: containing-sexp paren-state))
419:
420: ;; CASE 13: A catch or finally clause? This case is simpler
421: ;; than if-else and do-while, because a block is required
422: ;; after every try, catch and finally.
423: ((save-excursion
424: (and (cond ((c-major-mode-is 'c++-mode)
425: (looking-at "catch\\>[^_]"))
426: ((c-major-mode-is 'java-mode)
427: (looking-at "\\(catch\\|finally\\)\\>[^_]")))
428: (and (c-safe (c-backward-syntactic-ws)
429: (c-backward-sexp)
430: t)
431: (eq (char-after) ?{)
432: (c-safe (c-backward-syntactic-ws)
433: (c-backward-sexp)
434: t)
435: (if (eq (char-after) ?\()
436: (c-safe (c-backward-sexp) t)
437: t))
438: (looking-at "\\(try\\|catch\\)\\>[^_]")
439: (setq placeholder (point))))
440: (goto-char placeholder)
441: (c-add-stmt-syntax 'catch-clause nil t
442: containing-sexp paren-state))
443:
444: ;; CASE 18: A substatement we can recognize by keyword.
445: ((save-excursion
446: (and c-opt-block-stmt-key
447: (not (eq char-before-ip ?\;))
448: (not (c-at-vsemi-p before-ws-ip))
449: (not (memq char-after-ip '(?\) ?\] ?,)))
450: (or (not (eq char-before-ip ?}))
451: (c-looking-at-inexpr-block-backward c-state-cache))
452: (> (point)
453: (progn
454: ;; Ought to cache the result from the
455: ;; c-beginning-of-statement-1 calls here.
456: (setq placeholder (point))
457: (while (eq (setq step-type
458: (c-beginning-of-statement-1 lim))
459: 'label))
460: (if (eq step-type 'previous)
461: (goto-char placeholder)
462: (setq placeholder (point))
463: (if (and (eq step-type 'same)
464: (not (looking-at c-opt-block-stmt-key)))
465: ;; Step up to the containing statement if we
466: ;; stayed in the same one.
467: (let (step)
468: (while (eq
469: (setq step
470: (c-beginning-of-statement-1 lim))
471: 'label))
472: (if (eq step 'up)
473: (setq placeholder (point))
474: ;; There was no containing statement after all.
475: (goto-char placeholder)))))
476: placeholder))
477: (if (looking-at c-block-stmt-2-key)
478: ;; Require a parenthesis after these keywords.
479: ;; Necessary to catch e.g. synchronized in Java,
480: ;; which can be used both as statement and
481: ;; modifier.
482: (and (zerop (c-forward-token-2 1 nil))
483: (eq (char-after) ?\())
484: (looking-at c-opt-block-stmt-key))))
485:
486: (if (eq step-type 'up)
487: ;; CASE 18A: Simple substatement.
488: (progn
489: (goto-char placeholder)
490: (cond
491: ((eq char-after-ip ?{)
492: (c-add-stmt-syntax 'substatement-open nil nil
493: containing-sexp paren-state))
494: ((save-excursion
495: (goto-char indent-point)
496: (back-to-indentation)
497: (c-forward-label))
498: (c-add-stmt-syntax 'substatement-label nil nil
499: containing-sexp paren-state))
500: (t
501: (c-add-stmt-syntax 'substatement nil nil
502: containing-sexp paren-state))))
503:
504: ;; CASE 18B: Some other substatement. This is shared
505: ;; with case 10.
506: (c-guess-continued-construct indent-point
507: char-after-ip
508: placeholder
509: lim
510: paren-state)))
511:
512: ;; CASE 14: A case or default label
513: ((looking-at c-label-kwds-regexp)
514: (if containing-sexp
515: (progn
516: (goto-char containing-sexp)
517: (setq lim (c-most-enclosing-brace c-state-cache
518: containing-sexp))
519: (c-backward-to-block-anchor lim)
520: (c-add-stmt-syntax 'case-label nil t lim paren-state))
521: ;; Got a bogus label at the top level. In lack of better
522: ;; alternatives, anchor it on (point-min).
523: (c-add-syntax 'case-label (point-min))))
524:
525: ;; CASE 15: any other label
526: ((save-excursion
527: (back-to-indentation)
528: (and (not (looking-at c-syntactic-ws-start))
529: (c-forward-label)))
530: (cond (containing-decl-open
531: (setq placeholder (c-add-class-syntax 'inclass
532: containing-decl-open
533: containing-decl-start
534: containing-decl-kwd
535: paren-state))
536: ;; Append access-label with the same anchor point as
537: ;; inclass gets.
538: (c-append-syntax 'access-label placeholder))
539:
540: (containing-sexp
541: (goto-char containing-sexp)
542: (setq lim (c-most-enclosing-brace c-state-cache
543: containing-sexp))
544: (save-excursion
545: (setq tmpsymbol
546: (if (and (eq (c-beginning-of-statement-1 lim) 'up)
547: (looking-at "switch\\>[^_]"))
548: ;; If the surrounding statement is a switch then
549: ;; let's analyze all labels as switch labels, so
550: ;; that they get lined up consistently.
551: 'case-label
552: 'label)))
553: (c-backward-to-block-anchor lim)
554: (c-add-stmt-syntax tmpsymbol nil t lim paren-state))
555:
556: (t
557: ;; A label on the top level. Treat it as a class
558: ;; context. (point-min) is the closest we get to the
559: ;; class open brace.
560: (c-add-syntax 'access-label (point-min)))))
561:
562: ;; CASE 4: In-expression statement. C.f. cases 7B, 16A and
563: ;; 17E.
564: ((setq placeholder (c-looking-at-inexpr-block
565: (c-safe-position containing-sexp paren-state)
566: containing-sexp
567: ;; Have to turn on the heuristics after
568: ;; the point even though it doesn't work
569: ;; very well. C.f. test case class-16.pike.
570: t))
571: (setq tmpsymbol (assq (car placeholder)
572: '((inexpr-class . class-open)
573: (inexpr-statement . block-open))))
574: (if tmpsymbol
575: ;; It's a statement block or an anonymous class.
576: (setq tmpsymbol (cdr tmpsymbol))
577: ;; It's a Pike lambda. Check whether we are between the
578: ;; lambda keyword and the argument list or at the defun
579: ;; opener.
580: (setq tmpsymbol (if (eq char-after-ip ?{)
581: 'inline-open
582: 'lambda-intro-cont)))
583: (goto-char (cdr placeholder))
584: (back-to-indentation)
585: (c-add-stmt-syntax tmpsymbol nil t
586: (c-most-enclosing-brace c-state-cache (point))
587: paren-state)
588: (unless (eq (point) (cdr placeholder))
589: (c-add-syntax (car placeholder))))
590:
591: ;; CASE 5: Line is inside a declaration level block or at top level.
592: ((or containing-decl-open (null containing-sexp))
593: (cond
594:
595: ;; CASE 5A: we are looking at a defun, brace list, class,
596: ;; or inline-inclass method opening brace
597: ((setq special-brace-list
598: (or (and c-special-brace-lists
599: (c-looking-at-special-brace-list))
600: (eq char-after-ip ?{)))
601: (cond
602:
603: ;; CASE 5A.1: Non-class declaration block open.
604: ((save-excursion
605: (let (tmp)
606: (and (eq char-after-ip ?{)
607: (setq tmp (c-looking-at-decl-block containing-sexp t))
608: (progn
609: (setq placeholder (point))
610: (goto-char tmp)
611: (looking-at c-symbol-key))
612: (c-keyword-member
613: (c-keyword-sym (setq keyword (match-string 0)))
614: 'c-other-block-decl-kwds))))
615: (goto-char placeholder)
616: (c-add-stmt-syntax
617: (if (string-equal keyword "extern")
618: ;; Special case for extern-lang-open.
619: 'extern-lang-open
620: (intern (concat keyword "-open")))
621: nil t containing-sexp paren-state))
622:
623: ;; CASE 5A.2: we are looking at a class opening brace
624: ((save-excursion
625: (goto-char indent-point)
626: (skip-chars-forward " \t")
627: (and (eq (char-after) ?{)
628: (c-looking-at-decl-block containing-sexp t)
629: (setq placeholder (point))))
630: (c-add-syntax 'class-open placeholder))
631:
632: ;; CASE 5A.3: brace list open
633: ((save-excursion
634: (c-beginning-of-decl-1 lim)
635: (while (looking-at c-specifier-key)
636: (goto-char (match-end 1))
637: (c-forward-syntactic-ws indent-point))
638: (setq placeholder (c-point 'boi))
639: (or (consp special-brace-list)
640: (and (or (save-excursion
641: (goto-char indent-point)
642: (setq tmpsymbol nil)
643: (while (and (> (point) placeholder)
644: (zerop (c-backward-token-2 1 t))
645: (/= (char-after) ?=))
646: (and c-opt-inexpr-brace-list-key
647: (not tmpsymbol)
648: (looking-at c-opt-inexpr-brace-list-key)
649: (setq tmpsymbol 'topmost-intro-cont)))
650: (eq (char-after) ?=))
651: (looking-at c-brace-list-key))
652: (save-excursion
653: (while (and (< (point) indent-point)
654: (zerop (c-forward-token-2 1 t))
655: (not (memq (char-after) '(?\; ?\()))))
656: (not (memq (char-after) '(?\; ?\()))
657: ))))
658: (if (and (not c-auto-newline-analysis)
659: (c-major-mode-is 'java-mode)
660: (eq tmpsymbol 'topmost-intro-cont))
661: ;; We're in Java and have found that the open brace
662: ;; belongs to a "new Foo[]" initialization list,
663: ;; which means the brace list is part of an
664: ;; expression and not a top level definition. We
665: ;; therefore treat it as any topmost continuation
666: ;; even though the semantically correct symbol still
667: ;; is brace-list-open, on the same grounds as in
668: ;; case B.2.
669: (progn
670: (c-beginning-of-statement-1 lim)
671: (c-add-syntax 'topmost-intro-cont (c-point 'boi)))
672: (c-add-syntax 'brace-list-open placeholder)))
673:
674: ;; CASE 5A.4: inline defun open
675: ((and containing-decl-open
676: (not (c-keyword-member containing-decl-kwd
677: 'c-other-block-decl-kwds)))
678: (c-add-syntax 'inline-open)
679: (c-add-class-syntax 'inclass
680: containing-decl-open
681: containing-decl-start
682: containing-decl-kwd
683: paren-state))
684:
685: ;; CASE 5A.5: ordinary defun open
686: (t
687: (save-excursion
688: (c-beginning-of-decl-1 lim)
689: (while (looking-at c-specifier-key)
690: (goto-char (match-end 1))
691: (c-forward-syntactic-ws indent-point))
692: (c-add-syntax 'defun-open (c-point 'boi))
693: ;; Bogus to use bol here, but it's the legacy. (Resolved,
694: ;; 2007-11-09)
695: ))))
696:
697: ;; CASE 5B: After a function header but before the body (or
698: ;; the ending semicolon if there's no body).
699: ((save-excursion
700: (when (setq placeholder (c-just-after-func-arglist-p lim))
701: (setq tmp-pos (point))))
702: (cond
703:
704: ;; CASE 5B.1: Member init list.
705: ((eq (char-after tmp-pos) ?:)
706: (if (or (> tmp-pos indent-point)
707: (= (c-point 'bosws) (1+ tmp-pos)))
708: (progn
709: ;; There is no preceding member init clause.
710: ;; Indent relative to the beginning of indentation
711: ;; for the topmost-intro line that contains the
712: ;; prototype's open paren.
713: (goto-char placeholder)
714: (c-add-syntax 'member-init-intro (c-point 'boi)))
715: ;; Indent relative to the first member init clause.
716: (goto-char (1+ tmp-pos))
717: (c-forward-syntactic-ws)
718: (c-add-syntax 'member-init-cont (point))))
719:
720: ;; CASE 5B.2: K&R arg decl intro
721: ((and c-recognize-knr-p
722: (c-in-knr-argdecl lim))
723: (c-beginning-of-statement-1 lim)
724: (c-add-syntax 'knr-argdecl-intro (c-point 'boi))
725: (if containing-decl-open
726: (c-add-class-syntax 'inclass
727: containing-decl-open
728: containing-decl-start
729: containing-decl-kwd
730: paren-state)))
731:
732: ;; CASE 5B.4: Nether region after a C++ or Java func
733: ;; decl, which could include a `throws' declaration.
734: (t
735: (c-beginning-of-statement-1 lim)
736: (c-add-syntax 'func-decl-cont (c-point 'boi))
737: )))
738:
739: ;; CASE 5C: inheritance line. could be first inheritance
740: ;; line, or continuation of a multiple inheritance
741: ((or (and (c-major-mode-is 'c++-mode)
742: (progn
743: (when (eq char-after-ip ?,)
744: (skip-chars-forward " \t")
745: (forward-char))
746: (looking-at c-opt-postfix-decl-spec-key)))
747: (and (or (eq char-before-ip ?:)
748: ;; watch out for scope operator
749: (save-excursion
750: (and (eq char-after-ip ?:)
751: (c-safe (forward-char 1) t)
752: (not (eq (char-after) ?:))
753: )))
754: (save-excursion
755: (c-backward-syntactic-ws lim)
756: (if (eq char-before-ip ?:)
757: (progn
758: (forward-char -1)
759: (c-backward-syntactic-ws lim)))
760: (back-to-indentation)
761: (looking-at c-class-key)))
762: ;; for Java
763: (and (c-major-mode-is 'java-mode)
764: (let ((fence (save-excursion
765: (c-beginning-of-statement-1 lim)
766: (point)))
767: cont done)
768: (save-excursion
769: (while (not done)
770: (cond ((looking-at c-opt-postfix-decl-spec-key)
771: (setq injava-inher (cons cont (point))
772: done t))
773: ((or (not (c-safe (c-forward-sexp -1) t))
774: (<= (point) fence))
775: (setq done t))
776: )
777: (setq cont t)))
778: injava-inher)
779: (not (c-crosses-statement-barrier-p (cdr injava-inher)
780: (point)))
781: ))
782: (cond
783:
784: ;; CASE 5C.1: non-hanging colon on an inher intro
785: ((eq char-after-ip ?:)
786: (c-beginning-of-statement-1 lim)
787: (c-add-syntax 'inher-intro (c-point 'boi))
788: ;; don't add inclass symbol since relative point already
789: ;; contains any class offset
790: )
791:
792: ;; CASE 5C.2: hanging colon on an inher intro
793: ((eq char-before-ip ?:)
794: (c-beginning-of-statement-1 lim)
795: (c-add-syntax 'inher-intro (c-point 'boi))
796: (if containing-decl-open
797: (c-add-class-syntax 'inclass
798: containing-decl-open
799: containing-decl-start
800: containing-decl-kwd
801: paren-state)))
802:
803: ;; CASE 5C.3: in a Java implements/extends
804: (injava-inher
805: (let ((where (cdr injava-inher))
806: (cont (car injava-inher)))
807: (goto-char where)
808: (cond ((looking-at "throws\\>[^_]")
809: (c-add-syntax 'func-decl-cont
810: (progn (c-beginning-of-statement-1 lim)
811: (c-point 'boi))))
812: (cont (c-add-syntax 'inher-cont where))
813: (t (c-add-syntax 'inher-intro
814: (progn (goto-char (cdr injava-inher))
815: (c-beginning-of-statement-1 lim)
816: (point))))
817: )))
818:
819: ;; CASE 5C.4: a continued inheritance line
820: (t
821: (c-beginning-of-inheritance-list lim)
822: (c-add-syntax 'inher-cont (point))
823: ;; don't add inclass symbol since relative point already
824: ;; contains any class offset
825: )))
826:
827: ;; CASE 5D: this could be a top-level initialization, a
828: ;; member init list continuation, or a template argument
829: ;; list continuation.
830: ((save-excursion
831: ;; Note: We use the fact that lim is always after any
832: ;; preceding brace sexp.
833: (if c-recognize-<>-arglists
834: (while (and
835: (progn
836: (c-syntactic-skip-backward "^;$,=<>" lim t)
837: (> (point) lim))
838: (or
839: (when c-overloadable-operators-regexp
840: (when (setq placeholder (c-after-special-operator-id lim))
841: (goto-char placeholder)
842: t))
843: (cond
844: ((eq (char-before) ?>)
845: (or (c-backward-<>-arglist nil lim)
846: (backward-char))
847: t)
848: ((eq (char-before) ?<)
849: (backward-char)
850: (if (save-excursion
851: (c-forward-<>-arglist nil))
852: (progn (forward-char)
853: nil)
854: t))
855: (t nil)))))
856: ;; NB: No c-after-special-operator-id stuff in this
857: ;; clause - we assume only C++ needs it.
858: (c-syntactic-skip-backward "^;$,=" lim t))
859: (memq (char-before) '(?, ?= ?<)))
860: (cond
861:
862: ;; CASE 5D.3: perhaps a template list continuation?
863: ((and (c-major-mode-is 'c++-mode)
864: (save-excursion
865: (save-restriction
866: (c-with-syntax-table c++-template-syntax-table
867: (goto-char indent-point)
868: (setq placeholder (c-up-list-backward))
869: (and placeholder
870: (eq (char-after placeholder) ?<))))))
871: (c-with-syntax-table c++-template-syntax-table
872: (goto-char placeholder)
873: (c-beginning-of-statement-1 lim t)
874: (if (save-excursion
875: (c-backward-syntactic-ws lim)
876: (eq (char-before) ?<))
877: ;; In a nested template arglist.
878: (progn
879: (goto-char placeholder)
880: (c-syntactic-skip-backward "^,;" lim t)
881: (c-forward-syntactic-ws))
882: (back-to-indentation)))
883: ;; FIXME: Should use c-add-stmt-syntax, but it's not yet
884: ;; template aware.
885: (c-add-syntax 'template-args-cont (point) placeholder))
886:
887: ;; CASE 5D.4: perhaps a multiple inheritance line?
888: ((and (c-major-mode-is 'c++-mode)
889: (save-excursion
890: (c-beginning-of-statement-1 lim)
891: (setq placeholder (point))
892: (if (looking-at "static\\>[^_]")
893: (c-forward-token-2 1 nil indent-point))
894: (and (looking-at c-class-key)
895: (zerop (c-forward-token-2 2 nil indent-point))
896: (if (eq (char-after) ?<)
897: (c-with-syntax-table c++-template-syntax-table
898: (zerop (c-forward-token-2 1 t indent-point)))
899: t)
900: (eq (char-after) ?:))))
901: (goto-char placeholder)
902: (c-add-syntax 'inher-cont (c-point 'boi)))
903:
904: ;; CASE 5D.5: Continuation of the "expression part" of a
905: ;; top level construct. Or, perhaps, an unrecognized construct.
906: (t
907: (while (and (setq placeholder (point))
908: (eq (car (c-beginning-of-decl-1 containing-sexp))
909: 'same)
910: (save-excursion
911: (c-backward-syntactic-ws)
912: (eq (char-before) ?}))
913: (< (point) placeholder)))
914: (c-add-stmt-syntax
915: (cond
916: ((eq (point) placeholder) 'statement) ; unrecognized construct
917: ;; A preceding comma at the top level means that a
918: ;; new variable declaration starts here. Use
919: ;; topmost-intro-cont for it, for consistency with
920: ;; the first variable declaration. C.f. case 5N.
921: ((eq char-before-ip ?,) 'topmost-intro-cont)
922: (t 'statement-cont))
923: nil nil containing-sexp paren-state))
924: ))
925:
926: ;; CASE 5F: Close of a non-class declaration level block.
927: ((and (eq char-after-ip ?})
928: (c-keyword-member containing-decl-kwd
929: 'c-other-block-decl-kwds))
930: ;; This is inconsistent: Should use `containing-decl-open'
931: ;; here if it's at boi, like in case 5J.
932: (goto-char containing-decl-start)
933: (c-add-stmt-syntax
934: (if (string-equal (symbol-name containing-decl-kwd) "extern")
935: ;; Special case for compatibility with the
936: ;; extern-lang syntactic symbols.
937: 'extern-lang-close
938: (intern (concat (symbol-name containing-decl-kwd)
939: "-close")))
940: nil t
941: (c-most-enclosing-brace paren-state (point))
942: paren-state))
943:
944: ;; CASE 5G: we are looking at the brace which closes the
945: ;; enclosing nested class decl
946: ((and containing-sexp
947: (eq char-after-ip ?})
948: (eq containing-decl-open containing-sexp))
949: (c-add-class-syntax 'class-close
950: containing-decl-open
951: containing-decl-start
952: containing-decl-kwd
953: paren-state))
954:
955: ;; CASE 5H: we could be looking at subsequent knr-argdecls
956: ((and c-recognize-knr-p
957: (not containing-sexp) ; can't be knr inside braces.
958: (not (eq char-before-ip ?}))
959: (save-excursion
960: (setq placeholder (cdr (c-beginning-of-decl-1 lim)))
961: (and placeholder
962: ;; Do an extra check to avoid tripping up on
963: ;; statements that occur in invalid contexts
964: ;; (e.g. in macro bodies where we don't really
965: ;; know the context of what we're looking at).
966: (not (and c-opt-block-stmt-key
967: (looking-at c-opt-block-stmt-key)))))
968: (< placeholder indent-point))
969: (goto-char placeholder)
970: (c-add-syntax 'knr-argdecl (point)))
971:
972: ;; CASE 5I: ObjC method definition.
973: ((and c-opt-method-key
974: (looking-at c-opt-method-key))
975: (c-beginning-of-statement-1 nil t)
976: (if (= (point) indent-point)
977: ;; Handle the case when it's the first (non-comment)
978: ;; thing in the buffer. Can't look for a 'same return
979: ;; value from cbos1 since ObjC directives currently
980: ;; aren't recognized fully, so that we get 'same
981: ;; instead of 'previous if it moved over a preceding
982: ;; directive.
983: (goto-char (point-min)))
984: (c-add-syntax 'objc-method-intro (c-point 'boi)))
985:
986: ;; CASE 5P: AWK pattern or function or continuation
987: ;; thereof.
988: ((c-major-mode-is 'awk-mode)
989: (setq placeholder (point))
990: (c-add-stmt-syntax
991: (if (and (eq (c-beginning-of-statement-1) 'same)
992: (/= (point) placeholder))
993: 'topmost-intro-cont
994: 'topmost-intro)
995: nil nil
996: containing-sexp paren-state))
997:
998: ;; CASE 5N: At a variable declaration that follows a class
999: ;; definition or some other block declaration that doesn't
1000: ;; end at the closing '}'. C.f. case 5D.5.
1001: ((progn
1002: (c-backward-syntactic-ws lim)
1003: (and (eq (char-before) ?})
1004: (save-excursion
1005: (let ((start (point)))
1006: (if (and c-state-cache
1007: (consp (car c-state-cache))
1008: (eq (cdar c-state-cache) (point)))
1009: ;; Speed up the backward search a bit.
1010: (goto-char (caar c-state-cache)))
1011: (c-beginning-of-decl-1 containing-sexp)
1012: (setq placeholder (point))
1013: (if (= start (point))
1014: ;; The '}' is unbalanced.
1015: nil
1016: (c-end-of-decl-1)
1017: (>= (point) indent-point))))))
1018: (goto-char placeholder)
1019: (c-add-stmt-syntax 'topmost-intro-cont nil nil
1020: containing-sexp paren-state))
1021:
1022: ;; NOTE: The point is at the end of the previous token here.
1023:
1024: ;; CASE 5J: we are at the topmost level, make
1025: ;; sure we skip back past any access specifiers
1026: ((and
1027: ;; A macro continuation line is never at top level.
1028: (not (and macro-start
1029: (> indent-point macro-start)))
1030: (save-excursion
1031: (setq placeholder (point))
1032: (or (memq char-before-ip '(?\; ?$ ?{ ?} nil))
1033: (c-at-vsemi-p before-ws-ip)
1034: (when (and (eq char-before-ip ?:)
1035: (eq (c-beginning-of-statement-1 lim)
1036: 'label))
1037: (c-backward-syntactic-ws lim)
1038: (setq placeholder (point)))
1039: (and (c-major-mode-is 'objc-mode)
1040: (catch 'not-in-directive
1041: (c-beginning-of-statement-1 lim)
1042: (setq placeholder (point))
1043: (while (and (c-forward-objc-directive)
1044: (< (point) indent-point))
1045: (c-forward-syntactic-ws)
1046: (if (>= (point) indent-point)
1047: (throw 'not-in-directive t))
1048: (setq placeholder (point)))
1049: nil)))))
1050: ;; For historic reasons we anchor at bol of the last
1051: ;; line of the previous declaration. That's clearly
1052: ;; highly bogus and useless, and it makes our lives hard
1053: ;; to remain compatible. :P
1054: (goto-char placeholder)
1055: (c-add-syntax 'topmost-intro (c-point 'bol))
1056: (if containing-decl-open
1057: (if (c-keyword-member containing-decl-kwd
1058: 'c-other-block-decl-kwds)
1059: (progn
1060: (goto-char (c-brace-anchor-point containing-decl-open))
1061: (c-add-stmt-syntax
1062: (if (string-equal (symbol-name containing-decl-kwd)
1063: "extern")
1064: ;; Special case for compatibility with the
1065: ;; extern-lang syntactic symbols.
1066: 'inextern-lang
1067: (intern (concat "in"
1068: (symbol-name containing-decl-kwd))))
1069: nil t
1070: (c-most-enclosing-brace paren-state (point))
1071: paren-state))
1072: (c-add-class-syntax 'inclass
1073: containing-decl-open
1074: containing-decl-start
1075: containing-decl-kwd
1076: paren-state)))
1077: (when (and c-syntactic-indentation-in-macros
1078: macro-start
1079: (/= macro-start (c-point 'boi indent-point)))
1080: (c-add-syntax 'cpp-define-intro)
1081: (setq macro-start nil)))
1082:
1083: ;; CASE 5K: we are at an ObjC method definition
1084: ;; continuation line.
1085: ((and c-opt-method-key
1086: (save-excursion
1087: (c-beginning-of-statement-1 lim)
1088: (beginning-of-line)
1089: (when (looking-at c-opt-method-key)
1090: (setq placeholder (point)))))
1091: (c-add-syntax 'objc-method-args-cont placeholder))
1092:
1093: ;; CASE 5L: we are at the first argument of a template
1094: ;; arglist that begins on the previous line.
1095: ((and c-recognize-<>-arglists
1096: (eq (char-before) ?<)
1097: (setq placeholder (1- (point)))
1098: (not (and c-overloadable-operators-regexp
1099: (c-after-special-operator-id lim))))
1100: (c-beginning-of-statement-1 (c-safe-position (point) paren-state))
1101: (c-add-syntax 'template-args-cont (c-point 'boi) placeholder))
1102:
1103: ;; CASE 5Q: we are at a statement within a macro.
1104: (macro-start
1105: (c-beginning-of-statement-1 containing-sexp)
1106: (c-add-stmt-syntax 'statement nil t containing-sexp paren-state))
1107:
1108: ;; CASE 5M: we are at a topmost continuation line
1109: (t
1110: (c-beginning-of-statement-1 (c-safe-position (point) paren-state))
1111: (when (c-major-mode-is 'objc-mode)
1112: (setq placeholder (point))
1113: (while (and (c-forward-objc-directive)
1114: (< (point) indent-point))
1115: (c-forward-syntactic-ws)
1116: (setq placeholder (point)))
1117: (goto-char placeholder))
1118: (c-add-syntax 'topmost-intro-cont (c-point 'boi)))
1119: ))
1120:
1121: ;; (CASE 6 has been removed.)
1122:
1123: ;; CASE 19: line is an expression, not a statement, and is directly
1124: ;; contained by a template delimiter. Most likely, we are in a
1125: ;; template arglist within a statement. This case is based on CASE
1126: ;; 7. At some point in the future, we may wish to create more
1127: ;; syntactic symbols such as `template-intro',
1128: ;; `template-cont-nonempty', etc., and distinguish between them as we
1129: ;; do for `arglist-intro' etc. (2009-12-07).
1130: ((and c-recognize-<>-arglists
1131: (setq containing-< (c-up-list-backward indent-point containing-sexp))
1132: (eq (char-after containing-<) ?\<))
1133: (setq placeholder (c-point 'boi containing-<))
1134: (goto-char containing-sexp) ; Most nested Lbrace/Lparen (but not
1135: ; '<') before indent-point.
1136: (if (>= (point) placeholder)
1137: (progn
1138: (forward-char)
1139: (skip-chars-forward " \t"))
1140: (goto-char placeholder))
1141: (c-add-stmt-syntax 'template-args-cont (list containing-<) t
1142: (c-most-enclosing-brace c-state-cache (point))
1143: paren-state))
1144:
1145:
1146: ;; CASE 7: line is an expression, not a statement. Most
1147: ;; likely we are either in a function prototype or a function
1148: ;; call argument list, or a template argument list.
1149: ((not (or (and c-special-brace-lists
1150: (save-excursion
1151: (goto-char containing-sexp)
1152: (c-looking-at-special-brace-list)))
1153: (eq (char-after containing-sexp) ?{)
1154: (eq (char-after containing-sexp) ?<)))
1155: (cond
1156:
1157: ;; CASE 7A: we are looking at the arglist closing paren.
1158: ;; C.f. case 7F.
1159: ((memq char-after-ip '(?\) ?\]))
1160: (goto-char containing-sexp)
1161: (setq placeholder (c-point 'boi))
1162: (if (and (c-safe (backward-up-list 1) t)
1163: (>= (point) placeholder))
1164: (progn
1165: (forward-char)
1166: (skip-chars-forward " \t"))
1167: (goto-char placeholder))
1168: (c-add-stmt-syntax 'arglist-close (list containing-sexp) t
1169: (c-most-enclosing-brace paren-state (point))
1170: paren-state))
1171:
1172: ;; CASE 7B: Looking at the opening brace of an
1173: ;; in-expression block or brace list. C.f. cases 4, 16A
1174: ;; and 17E.
1175: ((and (eq char-after-ip ?{)
1176: (progn
1177: (setq placeholder (c-inside-bracelist-p (point)
1178: paren-state))
1179: (if placeholder
1180: (setq tmpsymbol '(brace-list-open . inexpr-class))
1181: (setq tmpsymbol '(block-open . inexpr-statement)
1182: placeholder
1183: (cdr-safe (c-looking-at-inexpr-block
1184: (c-safe-position containing-sexp
1185: paren-state)
1186: containing-sexp)))
1187: ;; placeholder is nil if it's a block directly in
1188: ;; a function arglist. That makes us skip out of
1189: ;; this case.
1190: )))
1191: (goto-char placeholder)
1192: (back-to-indentation)
1193: (c-add-stmt-syntax (car tmpsymbol) nil t
1194: (c-most-enclosing-brace paren-state (point))
1195: paren-state)
1196: (if (/= (point) placeholder)
1197: (c-add-syntax (cdr tmpsymbol))))
1198:
1199: ;; CASE 7C: we are looking at the first argument in an empty
1200: ;; argument list. Use arglist-close if we're actually
1201: ;; looking at a close paren or bracket.
1202: ((memq char-before-ip '(?\( ?\[))
1203: (goto-char containing-sexp)
1204: (setq placeholder (c-point 'boi))
1205: (if (and (c-safe (backward-up-list 1) t)
1206: (>= (point) placeholder))
1207: (progn
1208: (forward-char)
1209: (skip-chars-forward " \t"))
1210: (goto-char placeholder))
1211: (c-add-stmt-syntax 'arglist-intro (list containing-sexp) t
1212: (c-most-enclosing-brace paren-state (point))
1213: paren-state))
1214:
1215: ;; CASE 7D: we are inside a conditional test clause. treat
1216: ;; these things as statements
1217: ((progn
1218: (goto-char containing-sexp)
1219: (and (c-safe (c-forward-sexp -1) t)
1220: (looking-at "\\<for\\>[^_]")))
1221: (goto-char (1+ containing-sexp))
1222: (c-forward-syntactic-ws indent-point)
1223: (if (eq char-before-ip ?\;)
1224: (c-add-syntax 'statement (point))
1225: (c-add-syntax 'statement-cont (point))
1226: ))
1227:
1228: ;; CASE 7E: maybe a continued ObjC method call. This is the
1229: ;; case when we are inside a [] bracketed exp, and what
1230: ;; precede the opening bracket is not an identifier.
1231: ((and c-opt-method-key
1232: (eq (char-after containing-sexp) ?\[)
1233: (progn
1234: (goto-char (1- containing-sexp))
1235: (c-backward-syntactic-ws (c-point 'bod))
1236: (if (not (looking-at c-symbol-key))
1237: (c-add-syntax 'objc-method-call-cont containing-sexp))
1238: )))
1239:
1240: ;; CASE 7F: we are looking at an arglist continuation line,
1241: ;; but the preceding argument is on the same line as the
1242: ;; opening paren. This case includes multi-line
1243: ;; mathematical paren groupings, but we could be on a
1244: ;; for-list continuation line. C.f. case 7A.
1245: ((progn
1246: (goto-char (1+ containing-sexp))
1247: (< (save-excursion
1248: (c-forward-syntactic-ws)
1249: (point))
1250: (c-point 'bonl)))
1251: (goto-char containing-sexp) ; paren opening the arglist
1252: (setq placeholder (c-point 'boi))
1253: (if (and (c-safe (backward-up-list 1) t)
1254: (>= (point) placeholder))
1255: (progn
1256: (forward-char)
1257: (skip-chars-forward " \t"))
1258: (goto-char placeholder))
1259: (c-add-stmt-syntax 'arglist-cont-nonempty (list containing-sexp) t
1260: (c-most-enclosing-brace c-state-cache (point))
1261: paren-state))
1262:
1263: ;; CASE 7G: we are looking at just a normal arglist
1264: ;; continuation line
1265: (t (c-forward-syntactic-ws indent-point)
1266: (c-add-syntax 'arglist-cont (c-point 'boi)))
1267: ))
1268:
1269: ;; CASE 8: func-local multi-inheritance line
1270: ((and (c-major-mode-is 'c++-mode)
1271: (save-excursion
1272: (goto-char indent-point)
1273: (skip-chars-forward " \t")
1274: (looking-at c-opt-postfix-decl-spec-key)))
1275: (goto-char indent-point)
1276: (skip-chars-forward " \t")
1277: (cond
1278:
1279: ;; CASE 8A: non-hanging colon on an inher intro
1280: ((eq char-after-ip ?:)
1281: (c-backward-syntactic-ws lim)
1282: (c-add-syntax 'inher-intro (c-point 'boi)))
1283:
1284: ;; CASE 8B: hanging colon on an inher intro
1285: ((eq char-before-ip ?:)
1286: (c-add-syntax 'inher-intro (c-point 'boi)))
1287:
1288: ;; CASE 8C: a continued inheritance line
1289: (t
1290: (c-beginning-of-inheritance-list lim)
1291: (c-add-syntax 'inher-cont (point))
1292: )))
1293:
1294: ;; CASE 9: we are inside a brace-list
1295: ((and (not (c-major-mode-is 'awk-mode)) ; Maybe this isn't needed (ACM, 2002/3/29)
1296: (setq special-brace-list
1297: (or (and c-special-brace-lists ;;;; ALWAYS NIL FOR AWK!!
1298: (save-excursion
1299: (goto-char containing-sexp)
1300: (c-looking-at-special-brace-list)))
1301: (c-inside-bracelist-p containing-sexp paren-state))))
1302: (cond
1303:
1304: ;; CASE 9A: In the middle of a special brace list opener.
1305: ((and (consp special-brace-list)
1306: (save-excursion
1307: (goto-char containing-sexp)
1308: (eq (char-after) ?\())
1309: (eq char-after-ip (car (cdr special-brace-list))))
1310: (goto-char (car (car special-brace-list)))
1311: (skip-chars-backward " \t")
1312: (if (and (bolp)
1313: (assoc 'statement-cont
1314: (setq placeholder (c-guess-basic-syntax))))
1315: (setq c-syntactic-context placeholder)
1316: (c-beginning-of-statement-1
1317: (c-safe-position (1- containing-sexp) paren-state))
1318: (c-forward-token-2 0)
1319: (while (looking-at c-specifier-key)
1320: (goto-char (match-end 1))
1321: (c-forward-syntactic-ws))
1322: (c-add-syntax 'brace-list-open (c-point 'boi))))
1323:
1324: ;; CASE 9B: brace-list-close brace
1325: ((if (consp special-brace-list)
1326: ;; Check special brace list closer.
1327: (progn
1328: (goto-char (car (car special-brace-list)))
1329: (save-excursion
1330: (goto-char indent-point)
1331: (back-to-indentation)
1332: (or
1333: ;; We were between the special close char and the `)'.
1334: (and (eq (char-after) ?\))
1335: (eq (1+ (point)) (cdr (car special-brace-list))))
1336: ;; We were before the special close char.
1337: (and (eq (char-after) (cdr (cdr special-brace-list)))
1338: (zerop (c-forward-token-2))
1339: (eq (1+ (point)) (cdr (car special-brace-list)))))))
1340: ;; Normal brace list check.
1341: (and (eq char-after-ip ?})
1342: (c-safe (goto-char (c-up-list-backward (point))) t)
1343: (= (point) containing-sexp)))
1344: (if (eq (point) (c-point 'boi))
1345: (c-add-syntax 'brace-list-close (point))
1346: (setq lim (c-most-enclosing-brace c-state-cache (point)))
1347: (c-beginning-of-statement-1 lim)
1348: (c-add-stmt-syntax 'brace-list-close nil t lim paren-state)))
1349:
1350: (t
1351: ;; Prepare for the rest of the cases below by going to the
1352: ;; token following the opening brace
1353: (if (consp special-brace-list)
1354: (progn
1355: (goto-char (car (car special-brace-list)))
1356: (c-forward-token-2 1 nil indent-point))
1357: (goto-char containing-sexp))
1358: (forward-char)
1359: (let ((start (point)))
1360: (c-forward-syntactic-ws indent-point)
1361: (goto-char (max start (c-point 'bol))))
1362: (c-skip-ws-forward indent-point)
1363: (cond
1364:
1365: ;; CASE 9C: we're looking at the first line in a brace-list
1366: ((= (point) indent-point)
1367: (if (consp special-brace-list)
1368: (goto-char (car (car special-brace-list)))
1369: (goto-char containing-sexp))
1370: (if (eq (point) (c-point 'boi))
1371: (c-add-syntax 'brace-list-intro (point))
1372: (setq lim (c-most-enclosing-brace c-state-cache (point)))
1373: (c-beginning-of-statement-1 lim)
1374: (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state)))
1375:
1376: ;; CASE 9D: this is just a later brace-list-entry or
1377: ;; brace-entry-open
1378: (t (if (or (eq char-after-ip ?{)
1379: (and c-special-brace-lists
1380: (save-excursion
1381: (goto-char indent-point)
1382: (c-forward-syntactic-ws (c-point 'eol))
1383: (c-looking-at-special-brace-list (point)))))
1384: (c-add-syntax 'brace-entry-open (point))
1385: (c-add-syntax 'brace-list-entry (point))
1386: ))
1387: ))))
1388:
1389: ;; CASE 10: A continued statement or top level construct.
1390: ((and (not (memq char-before-ip '(?\; ?:)))
1391: (not (c-at-vsemi-p before-ws-ip))
1392: (or (not (eq char-before-ip ?}))
1393: (c-looking-at-inexpr-block-backward c-state-cache))
1394: (> (point)
1395: (save-excursion
1396: (c-beginning-of-statement-1 containing-sexp)
1397: (setq placeholder (point))))
1398: (/= placeholder containing-sexp))
1399: ;; This is shared with case 18.
1400: (c-guess-continued-construct indent-point
1401: char-after-ip
1402: placeholder
1403: containing-sexp
1404: paren-state))
1405:
1406: ;; CASE 16: block close brace, possibly closing the defun or
1407: ;; the class
1408: ((eq char-after-ip ?})
1409: ;; From here on we have the next containing sexp in lim.
1410: (setq lim (c-most-enclosing-brace paren-state))
1411: (goto-char containing-sexp)
1412: (cond
1413:
1414: ;; CASE 16E: Closing a statement block? This catches
1415: ;; cases where it's preceded by a statement keyword,
1416: ;; which works even when used in an "invalid" context,
1417: ;; e.g. a macro argument.
1418: ((c-after-conditional)
1419: (c-backward-to-block-anchor lim)
1420: (c-add-stmt-syntax 'block-close nil t lim paren-state))
1421:
1422: ;; CASE 16A: closing a lambda defun or an in-expression
1423: ;; block? C.f. cases 4, 7B and 17E.
1424: ((setq placeholder (c-looking-at-inexpr-block
1425: (c-safe-position containing-sexp paren-state)
1426: nil))
1427: (setq tmpsymbol (if (eq (car placeholder) 'inlambda)
1428: 'inline-close
1429: 'block-close))
1430: (goto-char containing-sexp)
1431: (back-to-indentation)
1432: (if (= containing-sexp (point))
1433: (c-add-syntax tmpsymbol (point))
1434: (goto-char (cdr placeholder))
1435: (back-to-indentation)
1436: (c-add-stmt-syntax tmpsymbol nil t
1437: (c-most-enclosing-brace paren-state (point))
1438: paren-state)
1439: (if (/= (point) (cdr placeholder))
1440: (c-add-syntax (car placeholder)))))
1441:
1442: ;; CASE 16B: does this close an inline or a function in
1443: ;; a non-class declaration level block?
1444: ((save-excursion
1445: (and lim
1446: (progn
1447: (goto-char lim)
1448: (c-looking-at-decl-block
1449: (c-most-enclosing-brace paren-state lim)
1450: nil))
1451: (setq placeholder (point))))
1452: (c-backward-to-decl-anchor lim)
1453: (back-to-indentation)
1454: (if (save-excursion
1455: (goto-char placeholder)
1456: (looking-at c-other-decl-block-key))
1457: (c-add-syntax 'defun-close (point))
1458: (c-add-syntax 'inline-close (point))))
1459:
1460: ;; CASE 16F: Can be a defun-close of a function declared
1461: ;; in a statement block, e.g. in Pike or when using gcc
1462: ;; extensions, but watch out for macros followed by
1463: ;; blocks. Let it through to be handled below.
1464: ;; C.f. cases B.3 and 17G.
1465: ((save-excursion
1466: (and (not (c-at-statement-start-p))
1467: (eq (c-beginning-of-statement-1 lim nil nil t) 'same)
1468: (setq placeholder (point))
1469: (let ((c-recognize-typeless-decls nil))
1470: ;; Turn off recognition of constructs that
1471: ;; lacks a type in this case, since that's more
1472: ;; likely to be a macro followed by a block.
1473: (c-forward-decl-or-cast-1 (c-point 'bosws) nil nil))))
1474: (back-to-indentation)
1475: (if (/= (point) containing-sexp)
1476: (goto-char placeholder))
1477: (c-add-stmt-syntax 'defun-close nil t lim paren-state))
1478:
1479: ;; CASE 16C: If there is an enclosing brace then this is
1480: ;; a block close since defun closes inside declaration
1481: ;; level blocks have been handled above.
1482: (lim
1483: ;; If the block is preceded by a case/switch label on
1484: ;; the same line, we anchor at the first preceding label
1485: ;; at boi. The default handling in c-add-stmt-syntax
1486: ;; really fixes it better, but we do like this to keep
1487: ;; the indentation compatible with version 5.28 and
1488: ;; earlier. C.f. case 17H.
1489: (while (and (/= (setq placeholder (point)) (c-point 'boi))
1490: (eq (c-beginning-of-statement-1 lim) 'label)))
1491: (goto-char placeholder)
1492: (if (looking-at c-label-kwds-regexp)
1493: (c-add-syntax 'block-close (point))
1494: (goto-char containing-sexp)
1495: ;; c-backward-to-block-anchor not necessary here; those
1496: ;; situations are handled in case 16E above.
1497: (c-add-stmt-syntax 'block-close nil t lim paren-state)))
1498:
1499: ;; CASE 16D: Only top level defun close left.
1500: (t
1501: (goto-char containing-sexp)
1502: (c-backward-to-decl-anchor lim)
1503: (c-add-stmt-syntax 'defun-close nil nil
1504: (c-most-enclosing-brace paren-state)
1505: paren-state))
1506: ))
1507:
1508: ;; CASE 17: Statement or defun catchall.
1509: (t
1510: (goto-char indent-point)
1511: ;; Back up statements until we find one that starts at boi.
1512: (while (let* ((prev-point (point))
1513: (last-step-type (c-beginning-of-statement-1
1514: containing-sexp)))
1515: (if (= (point) prev-point)
1516: (progn
1517: (setq step-type (or step-type last-step-type))
1518: nil)
1519: (setq step-type last-step-type)
1520: (/= (point) (c-point 'boi)))))
1521: (cond
1522:
1523: ;; CASE 17B: continued statement
1524: ((and (eq step-type 'same)
1525: (/= (point) indent-point))
1526: (c-add-stmt-syntax 'statement-cont nil nil
1527: containing-sexp paren-state))
1528:
1529: ;; CASE 17A: After a case/default label?
1530: ((progn
1531: (while (and (eq step-type 'label)
1532: (not (looking-at c-label-kwds-regexp)))
1533: (setq step-type
1534: (c-beginning-of-statement-1 containing-sexp)))
1535: (eq step-type 'label))
1536: (c-add-stmt-syntax (if (eq char-after-ip ?{)
1537: 'statement-case-open
1538: 'statement-case-intro)
1539: nil t containing-sexp paren-state))
1540:
1541: ;; CASE 17D: any old statement
1542: ((progn
1543: (while (eq step-type 'label)
1544: (setq step-type
1545: (c-beginning-of-statement-1 containing-sexp)))
1546: (eq step-type 'previous))
1547: (c-add-stmt-syntax 'statement nil t
1548: containing-sexp paren-state)
1549: (if (eq char-after-ip ?{)
1550: (c-add-syntax 'block-open)))
1551:
1552: ;; CASE 17I: Inside a substatement block.
1553: ((progn
1554: ;; The following tests are all based on containing-sexp.
1555: (goto-char containing-sexp)
1556: ;; From here on we have the next containing sexp in lim.
1557: (setq lim (c-most-enclosing-brace paren-state containing-sexp))
1558: (c-after-conditional))
1559: (c-backward-to-block-anchor lim)
1560: (c-add-stmt-syntax 'statement-block-intro nil t
1561: lim paren-state)
1562: (if (eq char-after-ip ?{)
1563: (c-add-syntax 'block-open)))
1564:
1565: ;; CASE 17E: first statement in an in-expression block.
1566: ;; C.f. cases 4, 7B and 16A.
1567: ((setq placeholder (c-looking-at-inexpr-block
1568: (c-safe-position containing-sexp paren-state)
1569: nil))
1570: (setq tmpsymbol (if (eq (car placeholder) 'inlambda)
1571: 'defun-block-intro
1572: 'statement-block-intro))
1573: (back-to-indentation)
1574: (if (= containing-sexp (point))
1575: (c-add-syntax tmpsymbol (point))
1576: (goto-char (cdr placeholder))
1577: (back-to-indentation)
1578: (c-add-stmt-syntax tmpsymbol nil t
1579: (c-most-enclosing-brace c-state-cache (point))
1580: paren-state)
1581: (if (/= (point) (cdr placeholder))
1582: (c-add-syntax (car placeholder))))
1583: (if (eq char-after-ip ?{)
1584: (c-add-syntax 'block-open)))
1585:
1586: ;; CASE 17F: first statement in an inline, or first
1587: ;; statement in a top-level defun. we can tell this is it
1588: ;; if there are no enclosing braces that haven't been
1589: ;; narrowed out by a class (i.e. don't use bod here).
1590: ((save-excursion
1591: (or (not (setq placeholder (c-most-enclosing-brace
1592: paren-state)))
1593: (and (progn
1594: (goto-char placeholder)
1595: (eq (char-after) ?{))
1596: (c-looking-at-decl-block (c-most-enclosing-brace
1597: paren-state (point))
1598: nil))))
1599: (c-backward-to-decl-anchor lim)
1600: (back-to-indentation)
1601: (c-add-syntax 'defun-block-intro (point)))
1602:
1603: ;; CASE 17G: First statement in a function declared inside
1604: ;; a normal block. This can occur in Pike and with
1605: ;; e.g. the gcc extensions, but watch out for macros
1606: ;; followed by blocks. C.f. cases B.3 and 16F.
1607: ((save-excursion
1608: (and (not (c-at-statement-start-p))
1609: (eq (c-beginning-of-statement-1 lim nil nil t) 'same)
1610: (setq placeholder (point))
1611: (let ((c-recognize-typeless-decls nil))
1612: ;; Turn off recognition of constructs that lacks
1613: ;; a type in this case, since that's more likely
1614: ;; to be a macro followed by a block.
1615: (c-forward-decl-or-cast-1 (c-point 'bosws) nil nil))))
1616: (back-to-indentation)
1617: (if (/= (point) containing-sexp)
1618: (goto-char placeholder))
1619: (c-add-stmt-syntax 'defun-block-intro nil t
1620: lim paren-state))
1621:
1622: ;; CASE 17H: First statement in a block.
1623: (t
1624: ;; If the block is preceded by a case/switch label on the
1625: ;; same line, we anchor at the first preceding label at
1626: ;; boi. The default handling in c-add-stmt-syntax is
1627: ;; really fixes it better, but we do like this to keep the
1628: ;; indentation compatible with version 5.28 and earlier.
1629: ;; C.f. case 16C.
1630: (while (and (/= (setq placeholder (point)) (c-point 'boi))
1631: (eq (c-beginning-of-statement-1 lim) 'label)))
1632: (goto-char placeholder)
1633: (if (looking-at c-label-kwds-regexp)
1634: (c-add-syntax 'statement-block-intro (point))
1635: (goto-char containing-sexp)
1636: ;; c-backward-to-block-anchor not necessary here; those
1637: ;; situations are handled in case 17I above.
1638: (c-add-stmt-syntax 'statement-block-intro nil t
1639: lim paren-state))
1640: (if (eq char-after-ip ?{)
1641: (c-add-syntax 'block-open)))
1642: ))
1643: )
1644:
1645: ;; now we need to look at any modifiers
1646: (goto-char indent-point)
1647: (skip-chars-forward " \t")
1648:
1649: ;; are we looking at a comment only line?
1650: (when (and (looking-at c-comment-start-regexp)
1651: (/= (c-forward-token-2 0 nil (c-point 'eol)) 0))
1652: (c-append-syntax 'comment-intro))
1653:
1654: ;; we might want to give additional offset to friends (in C++).
1655: (when (and c-opt-friend-key
1656: (looking-at c-opt-friend-key))
1657: (c-append-syntax 'friend))
1658:
1659: ;; Set syntactic-relpos.
1660: (let ((p c-syntactic-context))
1661: (while (and p
1662: (if (integerp (c-langelem-pos (car p)))
1663: (progn
1664: (setq syntactic-relpos (c-langelem-pos (car p)))
1665: nil)
1666: t))
1667: (setq p (cdr p))))
1668:
1669: ;; Start of or a continuation of a preprocessor directive?
1670: (if (and macro-start
1671: (eq macro-start (c-point 'boi))
1672: (not (and (c-major-mode-is 'pike-mode)
1673: (eq (char-after (1+ macro-start)) ?\"))))
1674: (c-append-syntax 'cpp-macro)
1675: (when (and c-syntactic-indentation-in-macros macro-start)
1676: (if in-macro-expr
1677: (when (or
1678: (< syntactic-relpos macro-start)
1679: (not (or
1680: (assq 'arglist-intro c-syntactic-context)
1681: (assq 'arglist-cont c-syntactic-context)
1682: (assq 'arglist-cont-nonempty c-syntactic-context)
1683: (assq 'arglist-close c-syntactic-context))))
1684: ;; If inside a cpp expression, i.e. anywhere in a
1685: ;; cpp directive except a #define body, we only let
1686: ;; through the syntactic analysis that is internal
1687: ;; in the expression. That means the arglist
1688: ;; elements, if they are anchored inside the cpp
1689: ;; expression.
1690: (setq c-syntactic-context nil)
1691: (c-add-syntax 'cpp-macro-cont macro-start))
1692: (when (and (eq macro-start syntactic-relpos)
1693: (not (assq 'cpp-define-intro c-syntactic-context))
1694: (save-excursion
1695: (goto-char macro-start)
1696: (or (not (c-forward-to-cpp-define-body))
1697: (<= (point) (c-point 'boi indent-point)))))
1698: ;; Inside a #define body and the syntactic analysis is
1699: ;; anchored on the start of the #define. In this case
1700: ;; we add cpp-define-intro to get the extra
1701: ;; indentation of the #define body.
1702: (c-add-syntax 'cpp-define-intro)))))
1703:
1704: ;; return the syntax
1705: c-syntactic-context)))
1706:
1707: ;;;; End of `asir-c-guess-basic-syntax'
1708:
1709: (provide 'asir-mode)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to asir-mode.el CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / windows / post-msg-asirgui