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