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