mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-18 11:50:38 -08:00
This reverts almost all my recent changes to use curved quotes in docstrings and/or strings used for error diagnostics. There are a few exceptions, e.g., Bahá’í proper names. * admin/unidata/unidata-gen.el (unidata-gen-table): * lisp/abbrev.el (expand-region-abbrevs): * lisp/align.el (align-region): * lisp/allout.el (allout-mode, allout-solicit-alternate-bullet) (outlineify-sticky): * lisp/apropos.el (apropos-library): * lisp/bookmark.el (bookmark-default-annotation-text): * lisp/button.el (button-category-symbol, button-put) (make-text-button): * lisp/calc/calc-aent.el (math-read-if, math-read-factor): * lisp/calc/calc-embed.el (calc-do-embedded): * lisp/calc/calc-ext.el (calc-user-function-list): * lisp/calc/calc-graph.el (calc-graph-show-dumb): * lisp/calc/calc-help.el (calc-describe-key) (calc-describe-thing, calc-full-help): * lisp/calc/calc-lang.el (calc-c-language) (math-parse-fortran-vector-end, math-parse-tex-sum) (math-parse-eqn-matrix, math-parse-eqn-prime) (calc-yacas-language, calc-maxima-language, calc-giac-language) (math-read-giac-subscr, math-read-math-subscr) (math-read-big-rec, math-read-big-balance): * lisp/calc/calc-misc.el (calc-help, report-calc-bug): * lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes) (calc-auto-recompute): * lisp/calc/calc-prog.el (calc-fix-token-name) (calc-read-parse-table-part, calc-user-define-invocation) (math-do-arg-check): * lisp/calc/calc-store.el (calc-edit-variable): * lisp/calc/calc-units.el (math-build-units-table-buffer): * lisp/calc/calc-vec.el (math-read-brackets): * lisp/calc/calc-yank.el (calc-edit-mode): * lisp/calc/calc.el (calc, calc-do, calc-user-invocation): * lisp/calendar/appt.el (appt-display-message): * lisp/calendar/diary-lib.el (diary-check-diary-file) (diary-mail-entries, diary-from-outlook): * lisp/calendar/icalendar.el (icalendar-export-region) (icalendar--convert-float-to-ical) (icalendar--convert-date-to-ical) (icalendar--convert-ical-to-diary) (icalendar--convert-recurring-to-diary) (icalendar--add-diary-entry): * lisp/calendar/time-date.el (format-seconds): * lisp/calendar/timeclock.el (timeclock-mode-line-display) (timeclock-make-hours-explicit, timeclock-log-data): * lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category) (todo-item-mark, todo-check-format) (todo-insert-item--next-param, todo-edit-item--next-key) (todo-mode): * lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules): * lisp/cedet/mode-local.el (describe-mode-local-overload) (mode-local-print-binding, mode-local-describe-bindings-2): * lisp/cedet/semantic/complete.el (semantic-displayor-show-request): * lisp/cedet/srecode/srt-mode.el (srecode-macro-help): * lisp/cus-start.el (standard): * lisp/cus-theme.el (describe-theme-1): * lisp/custom.el (custom-add-dependencies, custom-check-theme) (custom--sort-vars-1, load-theme): * lisp/descr-text.el (describe-text-properties-1, describe-char): * lisp/dired-x.el (dired-do-run-mail): * lisp/dired.el (dired-log): * lisp/emacs-lisp/advice.el (ad-read-advised-function) (ad-read-advice-class, ad-read-advice-name, ad-enable-advice) (ad-disable-advice, ad-remove-advice, ad-set-argument) (ad-set-arguments, ad--defalias-fset, ad-activate) (ad-deactivate): * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand) (byte-compile-unfold-lambda, byte-optimize-form-code-walker) (byte-optimize-while, byte-optimize-apply): * lisp/emacs-lisp/byte-run.el (defun, defsubst): * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode) (byte-compile-log-file, byte-compile-format-warn) (byte-compile-nogroup-warn, byte-compile-arglist-warn) (byte-compile-cl-warn) (byte-compile-warn-about-unresolved-functions) (byte-compile-file, byte-compile--declare-var) (byte-compile-file-form-defmumble, byte-compile-form) (byte-compile-normal-call, byte-compile-check-variable) (byte-compile-variable-ref, byte-compile-variable-set) (byte-compile-subr-wrong-args, byte-compile-setq-default) (byte-compile-negation-optimizer) (byte-compile-condition-case--old) (byte-compile-condition-case--new, byte-compile-save-excursion) (byte-compile-defvar, byte-compile-autoload) (byte-compile-lambda-form) (byte-compile-make-variable-buffer-local, display-call-tree) (batch-byte-compile): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use): * lisp/emacs-lisp/chart.el (chart-space-usage): * lisp/emacs-lisp/check-declare.el (check-declare-scan) (check-declare-warn, check-declare-file) (check-declare-directory): * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine) (checkdoc-message-text-engine): * lisp/emacs-lisp/cl-extra.el (cl-parse-integer) (cl--describe-class): * lisp/emacs-lisp/cl-generic.el (cl-defgeneric) (cl--generic-describe, cl-generic-generalizers): * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody) (cl-symbol-macrolet): * lisp/emacs-lisp/cl.el (cl-unload-function, flet): * lisp/emacs-lisp/copyright.el (copyright) (copyright-update-directory): * lisp/emacs-lisp/edebug.el (edebug-read-list): * lisp/emacs-lisp/eieio-base.el (eieio-persistent-read): * lisp/emacs-lisp/eieio-core.el (eieio--slot-override) (eieio-oref): * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): * lisp/emacs-lisp/eieio-speedbar.el: (eieio-speedbar-child-make-tag-lines) (eieio-speedbar-child-description): * lisp/emacs-lisp/eieio.el (defclass, change-class): * lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms) (elint-init-form, elint-check-defalias-form) (elint-check-let-form): * lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu) (ert-results-pop-to-backtrace-for-test-at-point) (ert-results-pop-to-messages-for-test-at-point) (ert-results-pop-to-should-forms-for-test-at-point) (ert-describe-test): * lisp/emacs-lisp/find-func.el (find-function-search-for-symbol) (find-function-library): * lisp/emacs-lisp/generator.el (iter-yield): * lisp/emacs-lisp/gv.el (gv-define-simple-setter): * lisp/emacs-lisp/lisp-mnt.el (lm-verify): * lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning): * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): * lisp/emacs-lisp/nadvice.el (advice--make-docstring) (advice--make, define-advice): * lisp/emacs-lisp/package-x.el (package-upload-file): * lisp/emacs-lisp/package.el (package-version-join) (package-disabled-p, package-activate-1, package-activate) (package--download-one-archive) (package--download-and-read-archives) (package-compute-transaction, package-install-from-archive) (package-install, package-install-selected-packages) (package-delete, package-autoremove, describe-package-1) (package-install-button-action, package-delete-button-action) (package-menu-hide-package, package-menu--list-to-prompt) (package-menu--perform-transaction) (package-menu--find-and-notify-upgrades): * lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1): * lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode): * lisp/emacs-lisp/ring.el (ring-previous, ring-next): * lisp/emacs-lisp/rx.el (rx-check, rx-anything) (rx-check-any-string, rx-check-any, rx-check-not, rx-=) (rx-repeat, rx-check-backref, rx-syntax, rx-check-category) (rx-form): * lisp/emacs-lisp/smie.el (smie-config-save): * lisp/emacs-lisp/subr-x.el (internal--check-binding): * lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag): * lisp/emacs-lisp/testcover.el (testcover-1value): * lisp/emacs-lisp/timer.el (timer-event-handler): * lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments) (viper-toggle-search-style, viper-kill-buffer) (viper-brac-function): * lisp/emulation/viper-macs.el (viper-record-kbd-macro): * lisp/env.el (setenv): * lisp/erc/erc-button.el (erc-nick-popup): * lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english): * lisp/eshell/em-dirs.el (eshell/cd): * lisp/eshell/em-glob.el (eshell-glob-regexp) (eshell-glob-entries): * lisp/eshell/em-pred.el (eshell-parse-modifiers): * lisp/eshell/esh-opt.el (eshell-show-usage): * lisp/facemenu.el (facemenu-add-new-face) (facemenu-add-new-color): * lisp/faces.el (read-face-name, read-face-font, describe-face) (x-resolve-font-name): * lisp/files-x.el (modify-file-local-variable): * lisp/files.el (locate-user-emacs-file, find-alternate-file) (set-auto-mode, hack-one-local-variable--obsolete) (dir-locals-set-directory-class, write-file, basic-save-buffer) (delete-directory, copy-directory, recover-session) (recover-session-finish, insert-directory) (file-modes-char-to-who, file-modes-symbolic-to-number) (move-file-to-trash): * lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer): * lisp/find-cmd.el (find-generic, find-to-string): * lisp/finder.el (finder-commentary): * lisp/font-lock.el (font-lock-fontify-buffer): * lisp/format.el (format-write-file, format-find-file) (format-insert-file): * lisp/frame.el (get-device-terminal, select-frame-by-name): * lisp/fringe.el (fringe--check-style): * lisp/gnus/nnmairix.el (nnmairix-widget-create-query): * lisp/help-fns.el (help-fns--key-bindings) (help-fns--compiler-macro, help-fns--parent-mode) (help-fns--obsolete, help-fns--interactive-only) (describe-function-1, describe-variable): * lisp/help.el (describe-mode) (describe-minor-mode-from-indicator): * lisp/image.el (image-type): * lisp/international/ccl.el (ccl-dump): * lisp/international/fontset.el (x-must-resolve-font-name): * lisp/international/mule-cmds.el (prefer-coding-system) (select-safe-coding-system-interactively) (select-safe-coding-system, activate-input-method) (toggle-input-method, describe-current-input-method) (describe-language-environment): * lisp/international/mule-conf.el (code-offset): * lisp/international/mule-diag.el (describe-character-set) (list-input-methods-1): * lisp/mail/feedmail.el (feedmail-run-the-queue): * lisp/mouse.el (minor-mode-menu-from-indicator): * lisp/mpc.el (mpc-playlist-rename): * lisp/msb.el (msb--choose-menu): * lisp/net/ange-ftp.el (ange-ftp-shell-command): * lisp/net/imap.el (imap-interactive-login): * lisp/net/mairix.el (mairix-widget-create-query): * lisp/net/newst-backend.el (newsticker--sentinel-work): * lisp/net/newst-treeview.el (newsticker--treeview-load): * lisp/net/rlogin.el (rlogin): * lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer): * lisp/obsolete/otodo-mode.el (todo-more-important-p): * lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region): * lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region): * lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region): * lisp/org/ob-core.el (org-babel-goto-named-src-block) (org-babel-goto-named-result): * lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap): * lisp/org/ob-ref.el (org-babel-ref-resolve): * lisp/org/org-agenda.el (org-agenda-prepare): * lisp/org/org-clock.el (org-clock-notify-once-if-expired) (org-clock-resolve): * lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag): * lisp/org/org-feed.el (org-feed-parse-atom-entry): * lisp/org/org-habit.el (org-habit-parse-todo): * lisp/org/org-mouse.el (org-mouse-popup-global-menu) (org-mouse-context-menu): * lisp/org/org-table.el (org-table-edit-formulas): * lisp/org/ox.el (org-export-async-start): * lisp/proced.el (proced-log): * lisp/progmodes/ada-mode.el (ada-get-indent-case) (ada-check-matching-start, ada-goto-matching-start): * lisp/progmodes/ada-prj.el (ada-prj-display-page): * lisp/progmodes/ada-xref.el (ada-find-executable): * lisp/progmodes/ebrowse.el (ebrowse-tags-apropos): * lisp/progmodes/etags.el (etags-tags-apropos-additional): * lisp/progmodes/flymake.el (flymake-parse-err-lines) (flymake-start-syntax-check-process): * lisp/progmodes/python.el (python-shell-get-process-or-error) (python-define-auxiliary-skeleton): * lisp/progmodes/sql.el (sql-comint): * lisp/progmodes/verilog-mode.el (verilog-load-file-at-point): * lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate): * lisp/recentf.el (recentf-open-files): * lisp/replace.el (query-replace-read-from) (occur-after-change-function, occur-1): * lisp/scroll-bar.el (scroll-bar-columns): * lisp/server.el (server-get-auth-key): * lisp/simple.el (execute-extended-command) (undo-outer-limit-truncate, list-processes--refresh) (compose-mail, set-variable, choose-completion-string) (define-alternatives): * lisp/startup.el (site-run-file, tty-handle-args, command-line) (command-line-1): * lisp/subr.el (noreturn, define-error, add-to-list) (read-char-choice, version-to-list): * lisp/term/common-win.el (x-handle-xrm-switch) (x-handle-name-switch, x-handle-args): * lisp/term/x-win.el (x-handle-parent-id, x-handle-smid): * lisp/textmodes/reftex-ref.el (reftex-label): * lisp/textmodes/reftex-toc.el (reftex-toc-rename-label): * lisp/textmodes/two-column.el (2C-split): * lisp/tutorial.el (tutorial--describe-nonstandard-key) (tutorial--find-changed-keys): * lisp/type-break.el (type-break-noninteractive-query): * lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes) (wdired-do-perm-changes): * lisp/whitespace.el (whitespace-report-region): Prefer grave quoting in source-code strings used to generate help and diagnostics. * lisp/faces.el (face-documentation): No need to convert quotes, since the result is a docstring. * lisp/info.el (Info-virtual-index-find-node) (Info-virtual-index, info-apropos): Simplify by generating only curved quotes, since info files are typically that ways nowadays anyway. * lisp/international/mule-diag.el (list-input-methods): Don’t assume text quoting style is curved. * lisp/org/org-bibtex.el (org-bibtex-fields): Revert my recent changes, going back to the old quoting style.
748 lines
24 KiB
EmacsLisp
748 lines
24 KiB
EmacsLisp
;;; srecode/srt-mode.el --- Major mode for writing screcode macros
|
||
|
||
;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Originally named srecode-template-mode.el in the CEDET repository.
|
||
|
||
(require 'srecode/compile)
|
||
(require 'srecode/ctxt)
|
||
(require 'srecode/template)
|
||
|
||
(require 'semantic)
|
||
(require 'semantic/analyze)
|
||
(require 'semantic/wisent)
|
||
(eval-when-compile
|
||
(require 'semantic/find))
|
||
|
||
(declare-function srecode-create-dictionary "srecode/dictionary")
|
||
(declare-function srecode-resolve-argument-list "srecode/insert")
|
||
|
||
;;; Code:
|
||
(defvar srecode-template-mode-syntax-table
|
||
(let ((table (make-syntax-table (standard-syntax-table))))
|
||
(modify-syntax-entry ?\; ". 12" table) ;; SEMI, Comment start ;;
|
||
(modify-syntax-entry ?\n ">" table) ;; Comment end
|
||
(modify-syntax-entry ?$ "." table) ;; Punctuation
|
||
(modify-syntax-entry ?: "." table) ;; Punctuation
|
||
(modify-syntax-entry ?< "." table) ;; Punctuation
|
||
(modify-syntax-entry ?> "." table) ;; Punctuation
|
||
(modify-syntax-entry ?# "." table) ;; Punctuation
|
||
(modify-syntax-entry ?! "." table) ;; Punctuation
|
||
(modify-syntax-entry ?? "." table) ;; Punctuation
|
||
(modify-syntax-entry ?\" "\"" table) ;; String
|
||
(modify-syntax-entry ?\- "_" table) ;; Symbol
|
||
(modify-syntax-entry ?\\ "\\" table) ;; Quote
|
||
(modify-syntax-entry ?\` "'" table) ;; Prefix ` (backquote)
|
||
(modify-syntax-entry ?\' "'" table) ;; Prefix ' (quote)
|
||
(modify-syntax-entry ?\, "'" table) ;; Prefix , (comma)
|
||
|
||
table)
|
||
"Syntax table used in semantic recoder macro buffers.")
|
||
|
||
(defface srecode-separator-face
|
||
'((t (:weight bold :strike-through t)))
|
||
"Face used for decorating separators in srecode template mode."
|
||
:group 'srecode)
|
||
|
||
(defvar srecode-font-lock-keywords
|
||
'(
|
||
;; Template
|
||
("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\|\\)+\\)$"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-function-name-face)
|
||
(3 font-lock-builtin-face ))
|
||
("^\\(sectiondictionary\\)\\s-+\""
|
||
(1 font-lock-keyword-face))
|
||
("^\\s\s*\\(section\\)\\s-+\""
|
||
(1 font-lock-keyword-face))
|
||
("^\\s\s*\\(end\\)"
|
||
(1 font-lock-keyword-face))
|
||
("^\\(bind\\)\\s-+\""
|
||
(1 font-lock-keyword-face))
|
||
;; Variable type setting
|
||
("^\\s\s*\\(set\\)\\s-+\\(\\w+\\)\\s-+"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-variable-name-face))
|
||
("^\\s\s*\\(show\\)\\s-+\\(\\w+\\)\\s-*$"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-variable-name-face))
|
||
("\\<\\(macro\\)\\s-+\""
|
||
(1 font-lock-keyword-face))
|
||
;; Context type setting
|
||
("^\\(context\\)\\s-+\\(\\w+\\)"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-builtin-face))
|
||
;; Prompting setting
|
||
("^\\(prompt\\)\\s-+\\(\\w+\\)"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-variable-name-face))
|
||
("\\(default\\(macro\\)?\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
|
||
(1 font-lock-keyword-face)
|
||
(3 font-lock-type-face))
|
||
("\\<\\(default\\(macro\\)?\\)\\>" (1 font-lock-keyword-face))
|
||
("\\<\\(read\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-type-face))
|
||
|
||
;; Macro separators
|
||
("^----\n" 0 'srecode-separator-face)
|
||
|
||
;; Macro Matching
|
||
(srecode-template-mode-macro-escape-match 1 font-lock-string-face)
|
||
((lambda (limit)
|
||
(srecode-template-mode-font-lock-macro-helper
|
||
limit "\\(\\??\\w+\\)[^ \t\n{}$#@&*()]*"))
|
||
1 font-lock-variable-name-face)
|
||
((lambda (limit)
|
||
(srecode-template-mode-font-lock-macro-helper
|
||
limit "\\([#/]\\w+\\)[^ \t\n{}$#@&*()]*"))
|
||
1 font-lock-keyword-face)
|
||
((lambda (limit)
|
||
(srecode-template-mode-font-lock-macro-helper
|
||
limit "\\([<>]\\w*\\):\\(\\w+\\):\\(\\w+\\)"))
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-builtin-face)
|
||
(3 font-lock-type-face))
|
||
((lambda (limit)
|
||
(srecode-template-mode-font-lock-macro-helper
|
||
limit "\\([<>?]?\\w*\\):\\(\\w+\\)"))
|
||
(1 font-lock-keyword-face)
|
||
(2 font-lock-type-face))
|
||
((lambda (limit)
|
||
(srecode-template-mode-font-lock-macro-helper
|
||
limit "!\\([^{}$]*\\)"))
|
||
1 font-lock-comment-face)
|
||
|
||
)
|
||
"Keywords for use with srecode macros and font-lock.")
|
||
|
||
(defun srecode-template-mode-font-lock-macro-helper (limit expression)
|
||
"Match against escape characters.
|
||
Don't scan past LIMIT. Match with EXPRESSION."
|
||
(let* ((done nil)
|
||
(md nil)
|
||
(es (regexp-quote (srecode-template-get-escape-start)))
|
||
(ee (regexp-quote (srecode-template-get-escape-end)))
|
||
(regex (concat es expression ee))
|
||
)
|
||
(while (not done)
|
||
(save-match-data
|
||
(if (re-search-forward regex limit t)
|
||
(when (equal (car (srecode-calculate-context)) "code")
|
||
(setq md (match-data)
|
||
done t))
|
||
(setq done t))))
|
||
(set-match-data md)
|
||
;; (when md (message "Found a match!"))
|
||
(when md t)))
|
||
|
||
(defun srecode-template-mode-macro-escape-match (limit)
|
||
"Match against escape characters.
|
||
Don't scan past LIMIT."
|
||
(let* ((done nil)
|
||
(md nil)
|
||
(es (regexp-quote (srecode-template-get-escape-start)))
|
||
(ee (regexp-quote (srecode-template-get-escape-end)))
|
||
(regex (concat "\\(" es "\\|" ee "\\)"))
|
||
)
|
||
(while (not done)
|
||
(save-match-data
|
||
(if (re-search-forward regex limit t)
|
||
(when (equal (car (srecode-calculate-context)) "code")
|
||
(setq md (match-data)
|
||
done t))
|
||
(setq done t))))
|
||
(set-match-data md)
|
||
;;(when md (message "Found a match!"))
|
||
(when md t)))
|
||
|
||
(defvar srecode-font-lock-macro-keywords nil
|
||
"Dynamically generated `font-lock' keywords for srecode templates.
|
||
Once the escape_start, and escape_end sequences are known, then
|
||
we can tell font lock about them.")
|
||
|
||
(defvar srecode-template-mode-map
|
||
(let ((km (make-sparse-keymap)))
|
||
(define-key km "\C-c\C-c" 'srecode-compile-templates)
|
||
(define-key km "\C-c\C-m" 'srecode-macro-help)
|
||
(define-key km "/" 'srecode-self-insert-complete-end-macro)
|
||
km)
|
||
"Keymap used in srecode mode.")
|
||
|
||
;;;###autoload
|
||
(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
|
||
;; FIXME: Shouldn't it derive from prog-mode?
|
||
"Major-mode for writing SRecode macros."
|
||
(set (make-local-variable 'comment-start) ";;")
|
||
(set (make-local-variable 'comment-end) "")
|
||
(set (make-local-variable 'parse-sexp-ignore-comments) t)
|
||
(set (make-local-variable 'comment-start-skip)
|
||
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
|
||
(set (make-local-variable 'font-lock-defaults)
|
||
'(srecode-font-lock-keywords
|
||
nil ;; perform string/comment fontification
|
||
nil ;; keywords are case sensitive.
|
||
;; This puts _ & - as a word constituent,
|
||
;; simplifying our keywords significantly
|
||
((?_ . "w") (?- . "w")))))
|
||
|
||
;;;###autoload
|
||
(defalias 'srt-mode 'srecode-template-mode)
|
||
|
||
;;; Template Commands
|
||
;;
|
||
(defun srecode-self-insert-complete-end-macro ()
|
||
"Self insert the current key, then autocomplete the end macro."
|
||
(interactive)
|
||
(call-interactively 'self-insert-command)
|
||
(when (and (semantic-current-tag)
|
||
(semantic-tag-of-class-p (semantic-current-tag) 'function)
|
||
)
|
||
(let* ((es (srecode-template-get-escape-start))
|
||
(ee (srecode-template-get-escape-end))
|
||
(name (save-excursion
|
||
(forward-char (- (length es)))
|
||
(forward-char -1)
|
||
(if (looking-at (regexp-quote es))
|
||
(srecode-up-context-get-name (point) t))))
|
||
)
|
||
(when name
|
||
(insert name)
|
||
(insert ee))))
|
||
)
|
||
|
||
|
||
(defun srecode-macro-help ()
|
||
"Provide help for working with macros in a template."
|
||
(interactive)
|
||
(let* ((root 'srecode-template-inserter)
|
||
(chl (eieio-class-children root))
|
||
(ess (srecode-template-get-escape-start))
|
||
(ees (srecode-template-get-escape-end))
|
||
)
|
||
(with-output-to-temp-buffer "*SRecode Macros*"
|
||
(princ "Description of known SRecode Template Macros.")
|
||
(terpri)
|
||
(terpri)
|
||
(while chl
|
||
(let* ((C (car chl))
|
||
(name (symbol-name C))
|
||
(key (when (slot-exists-p C 'key)
|
||
(oref C key)))
|
||
(showexample t)
|
||
)
|
||
(setq chl (cdr chl))
|
||
(setq chl (append (eieio-class-children C) chl))
|
||
|
||
(catch 'skip
|
||
(when (eq C 'srecode-template-inserter-section-end)
|
||
(throw 'skip nil))
|
||
|
||
(when (class-abstract-p C)
|
||
(throw 'skip nil))
|
||
|
||
(princ (substitute-command-keys "`"))
|
||
(princ name)
|
||
(princ (substitute-command-keys "'"))
|
||
(when (slot-exists-p C 'key)
|
||
(when key
|
||
(princ " - Character Key: ")
|
||
(if (stringp key)
|
||
(progn
|
||
(setq showexample nil)
|
||
(cond ((string= key "\n")
|
||
(princ "\"\\n\"")
|
||
)
|
||
(t
|
||
(prin1 key)
|
||
)))
|
||
(prin1 (format "%c" key))
|
||
)))
|
||
(terpri)
|
||
(princ (documentation-property C 'variable-documentation))
|
||
(terpri)
|
||
(when showexample
|
||
(princ "Example:")
|
||
(terpri)
|
||
(srecode-inserter-prin-example C ess ees)
|
||
)
|
||
|
||
(terpri)
|
||
|
||
) ;; catch
|
||
);; let*
|
||
))))
|
||
|
||
|
||
;;; Misc Language Overrides
|
||
;;
|
||
(define-mode-local-override semantic-ia-insert-tag
|
||
srecode-template-mode (tag)
|
||
"Insert the SRecode TAG into the current buffer."
|
||
(insert (semantic-tag-name tag)))
|
||
|
||
|
||
;;; Local Context Parsing.
|
||
|
||
(defun srecode-in-macro-p (&optional point)
|
||
"Non-nil if POINT is inside a macro bounds.
|
||
If the ESCAPE_START and END are different sequences,
|
||
a simple search is used. If ESCAPE_START and END are the same
|
||
characters, start at the beginning of the line, and find out
|
||
how many occur."
|
||
(let ((tag (semantic-current-tag))
|
||
(es (regexp-quote (srecode-template-get-escape-start)))
|
||
(ee (regexp-quote (srecode-template-get-escape-end)))
|
||
(start (or point (point)))
|
||
)
|
||
(when (and tag (semantic-tag-of-class-p tag 'function))
|
||
(if (string= es ee)
|
||
(save-excursion
|
||
(beginning-of-line)
|
||
(while (re-search-forward es start t 2))
|
||
(if (re-search-forward es start t)
|
||
;; If there is a single, the answer is yes.
|
||
t
|
||
;; If there wasn't another, then the answer is no.
|
||
nil)
|
||
)
|
||
;; ES And EE are not the same.
|
||
(save-excursion
|
||
(and (re-search-backward es (semantic-tag-start tag) t)
|
||
(>= (or (re-search-forward ee (semantic-tag-end tag) t)
|
||
;; No end match means an incomplete macro.
|
||
start)
|
||
start)))
|
||
))))
|
||
|
||
(defun srecode-up-context-get-name (&optional point find-unmatched)
|
||
"Move up one context as for `semantic-up-context', and return the name.
|
||
Moves point to the opening characters of the section macro text.
|
||
If there is no upper context, return nil.
|
||
Starts at POINT if provided.
|
||
If FIND-UNMATCHED is specified as non-nil, then we are looking for an unmatched
|
||
section."
|
||
(when point (goto-char (point)))
|
||
(let* ((tag (semantic-current-tag))
|
||
(es (regexp-quote (srecode-template-get-escape-start)))
|
||
(start (concat es "[#<]\\(\\w+\\)"))
|
||
(orig (point))
|
||
(name nil)
|
||
(res nil))
|
||
(when (semantic-tag-of-class-p tag 'function)
|
||
(while (and (not res)
|
||
(re-search-backward start (semantic-tag-start tag) t))
|
||
(when (save-excursion
|
||
(setq name (match-string 1))
|
||
(let ((endr (concat es "/" name)))
|
||
(if (re-search-forward endr (semantic-tag-end tag) t)
|
||
(< orig (point))
|
||
(if (not find-unmatched)
|
||
(error "Unmatched Section Template")
|
||
;; We found what we want.
|
||
t))))
|
||
(setq res (point)))
|
||
)
|
||
;; Restore in no result found.
|
||
(goto-char (or res orig))
|
||
name)))
|
||
|
||
(define-mode-local-override semantic-up-context
|
||
srecode-template-mode (&optional point)
|
||
"Move up one context in the current code.
|
||
Moves out one named section."
|
||
(not (srecode-up-context-get-name point)))
|
||
|
||
(define-mode-local-override semantic-beginning-of-context
|
||
srecode-template-mode (&optional point)
|
||
"Move to the beginning of the current context.
|
||
Moves to the beginning of one named section."
|
||
(if (semantic-up-context point)
|
||
t
|
||
(let ((es (regexp-quote (srecode-template-get-escape-start)))
|
||
(ee (regexp-quote (srecode-template-get-escape-end))))
|
||
(re-search-forward es) ;; move over the start chars.
|
||
(re-search-forward ee) ;; Move after the end chars.
|
||
nil)))
|
||
|
||
(define-mode-local-override semantic-end-of-context
|
||
srecode-template-mode (&optional point)
|
||
"Move to the end of the current context.
|
||
Moves to the end of one named section."
|
||
(let ((name (srecode-up-context-get-name point))
|
||
(tag (semantic-current-tag))
|
||
(es (regexp-quote (srecode-template-get-escape-start))))
|
||
(if (not name)
|
||
t
|
||
(unless (re-search-forward (concat es "/" name) (semantic-tag-end tag) t)
|
||
(error "Section %s has no end" name))
|
||
(goto-char (match-beginning 0))
|
||
nil)))
|
||
|
||
(define-mode-local-override semantic-get-local-variables
|
||
srecode-template-mode (&optional point)
|
||
"Get local variables from an SRecode template."
|
||
(save-excursion
|
||
(when point (goto-char (point)))
|
||
(let* ((tag (semantic-current-tag))
|
||
(name (save-excursion
|
||
(srecode-up-context-get-name (point))))
|
||
(subdicts (semantic-tag-get-attribute tag :dictionaries))
|
||
(global nil)
|
||
)
|
||
(dolist (D subdicts)
|
||
(setq global (cons (semantic-tag-new-variable (car D) nil)
|
||
global)))
|
||
(if name
|
||
;; Lookup any subdictionaries in TAG.
|
||
(let ((res nil))
|
||
|
||
(while (and (not res) subdicts)
|
||
;; Find the subdictionary with the same name. Those variables
|
||
;; are now local to this section.
|
||
(when (string= (car (car subdicts)) name)
|
||
(setq res (cdr (car subdicts))))
|
||
(setq subdicts (cdr subdicts)))
|
||
;; Pre-pend our global vars.
|
||
(append global res))
|
||
;; If we aren't in a subsection, just do the global variables
|
||
global
|
||
))))
|
||
|
||
(define-mode-local-override semantic-get-local-arguments
|
||
srecode-template-mode (&optional point)
|
||
"Get local arguments from an SRecode template."
|
||
(require 'srecode/insert)
|
||
(save-excursion
|
||
(when point (goto-char (point)))
|
||
(let* ((tag (semantic-current-tag))
|
||
(args (semantic-tag-function-arguments tag))
|
||
(argsym (mapcar 'intern args))
|
||
(argvars nil)
|
||
;; Create a temporary dictionary in which the
|
||
;; arguments can be resolved so we can extract
|
||
;; the results.
|
||
(dict (srecode-create-dictionary t))
|
||
)
|
||
;; Resolve args into our temp dictionary
|
||
(srecode-resolve-argument-list argsym dict)
|
||
|
||
(maphash
|
||
(lambda (key entry)
|
||
(setq argvars
|
||
(cons (semantic-tag-new-variable key nil entry)
|
||
argvars)))
|
||
(oref dict namehash))
|
||
|
||
argvars)))
|
||
|
||
(define-mode-local-override semantic-ctxt-current-symbol
|
||
srecode-template-mode (&optional point)
|
||
"Return the current symbol under POINT.
|
||
Return nil if point is not on/in a template macro."
|
||
(let ((macro (srecode-parse-this-macro point)))
|
||
(cdr macro))
|
||
)
|
||
|
||
(defun srecode-parse-this-macro (&optional point)
|
||
"Return the current symbol under POINT.
|
||
Return nil if point is not on/in a template macro.
|
||
The first element is the key for the current macro, such as # for a
|
||
section or ? for an ask variable."
|
||
(save-excursion
|
||
(if point (goto-char point))
|
||
(let ((tag (semantic-current-tag))
|
||
(es (regexp-quote (srecode-template-get-escape-start)))
|
||
(ee (regexp-quote (srecode-template-get-escape-end)))
|
||
(start (point))
|
||
(macrostart nil)
|
||
(raw nil)
|
||
)
|
||
(when (and tag (semantic-tag-of-class-p tag 'function)
|
||
(srecode-in-macro-p point)
|
||
(re-search-backward es (semantic-tag-start tag) t))
|
||
(setq macrostart (match-end 0))
|
||
(goto-char macrostart)
|
||
;; We have a match
|
||
(when (not (re-search-forward ee (semantic-tag-end tag) t))
|
||
(goto-char start) ;; Pretend we are ok for completion
|
||
(set-match-data (list start start))
|
||
)
|
||
|
||
(if (> start (point))
|
||
;; If our starting point is after the found point, that
|
||
;; means we are not inside the macro. Return nil.
|
||
nil
|
||
;; We are inside the macro, extract the text so far.
|
||
(let* ((macroend (match-beginning 0))
|
||
(raw (buffer-substring-no-properties
|
||
macrostart macroend))
|
||
(STATE (srecode-compile-state "TMP"))
|
||
(inserter (condition-case nil
|
||
(srecode-compile-parse-inserter
|
||
raw STATE)
|
||
(error nil)))
|
||
)
|
||
(when inserter
|
||
(let ((base
|
||
(cons (oref inserter :object-name)
|
||
(if (and (slot-boundp inserter :secondname)
|
||
(oref inserter :secondname))
|
||
(split-string (oref inserter :secondname)
|
||
":")
|
||
nil)))
|
||
(key (oref inserter key)))
|
||
(cond ((null key)
|
||
;; A plain variable
|
||
(cons nil base))
|
||
(t
|
||
;; A complex variable thingy.
|
||
(cons (format "%c" key)
|
||
base)))))
|
||
)
|
||
)))
|
||
))
|
||
|
||
(define-mode-local-override semantic-analyze-current-context
|
||
srecode-template-mode (point)
|
||
"Provide a Semantic analysis in SRecode template mode."
|
||
(let* ((context-return nil)
|
||
(prefixandbounds (semantic-ctxt-current-symbol-and-bounds))
|
||
(prefix (car prefixandbounds))
|
||
(bounds (nth 2 prefixandbounds))
|
||
(key (car (srecode-parse-this-macro (point))))
|
||
(prefixsym nil)
|
||
(prefix-var nil)
|
||
(prefix-context nil)
|
||
(prefix-function nil)
|
||
(prefixclass (semantic-ctxt-current-class-list))
|
||
(globalvar (semantic-find-tags-by-class 'variable (current-buffer)))
|
||
(argtype 'macro)
|
||
(scope (semantic-calculate-scope point))
|
||
)
|
||
|
||
(oset scope fullscope (append (oref scope localvar) globalvar))
|
||
|
||
(when prefix
|
||
;; First, try to find the variable for the first
|
||
;; entry in the prefix list.
|
||
(setq prefix-var (semantic-find-first-tag-by-name
|
||
(car prefix) (oref scope fullscope)))
|
||
|
||
(cond
|
||
((and (or (not key) (string= key "?"))
|
||
(> (length prefix) 1))
|
||
;; Variables can have lisp function names.
|
||
(with-mode-local emacs-lisp-mode
|
||
(let ((fcns (semanticdb-find-tags-by-name (car (last prefix)))))
|
||
(setq prefix-function (car (semanticdb-find-result-nth fcns 0)))
|
||
(setq argtype 'elispfcn)))
|
||
)
|
||
((or (string= key "<") (string= key ">"))
|
||
;; Includes have second args that is the template name.
|
||
(if (= (length prefix) 3)
|
||
(let ((contexts (semantic-find-tags-by-class
|
||
'context (current-buffer))))
|
||
(setq prefix-context
|
||
(or (semantic-find-first-tag-by-name
|
||
(nth 1 prefix) contexts)
|
||
;; Calculate from location
|
||
(semantic-tag
|
||
(symbol-name
|
||
(srecode-template-current-context))
|
||
'context)))
|
||
(setq argtype 'template))
|
||
(setq prefix-context
|
||
;; Calculate from location
|
||
(semantic-tag
|
||
(symbol-name (srecode-template-current-context))
|
||
'context))
|
||
(setq argtype 'template)
|
||
)
|
||
;; The last one?
|
||
(when (> (length prefix) 1)
|
||
(let ((toc (srecode-template-find-templates-of-context
|
||
(read (semantic-tag-name prefix-context))))
|
||
)
|
||
(setq prefix-function
|
||
(or (semantic-find-first-tag-by-name
|
||
(car (last prefix)) toc)
|
||
;; Not in this buffer? Search the master
|
||
;; templates list.
|
||
nil))
|
||
))
|
||
)
|
||
)
|
||
|
||
(setq prefixsym
|
||
(cond ((= (length prefix) 3)
|
||
(list (or prefix-var (nth 0 prefix))
|
||
(or prefix-context (nth 1 prefix))
|
||
(or prefix-function (nth 2 prefix))))
|
||
((= (length prefix) 2)
|
||
(list (or prefix-var (nth 0 prefix))
|
||
(or prefix-function (nth 1 prefix))))
|
||
((= (length prefix) 1)
|
||
(list (or prefix-var (nth 0 prefix)))
|
||
)))
|
||
|
||
(setq context-return
|
||
(semantic-analyze-context-functionarg
|
||
"context-for-srecode"
|
||
:buffer (current-buffer)
|
||
:scope scope
|
||
:bounds bounds
|
||
:prefix (or prefixsym
|
||
prefix)
|
||
:prefixtypes nil
|
||
:prefixclass prefixclass
|
||
:errors nil
|
||
;; Use the functionarg analyzer class so we
|
||
;; can save the current key, and the index
|
||
;; into the macro part we are completing on.
|
||
:function (list key)
|
||
:index (length prefix)
|
||
:argument (list argtype)
|
||
))
|
||
|
||
context-return)))
|
||
|
||
(define-mode-local-override semantic-analyze-possible-completions
|
||
srecode-template-mode (context)
|
||
"Return a list of possible completions based on NONTEXT."
|
||
(with-current-buffer (oref context buffer)
|
||
(let* ((prefix (car (last (oref context :prefix))))
|
||
(prefixstr (cond ((stringp prefix)
|
||
prefix)
|
||
((semantic-tag-p prefix)
|
||
(semantic-tag-name prefix))))
|
||
; (completetext (cond ((semantic-tag-p prefix)
|
||
; (semantic-tag-name prefix))
|
||
; ((stringp prefix)
|
||
; prefix)
|
||
; ((stringp (car prefix))
|
||
; (car prefix))))
|
||
(argtype (car (oref context :argument)))
|
||
(matches nil))
|
||
|
||
;; Depending on what the analyzer is, we have different ways
|
||
;; of creating completions.
|
||
(cond ((eq argtype 'template)
|
||
(setq matches (semantic-find-tags-for-completion
|
||
prefixstr (current-buffer)))
|
||
(setq matches (semantic-find-tags-by-class
|
||
'function matches))
|
||
)
|
||
((eq argtype 'elispfcn)
|
||
(with-mode-local emacs-lisp-mode
|
||
(setq matches (semanticdb-find-tags-for-completion
|
||
prefixstr))
|
||
(setq matches (semantic-find-tags-by-class
|
||
'function matches))
|
||
)
|
||
)
|
||
((eq argtype 'macro)
|
||
(let ((scope (oref context scope)))
|
||
(setq matches
|
||
(semantic-find-tags-for-completion
|
||
prefixstr (oref scope fullscope))))
|
||
)
|
||
)
|
||
|
||
matches)))
|
||
|
||
|
||
|
||
;;; Utils
|
||
;;
|
||
(defun srecode-template-get-mode ()
|
||
"Get the supported major mode for this template file."
|
||
(let ((m (semantic-find-first-tag-by-name "mode" (current-buffer))))
|
||
(when m (read (semantic-tag-variable-default m)))))
|
||
|
||
(defun srecode-template-get-escape-start ()
|
||
"Get the current escape_start characters."
|
||
(let ((es (semantic-find-first-tag-by-name "escape_start" (current-buffer)))
|
||
)
|
||
(if es (car (semantic-tag-get-attribute es :default-value))
|
||
"{{")))
|
||
|
||
(defun srecode-template-get-escape-end ()
|
||
"Get the current escape_end characters."
|
||
(let ((ee (semantic-find-first-tag-by-name "escape_end" (current-buffer)))
|
||
)
|
||
(if ee (car (semantic-tag-get-attribute ee :default-value))
|
||
"}}")))
|
||
|
||
(defun srecode-template-current-context (&optional point)
|
||
"Calculate the context encompassing POINT."
|
||
(save-excursion
|
||
(when point (goto-char (point)))
|
||
(let ((ct (semantic-current-tag)))
|
||
(when (not ct)
|
||
(setq ct (semantic-find-tag-by-overlay-prev)))
|
||
|
||
;; Loop till we find the context.
|
||
(while (and ct (not (semantic-tag-of-class-p ct 'context)))
|
||
(setq ct (semantic-find-tag-by-overlay-prev
|
||
(semantic-tag-start ct))))
|
||
|
||
(if ct
|
||
(read (semantic-tag-name ct))
|
||
'declaration))))
|
||
|
||
(defun srecode-template-find-templates-of-context (context &optional buffer)
|
||
"Find all the templates belonging to a particular CONTEXT.
|
||
When optional BUFFER is provided, search that buffer."
|
||
(save-excursion
|
||
(when buffer (set-buffer buffer))
|
||
(let ((tags (semantic-fetch-available-tags))
|
||
(cc 'declaration)
|
||
(scan nil)
|
||
(ans nil))
|
||
|
||
(when (eq cc context)
|
||
(setq scan t))
|
||
|
||
(dolist (T tags)
|
||
;; Handle contexts
|
||
(when (semantic-tag-of-class-p T 'context)
|
||
(setq cc (read (semantic-tag-name T)))
|
||
(when (eq cc context)
|
||
(setq scan t)))
|
||
|
||
;; Scan
|
||
(when (and scan (semantic-tag-of-class-p T 'function))
|
||
(setq ans (cons T ans)))
|
||
)
|
||
|
||
(nreverse ans))))
|
||
|
||
(provide 'srecode/srt-mode)
|
||
|
||
;; The autoloads in this file must go into the global loaddefs.el, not
|
||
;; the srecode one, so that srecode-template-mode can be called from
|
||
;; auto-mode-alist.
|
||
|
||
;; Local variables:
|
||
;; generated-autoload-load-name: "srecode/srt-mode"
|
||
;; End:
|
||
|
||
;;; srecode/srt-mode.el ends here
|