+ (message "Unhide all actions (including arguments)...done")))))
+
+
+;;;===========================================================================
+;;; Insert option: command
+;;;===========================================================================
+
+(defun antlr-insert-option (level option &optional location)
+ "Insert file/grammar/rule/subrule option near point.
+LEVEL determines option kind to insert: 1=file, 2=grammar, 3=rule,
+4=subrule. OPTION is a string with the name of the option to insert.
+LOCATION can be specified for not calling `antlr-option-kind' twice.
+
+Inserting an option with this command works as follows:
+
+ 1. When called interactively, LEVEL is determined by the prefix
+ argument or automatically deduced without prefix argument.
+ 2. Signal an error if no option of that level could be inserted, e.g.,
+ if the buffer is read-only, the option area is outside the visible
+ part of the buffer or a subrule/rule option should be inserted with
+ point outside a subrule/rule.
+ 3. When called interactively, OPTION is read from the minibuffer with
+ completion over the known options of the given LEVEL.
+ 4. Ask user for confirmation if the given OPTION does not seem to be a
+ valid option to insert into the current file.
+ 5. Find a correct position to insert the option.
+ 6. Depending on the option, insert it the following way \(inserting an
+ option also means inserting the option section if necessary\):
+ - Insert the option and let user insert the value at point.
+ - Read a value (with completion) from the minibuffer, using a
+ previous value as initial contents, and insert option with value.
+ 7. Final action depending on the option. For example, set the language
+ according to a newly inserted language option.
+
+The name of all options with a specification for their values are stored
+in `antlr-options-alists'. The used specification also depends on the
+value of `antlr-tool-version', i.e., step 4 will warn you if you use an
+option that has been introduced in newer version of ANTLR, and step 5
+will offer completion using version-correct values.
+
+If the option already exists inside the visible part of the buffer, this
+command can be used to change the value of that option. Otherwise, find
+a correct position where the option can be inserted near point.
+
+The search for a correct position is as follows:
+
+ * If search is within an area where options can be inserted, use the
+ position of point. Inside the options section and if point is in
+ the middle of a option definition, skip the rest of it.
+ * If an options section already exists, insert the options at the end.
+ If only the beginning of the area is visible, insert at the
+ beginning.
+ * Otherwise, find the position where an options section can be
+ inserted and insert a new section before any comments. If the
+ position before the comments is not visible, insert the new section
+ after the comments.
+
+This function also inserts \"options {...}\" and the \":\" if necessary,
+see `antlr-options-auto-colon'. See also `antlr-options-assign-string'.
+
+This command might also set the mark like \\[set-mark-command] does, see
+`antlr-options-push-mark'."
+ (interactive (antlr-insert-option-interactive current-prefix-arg))
+ (barf-if-buffer-read-only)
+ (or location (setq location (cdr (antlr-option-kind level))))
+ (cond ((null level)
+ (error "Cannot deduce what kind of option to insert"))
+ ((atom location)
+ (error "Cannot insert any %s options around here"
+ (elt antlr-options-headings (1- level)))))
+ (let ((area (car location))
+ (place (cdr location)))
+ (cond ((null place) ; invisible
+ (error (if area
+ "Invisible %s options, use %s to make them visible"
+ "Invisible area for %s options, use %s to make it visible")
+ (elt antlr-options-headings (1- level))
+ (substitute-command-keys "\\[widen]")))
+ ((null area) ; without option part
+ (antlr-insert-option-do level option nil
+ (null (cdr place))
+ (car place)))
+ ((save-excursion ; with option part, option visible
+ (goto-char (max (point-min) (car area)))
+ (re-search-forward (concat "\\(^\\|;\\)[ \t]*\\(\\<"
+ (regexp-quote option)
+ "\\>\\)[ \t\n]*\\(\\(=[ \t]?\\)[ \t]*\\(\\(\\sw\\|\\s_\\)+\\|\"\\([^\n\"\\]\\|[\\][^\n]\\)*\"\\)?\\)?")
+ ;; 2=name, 3=4+5, 4="=", 5=value
+ (min (point-max) (cdr area))
+ t))
+ (antlr-insert-option-do level option
+ (cons (or (match-beginning 5)
+ (match-beginning 3))
+ (match-end 5))
+ (and (null (cdr place)) area)
+ (or (match-beginning 5)
+ (match-end 4)
+ (match-end 2))))
+ (t ; with option part, option not yet
+ (antlr-insert-option-do level option t
+ (and (null (cdr place)) area)
+ (car place))))))
+
+(defun antlr-insert-option-interactive (arg)
+ "Interactive specification for `antlr-insert-option'.
+Return \(LEVEL OPTION LOCATION)."
+ (barf-if-buffer-read-only)
+ (if arg (setq arg (prefix-numeric-value arg)))
+ (unless (memq arg '(nil 1 2 3 4))
+ (error "Valid prefix args: no=auto, 1=file, 2=grammar, 3=rule, 4=subrule"))
+ (let* ((kind (antlr-option-kind arg))
+ (level (car kind)))
+ (if (atom (cdr kind))
+ (list level nil (cdr kind))
+ (let* ((table (elt antlr-options-alists (1- level)))
+ (completion-ignore-case t) ;dynamic
+ (input (completing-read (format "Insert %s option: "
+ (elt antlr-options-headings
+ (1- level)))
+ table)))
+ (list level input (cdr kind))))))
+
+(defun antlr-options-menu-filter (level menu-items)
+ "Return items for options submenu of level LEVEL."
+ ;; checkdoc-params: (menu-items)
+ (let ((active (if buffer-read-only
+ nil
+ (consp (cdr-safe (cdr (antlr-option-kind level)))))))
+ (mapcar (lambda (option)
+ (vector option
+ (list 'antlr-insert-option level option)
+ :active active))
+ (sort (mapcar 'car (elt antlr-options-alists (1- level)))
+ 'string-lessp))))
+
+
+;;;===========================================================================
+;;; Insert option: determine section-kind
+;;;===========================================================================
+
+(defun antlr-option-kind (requested)
+ "Return level and location for option to insert near point.
+Call function `antlr-option-level' with argument REQUESTED. If the
+result is nil, return \(REQUESTED \. error). If the result has the
+non-nil value LEVEL, return \(LEVEL \. LOCATION) where LOCATION looks
+like \(AREA \. PLACE), see `antlr-option-location'."
+ (save-excursion
+ (save-restriction
+ (let ((min0 (point-min)) ; before `widen'!
+ (max0 (point-max))
+ (orig (point))
+ (level (antlr-option-level requested)) ; calls `widen'!
+ pos)
+ (cond ((null level)
+ (setq level requested))
+ ((eq level 1) ; file options
+ (goto-char (point-min))
+ (setq pos (antlr-skip-file-prelude 'header-only)))
+ ((not (eq level 3)) ; grammar or subrule options
+ (setq pos (point))
+ (antlr-c-forward-sws))
+ ((looking-at "^\\(private[ \t\n]\\|public[ \t\n]\\|protected[ \t\n]\\)?[ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]*\\(!\\)?[ \t\n]*\\(\\[\\)?")
+ ;; rule options, with complete rule header
+ (goto-char (or (match-end 4) (match-end 3)))
+ (setq pos (antlr-skip-sexps (if (match-end 5) 1 0)))
+ (when (looking-at "returns[ \t\n]*\\[")
+ (goto-char (1- (match-end 0)))
+ (setq pos (antlr-skip-sexps 1)))))
+ (cons level
+ (cond ((null pos) 'error)
+ ((looking-at "options[ \t\n]*{")
+ (goto-char (match-end 0))
+ (setq pos (ignore-errors-x (scan-lists (point) 1 1)))
+ (antlr-option-location orig min0 max0
+ (point)
+ (if pos (1- pos) (point-max))
+ t))
+ (t
+ (antlr-option-location orig min0 max0
+ pos (point)
+ nil))))))))
+
+(defun antlr-option-level (requested)
+ "Return level for option to insert near point.
+Remove any restrictions from current buffer and return level for the
+option to insert near point, i.e., 1, 2, 3, 4, or nil if no such option
+can be inserted. If REQUESTED is non-nil, it is the only possible value
+to return except nil. If REQUESTED is nil, return level for the nearest
+option kind, i.e., the highest number possible.
+
+If the result is 2, point is at the beginning of the class after the
+class definition. If the result is 3 or 4, point is at the beginning of
+the rule/subrule after the init action. Otherwise, the point position
+is undefined."
+ (widen)
+ (if (eq requested 1)
+ 1
+ (antlr-with-syntax-table antlr-action-syntax-table
+ (antlr-invalidate-context-cache)
+ (let* ((orig (point))
+ (outsidep (antlr-outside-rule-p))
+ bor depth)
+ (if (eq (char-after) ?\{) (antlr-skip-sexps 1))
+ (setq bor (point)) ; beginning of rule (after init action)
+ (cond ((eq requested 2) ; grammar options required?
+ (let (boc) ; beginning of class
+ (goto-char (point-min))
+ (while (and (<= (point) bor)
+ (antlr-re-search-forward antlr-class-header-regexp
+ nil))
+ (if (<= (match-beginning 0) bor)
+ (setq boc (match-end 0))))
+ (when boc
+ (goto-char boc)
+ 2)))
+ ((save-excursion ; in region of file options?
+ (goto-char (point-min))
+ (antlr-skip-file-prelude t) ; ws/comment after: OK
+ (< orig (point)))
+ (and (null requested) 1))
+ (outsidep ; outside rule not OK
+ nil)
+ ((looking-at antlr-class-header-regexp) ; rule = class def?
+ (goto-char (match-end 0))
+ (and (null requested) 2))
+ ((eq requested 3) ; rule options required?
+ (goto-char bor)
+ 3)
+ ((setq depth (antlr-syntactic-grammar-depth orig bor))
+ (if (> depth 0) ; move out of actions
+ (goto-char (scan-lists (point) -1 depth)))
+ (set-syntax-table antlr-mode-syntax-table)
+ (antlr-invalidate-context-cache)
+ (if (eq (antlr-syntactic-context) 0) ; not in subrule?
+ (unless (eq requested 4)
+ (goto-char bor)
+ 3)
+ (goto-char (1+ (scan-lists (point) -1 1)))
+ 4)))))))
+
+(defun antlr-option-location (orig min-vis max-vis min-area max-area withp)
+ "Return location for the options area.
+ORIG is the original position of `point', MIN-VIS is `point-min' and
+MAX-VIS is `point-max'. If WITHP is non-nil, there exists an option
+specification and it starts after the brace at MIN-AREA and stops at
+MAX-AREA. If WITHP is nil, there is no area and the region where it
+could be inserted starts at MIN-AREA and stops at MAX-AREA.
+
+The result has the form (AREA . PLACE). AREA is (MIN-AREA . MAX-AREA)
+if WITHP is non-nil, and nil otherwise. PLACE is nil if the area is
+invisible, (ORIG) if ORIG is inside the area, (MIN-AREA . beginning) for
+a visible start position and (MAX-AREA . end) for a visible end position
+where the beginning is preferred if WITHP is nil and the end if WITHP is
+non-nil."
+ (cons (and withp (cons min-area max-area))
+ (cond ((and (<= min-area orig) (<= orig max-area)
+ (save-excursion
+ (goto-char orig)
+ (not (memq (antlr-syntactic-context)
+ '(comment block-comment)))))
+ ;; point in options area and not in comment
+ (list orig))
+ ((and (null withp) (<= min-vis min-area) (<= min-area max-vis))
+ ;; use start of options area (only if not `withp')
+ (cons min-area 'beginning))
+ ((and (<= min-vis max-area) (<= max-area max-vis))
+ ;; use end of options area
+ (cons max-area 'end))
+ ((and withp (<= min-vis min-area) (<= min-area max-vis))
+ ;; use start of options area (only if `withp')
+ (cons min-area 'beginning)))))
+
+(defun antlr-syntactic-grammar-depth (pos beg)
+ "Return syntactic context depth at POS.
+Move to POS and from there on to the beginning of the string or comment
+if POS is inside such a construct. Then, return the syntactic context
+depth at point if the point position is smaller than BEG.
+WARNING: this may alter `match-data'."
+ (goto-char pos)
+ (let ((context (or (antlr-syntactic-context) 0)))
+ (while (and context (not (integerp context)))
+ (cond ((eq context 'string)
+ (setq context
+ (and (search-backward "\"" nil t)
+ (>= (point) beg)
+ (or (antlr-syntactic-context) 0))))
+ ((memq context '(comment block-comment))
+ (setq context
+ (and (re-search-backward "/[/*]" nil t)
+ (>= (point) beg)
+ (or (antlr-syntactic-context) 0))))))
+ context))
+
+
+;;;===========================================================================
+;;; Insert options: do the insertion
+;;;===========================================================================
+
+(defun antlr-insert-option-do (level option old area pos)
+ "Insert option into buffer at position POS.
+Insert option of level LEVEL and name OPTION. If OLD is non-nil, an
+options area is already exists. If OLD looks like \(BEG \. END), the
+option already exists. Then, BEG is the start position of the option
+value, the position of the `=' or nil, and END is the end position of
+the option value or nil.
+
+If the original point position was outside an options area, AREA is nil.
+Otherwise, and if an option specification already exists, AREA is a cons
+cell where the two values determine the area inside the braces."
+ (let* ((spec (cdr (assoc option (elt antlr-options-alists (1- level)))))
+ (value (antlr-option-spec level option (cdr spec) (consp old))))
+ (if (fboundp (car spec)) (funcall (car spec) 'before-input option))
+ ;; set mark (unless point was inside options area before)
+ (if (cond (area (eq antlr-options-push-mark t))
+ ((numberp antlr-options-push-mark)
+ (> (count-lines (min (point) pos) (max (point) pos))
+ antlr-options-push-mark))
+ (antlr-options-push-mark))
+ (push-mark))
+ ;; read option value -----------------------------------------------------
+ (goto-char pos)
+ (if (null value)
+ ;; no option specification found
+ (if (y-or-n-p (format "Insert unknown %s option %s? "
+ (elt antlr-options-headings (1- level))
+ option))
+ (message "Insert value for %s option %s"
+ (elt antlr-options-headings (1- level))
+ option)
+ (error "Didn't insert unknown %s option %s"
+ (elt antlr-options-headings (1- level))
+ option))
+ ;; option specification found
+ (setq value (cdr value))
+ (if (car value)
+ (let ((initial (and (consp old) (cdr old)
+ (buffer-substring (car old) (cdr old)))))
+ (setq value (apply (car value)
+ (and initial
+ (if (eq (aref initial 0) ?\")
+ (read initial)
+ initial))
+ (cdr value))))
+ (message (cadr value))
+ (setq value nil)))
+ ;; insert value ----------------------------------------------------------
+ (if (consp old)
+ (antlr-insert-option-existing old value)
+ (if (consp area)
+ ;; Move outside string/comment if point is inside option spec
+ (antlr-syntactic-grammar-depth (point) (car area)))
+ (antlr-insert-option-space area old)
+ (or old (antlr-insert-option-area level))
+ (insert option " = ;")
+ (backward-char)
+ (if value (insert value)))
+ ;; final -----------------------------------------------------------------
+ (if (fboundp (car spec)) (funcall (car spec) 'after-insertion option))))
+
+(defun antlr-option-spec (level option specs existsp)
+ "Return version correct option value specification.
+Return specification for option OPTION of kind level LEVEL. SPECS
+should correspond to the VALUE-SPEC... in `antlr-option-alists'.
+EXISTSP determines whether the option already exists."
+ (let (value)
+ (while (and specs (>= antlr-tool-version (caar specs)))
+ (setq value (pop specs)))
+ (cond (value) ; found correct spec
+ ((null specs) nil) ; didn't find any specs
+ (existsp (car specs)) ; wrong version, but already present
+ ((y-or-n-p (format "Insert v%s %s option %s in v%s? "
+ (antlr-version-string (caar specs))
+ (elt antlr-options-headings (1- level))
+ option
+ (antlr-version-string antlr-tool-version)))
+ (car specs))
+ (t
+ (error "Didn't insert v%s %s option %s in v%s"
+ (antlr-version-string (caar specs))
+ (elt antlr-options-headings (1- level))
+ option
+ (antlr-version-string antlr-tool-version))))))
+
+(defun antlr-version-string (version)
+ "Format the Antlr version number VERSION, see `antlr-tool-version'."
+ (let ((version100 (/ version 100)))
+ (format "%d.%d.%d"
+ (/ version100 100) (mod version100 100) (mod version 100))))
+
+
+;;;===========================================================================
+;;; Insert options: the details (used by `antlr-insert-option-do')
+;;;===========================================================================
+
+(defun antlr-insert-option-existing (old value)
+ "Insert option value VALUE at point for existing option.
+For OLD, see `antlr-insert-option-do'."
+ ;; no = => insert =
+ (unless (car old) (insert antlr-options-assign-string))
+ ;; with user input => insert if necessary
+ (when value
+ (if (cdr old) ; with value
+ (if (string-equal value (buffer-substring (car old) (cdr old)))
+ (goto-char (cdr old))
+ (delete-region (car old) (cdr old))
+ (insert value))
+ (insert value)))
+ (unless (looking-at "\\([^\n=;{}/'\"]\\|'\\([^\n'\\]\\|\\\\.\\)*'\\|\"\\([^\n\"\\]\\|\\\\.\\)*\"\\)*;")
+ ;; stuff (no =, {, } or /) at point is not followed by ";"
+ (insert ";")
+ (backward-char)))
+
+(defun antlr-insert-option-space (area old)
+ "Find appropriate place to insert option, insert newlines/spaces.
+For AREA and OLD, see `antlr-insert-option-do'."
+ (let ((orig (point))
+ (open t))
+ (skip-chars-backward " \t")
+ (unless (bolp)
+ (let ((before (char-after (1- (point)))))
+ (goto-char orig)
+ (and old ; with existing options area
+ (consp area) ; if point inside existing area
+ (not (eq before ?\;)) ; if not at beginning of option
+ ; => skip to end of option
+ (if (and (search-forward ";" (cdr area) t)
+ (let ((context (antlr-syntactic-context)))
+ (or (null context) (numberp context))))
+ (setq orig (point))
+ (goto-char orig)))
+ (skip-chars-forward " \t")
+
+ (if (looking-at "$\\|//")
+ ;; just comment after point => skip (+ lines w/ same col comment)
+ (let ((same (if (> (match-end 0) (match-beginning 0))
+ (current-column))))
+ (beginning-of-line 2)
+ (or (bolp) (insert "\n"))
+ (when (and same (null area)) ; or (consp area)?
+ (while (and (looking-at "[ \t]*\\(//\\)")
+ (goto-char (match-beginning 1))
+ (= (current-column) same))
+ (beginning-of-line 2)
+ (or (bolp) (insert "\n")))))
+ (goto-char orig)
+ (if (null old)
+ (progn (insert "\n") (antlr-indent-line))
+ (unless (eq (char-after (1- (point))) ?\ )
+ (insert " "))
+ (unless (eq (char-after (point)) ?\ )
+ (insert " ")
+ (backward-char))
+ (setq open nil)))))
+ (when open
+ (beginning-of-line 1)
+ (insert "\n")
+ (backward-char)
+ (antlr-indent-line))))
+
+(defun antlr-insert-option-area (level)
+ "Insert new options area for options of level LEVEL.
+Used by `antlr-insert-option-do'."
+ (insert "options {\n\n}")
+ (when (and antlr-options-auto-colon
+ (memq level '(3 4))
+ (save-excursion
+ (antlr-c-forward-sws)
+ (if (eq (char-after (point)) ?\{) (antlr-skip-sexps 1))
+ (not (eq (char-after (point)) ?\:))))
+ (insert "\n:")
+ (antlr-indent-line)
+ (end-of-line 0))
+ (backward-char 1)
+ (antlr-indent-line)
+ (beginning-of-line 0)
+ (antlr-indent-line))
+
+
+;;;===========================================================================
+;;; Insert options: in `antlr-options-alists'
+;;;===========================================================================
+
+(defun antlr-read-value (initial-contents prompt
+ &optional as-string table table-x)
+ "Read a string from the minibuffer, possibly with completion.
+If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
+PROMPT is a string to prompt with, normally it ends in a colon and a
+space. If AS-STRING is t or is a member \(comparison done with `eq') of
+`antlr-options-style', return printed representation of the user input,
+otherwise return the user input directly.
+
+If TABLE or TABLE-X is non-nil, read with completion. The completion
+table is the resulting alist of TABLE-X concatenated with TABLE where
+TABLE can also be a function evaluation to an alist.
+
+Used inside `antlr-options-alists'."
+ (let* ((completion-ignore-case t) ; dynamic
+ (table0 (and (or table table-x)
+ (append table-x
+ (if (functionp table) (funcall table) table))))
+ (input (if table0
+ (completing-read prompt table0 nil nil initial-contents)
+ (read-from-minibuffer prompt initial-contents))))
+ (if (and as-string
+ (or (eq as-string t)
+ (cdr (assq as-string antlr-options-style))))
+ (format "%S" input)
+ input)))
+
+(defun antlr-read-boolean (initial-contents prompt &optional table)
+ "Read a boolean value from the minibuffer, with completion.
+If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
+PROMPT is a string to prompt with, normally it ends in a question mark
+and a space. \"(true or false) \" is appended if TABLE is nil.
+
+Read with completion over \"true\", \"false\" and the keys in TABLE, see
+also `antlr-read-value'.
+
+Used inside `antlr-options-alists'."
+ (antlr-read-value initial-contents
+ (if table prompt (concat prompt "(true or false) "))
+ nil
+ table '(("false") ("true"))))
+
+(defun antlr-language-option-extra (phase &rest dummies)
+;; checkdoc-params: (dummies)
+ "Change language according to the new value of the \"language\" option.
+Call `antlr-mode' if the new language would be different from the value
+of `antlr-language', keeping the value of variable `font-lock-mode'.
+
+Called in PHASE `after-insertion', see `antlr-options-alists'."
+ (when (eq phase 'after-insertion)
+ (let ((new-language (antlr-language-option t)))
+ (or (null new-language)
+ (eq new-language antlr-language)
+ (let ((font-lock (and (boundp 'font-lock-mode) font-lock-mode)))
+ (if font-lock (font-lock-mode 0))
+ (antlr-mode)
+ (and font-lock (null font-lock-mode) (font-lock-mode 1)))))))
+
+(defun antlr-c++-mode-extra (phase option &rest dummies)
+;; checkdoc-params: (option dummies)
+ "Warn if C++ option is used with the wrong language.
+Ask user \(\"y or n\"), if a C++ only option is going to be inserted but
+`antlr-language' has not the value `c++-mode'.
+
+Called in PHASE `before-input', see `antlr-options-alists'."
+ (and (eq phase 'before-input)
+ (not (eq antlr-language 'c++-mode))
+ (not (y-or-n-p (format "Insert C++ %s option? " option)))
+ (error "Didn't insert C++ %s option with language %s"
+ option (cadr (assq antlr-language antlr-language-alist)))))