diff options
Diffstat (limited to 'lib/tools/emacs')
-rw-r--r-- | lib/tools/emacs/erlang-skels.el | 153 | ||||
-rw-r--r-- | lib/tools/emacs/erlang-test.el | 106 | ||||
-rw-r--r-- | lib/tools/emacs/erlang.el | 114 |
3 files changed, 263 insertions, 110 deletions
diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index ce26c83295..0284c9d686 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -56,8 +56,10 @@ erlang-skel-gen-event erlang-skel-header) ("gen_fsm" "gen-fsm" erlang-skel-gen-fsm erlang-skel-header) - ("gen_statem" "gen-statem" - erlang-skel-gen-statem erlang-skel-header) + ("gen_statem (StateName/3)" "gen-statem-StateName" + erlang-skel-gen-statem-StateName erlang-skel-header) + ("gen_statem (handle_event/4)" "gen-statem-handle-event" + erlang-skel-gen-statem-handle-event erlang-skel-header) ("wx_object" "wx-object" erlang-skel-wx-object erlang-skel-header) ("Library module" "gen-lib" @@ -497,6 +499,7 @@ Please see the function `tempo-define-template'.") "%% {stop, Reason}" n (erlang-skel-separator-end 2) "init([]) ->" n> + "process_flag(trap_exit, true)," n> "{ok, #state{}}." n n (erlang-skel-separator-start 2) @@ -740,6 +743,7 @@ Please see the function `tempo-define-template'.") "%% {stop, StopReason}" n (erlang-skel-separator-end 2) "init([]) ->" n> + "process_flag(trap_exit, true)," n> "{ok, state_name, #state{}}." n n (erlang-skel-separator-start 2) @@ -860,7 +864,7 @@ Please see the function `tempo-define-template'.") "*The template of a gen_fsm. Please see the function `tempo-define-template'.") -(defvar erlang-skel-gen-statem +(defvar erlang-skel-gen-statem-StateName '((erlang-skel-include erlang-skel-large-header) "-behaviour(gen_statem)." n n @@ -868,9 +872,8 @@ Please see the function `tempo-define-template'.") "-export([start_link/0])." n n "%% gen_statem callbacks" n - "-export([init/1, terminate/3, code_change/4])." n + "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n "-export([state_name/3])." n - "-export([handle_event/4])." n n "-define(SERVER, ?MODULE)." n n @@ -899,48 +902,151 @@ Please see the function `tempo-define-template'.") (erlang-skel-separator-start 2) "%% @private" n "%% @doc" n + "%% Define the callback_mode() for this callback module." n + (erlang-skel-separator-end 2) + "-spec callback_mode() -> gen_statem:callback_mode()." n + "callback_mode() -> state_functions." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n "%% gen_statem:start_link/[3,4], this function is called by the new" n "%% process to initialize." n (erlang-skel-separator-end 2) - "-spec init(Args :: term()) -> " n> - "{gen_statem:callback_mode()," n> - "State :: term(), Data :: term()} |" n> - "{gen_statem:callback_mode()," n> - "State :: term(), Data :: term()," n> + "-spec init(Args :: term()) ->" n> + "{ok, State :: term(), Data :: term()} |" n> + "{ok, State :: term(), Data :: term()," n> "[gen_statem:action()] | gen_statem:action()} |" n> "ignore |" n> "{stop, Reason :: term()}." n "init([]) ->" n> - "{state_functions, state_name, #data{}}." n + "process_flag(trap_exit, true)," n> + "{ok, state_name, #data{}}." n n (erlang-skel-separator-start 2) "%% @private" n "%% @doc" n - "%% If the gen_statem runs with CallbackMode =:= state_functions" n - "%% there should be one instance of this function for each possible" n - "%% state name. Whenever a gen_statem receives an event," n - "%% the instance of this function with the same name" n - "%% as the current state name StateName is called to" n - "%% handle the event." n + "%% There should be one function like this for each state name." n + "%% Whenever a gen_statem receives an event, the function " n + "%% with the name of the current state (StateName) " n + "%% is called to handle the event." n + "%%" n + "%% NOTE: If there is an exported function handle_event/4, it is called" n + "%% instead of StateName/3 functions like this!" n (erlang-skel-separator-end 2) "-spec state_name(" n> "gen_statem:event_type(), Msg :: term()," n> "Data :: term()) ->" n> - "gen_statem:state_function_result(). " n + "gen_statem:state_function_result()." n "state_name({call,Caller}, _Msg, Data) ->" n> "{next_state, state_name, Data, [{reply,Caller,ok}]}." n n (erlang-skel-separator-start 2) "%% @private" n "%% @doc" n - "%% If the gen_statem runs with CallbackMode =:= handle_event_function" n - "%% this function is called for every event a gen_statem receives." n + "%% This function is called by a gen_statem when it is about to" n + "%% terminate. It should be the opposite of Module:init/1 and do any" n + "%% necessary cleaning up. When it returns, the gen_statem terminates with" n + "%% Reason. The return value is ignored." n + (erlang-skel-separator-end 2) + "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n> + "any()." n + "terminate(_Reason, _State, _Data) ->" n> + "void." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + (erlang-skel-separator-end 2) + "-spec code_change(" n> + "OldVsn :: term() | {down,term()}," n> + "State :: term(), Data :: term(), Extra :: term()) ->" n> + "{ok, NewState :: term(), NewData :: term()} |" n> + "(Reason :: term())." n + "code_change(_OldVsn, State, Data, _Extra) ->" n> + "{ok, State, Data}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a gen_statem (StateName/3). +Please see the function `tempo-define-template'.") + +(defvar erlang-skel-gen-statem-handle-event + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_statem)." n n + + "%% API" n + "-export([start_link/0])." n + n + "%% gen_statem callbacks" n + "-export([callback_mode/0, init/1, terminate/3, code_change/4])." n + "-export([handle_event/4])." n + n + "-define(SERVER, ?MODULE)." n + n + "-record(data, {})." n + n + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Creates a gen_statem process which calls Module:init/1 to" n + "%% initialize. To ensure a synchronized start-up procedure, this" n + "%% function does not return until Module:init/1 has returned." n + "%%" n + (erlang-skel-separator-end 2) + "-spec start_link() ->" n> + "{ok, Pid :: pid()} |" n> + "ignore |" n> + "{error, Error :: term()}." n + "start_link() ->" n> + "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator-start 3) + "%%% gen_statem callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Define the callback_mode() for this callback module." n + (erlang-skel-separator-end 2) + "-spec callback_mode() -> gen_statem:callback_mode()." n + "callback_mode() -> handle_event_function." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n + "%% gen_statem:start_link/[3,4], this function is called by the new" n + "%% process to initialize." n + (erlang-skel-separator-end 2) + "-spec init(Args :: term()) ->" n> + "{ok, State :: term(), Data :: term()} |" n> + "{ok, State :: term(), Data :: term()," n> + "[gen_statem:action()] | gen_statem:action()} |" n> + "ignore |" n> + "{stop, Reason :: term()}." n + "init([]) ->" n> + "process_flag(trap_exit, true)," n> + "{ok, state_name, #data{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called for every event a gen_statem receives." n + "%%" n + "%% NOTE: If there is no exported function handle_event/4," n + "%% StateName/3 functions are called instead!" n (erlang-skel-separator-end 2) "-spec handle_event(" n> "gen_statem:event_type(), Msg :: term()," n> "State :: term(), Data :: term()) ->" n> - "gen_statem:handle_event_result(). " n + "gen_statem:handle_event_result()." n "handle_event({call,From}, _Msg, State, Data) ->" n> "{next_state, State, Data, [{reply,From,ok}]}." n n @@ -965,7 +1071,8 @@ Please see the function `tempo-define-template'.") "-spec code_change(" n> "OldVsn :: term() | {down,term()}," n> "State :: term(), Data :: term(), Extra :: term()) ->" n> - "{ok, NewState :: term(), NewData :: term()}." n + "{ok, NewState :: term(), NewData :: term()} |" n> + "(Reason :: term())." n "code_change(_OldVsn, State, Data, _Extra) ->" n> "{ok, State, Data}." n n @@ -973,7 +1080,7 @@ Please see the function `tempo-define-template'.") "%%% Internal functions" n (erlang-skel-double-separator-end 3) ) - "*The template of a gen_statem. + "*The template of a gen_statem (handle_event/4). Please see the function `tempo-define-template'.") (defvar erlang-skel-wx-object diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index 9a146632c5..ba6190d194 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -52,28 +52,42 @@ concatenated to form an erlang file to test on.") (ert-deftest erlang-test-tags () (let* ((dir (make-temp-file "erlang-test" t)) - (erlang-file (expand-file-name "erlang_test.erl" dir)) - (tags-file (expand-file-name "TAGS" dir)) - tags-file-name tags-table-list erlang-buffer) - (unwind-protect - (progn - (erlang-test-create-erlang-file erlang-file) - (erlang-test-compile-tags erlang-file tags-file) - (setq erlang-buffer (find-file-noselect erlang-file)) - (with-current-buffer erlang-buffer - (setq-local tags-file-name tags-file)) - ;; Setting global tags-file-name is a workaround for - ;; GNU Emacs bug#23164. - (setq tags-file-name tags-file) - (erlang-test-completion-table) - (erlang-test-xref-find-definitions erlang-file erlang-buffer)) - (when (buffer-live-p erlang-buffer) - (kill-buffer erlang-buffer)) - (let ((tags-buffer (find-buffer-visiting tags-file))) - (when (buffer-live-p tags-buffer) - (kill-buffer tags-buffer))) - (when (file-exists-p dir) - (delete-directory dir t))))) + (erlang-file (expand-file-name "erlang_test.erl" dir)) + (tags-file (expand-file-name "TAGS" dir)) + (old-tags-file-name (default-value 'tags-file-name)) + (old-tags-table-list (default-value 'tags-table-list)) + tags-file-name + tags-table-list + tags-table-set-list + erlang-buffer + erlang-mode-hook + prog-mode-hook + erlang-shell-mode-hook + tags-add-tables) + (unwind-protect + (progn + (setq-default tags-file-name nil) + (setq-default tags-table-list nil) + (erlang-test-create-erlang-file erlang-file) + (erlang-test-compile-tags erlang-file tags-file) + (setq erlang-buffer (find-file-noselect erlang-file)) + (with-current-buffer erlang-buffer + (setq-local tags-file-name tags-file)) + ;; Setting global tags-file-name is a workaround for + ;; GNU Emacs bug#23164. + (setq tags-file-name tags-file) + (erlang-test-complete-at-point tags-file) + (erlang-test-completion-table) + (erlang-test-xref-find-definitions erlang-file erlang-buffer)) + (when (buffer-live-p erlang-buffer) + (kill-buffer erlang-buffer)) + (let ((tags-buffer (find-buffer-visiting tags-file))) + (when (buffer-live-p tags-buffer) + (kill-buffer tags-buffer))) + (when (file-exists-p dir) + (delete-directory dir t)) + (setq-default tags-file-name old-tags-file-name) + (setq-default tags-table-list old-tags-table-list)))) (defun erlang-test-create-erlang-file (erlang-file) (with-temp-file erlang-file @@ -116,6 +130,54 @@ concatenated to form an erlang file to test on.") (should (eq expected-line (line-number-at-pos))) (should (= (point-at-bol) (point)))) +(defun erlang-test-complete-at-point (tags-file) + (with-temp-buffer + (erlang-mode) + (setq-local tags-file-name tags-file) + (insert "\nerlang_test:fun") + (erlang-complete-tag) + (should (looking-back "erlang_test:function")) + (insert "\nfun") + (erlang-complete-tag) + (should (looking-back "function")) + (insert "\nerlang_") + (erlang-complete-tag) + (should (looking-back "erlang_test:")))) + + +(ert-deftest erlang-test-compile-options () + (erlang-test-format-opt t + "t") + (erlang-test-format-opt nil + "nil") + (erlang-test-format-opt (cons 1 2) + "{1, 2}") + (erlang-test-format-opt (list 1) + "[1]") + (erlang-test-format-opt (list 1 2) + "[1, 2]") + (erlang-test-format-opt (list 1 2 3) + "[1, 2, 3]") + (erlang-test-format-opt 'symbol + "symbol") + (erlang-test-format-opt "string" + "\"string\"") + (erlang-test-format-opt [] + "{}") + (erlang-test-format-opt [1] + "{1}") + (erlang-test-format-opt [1 2] + "{1, 2}") + (erlang-test-format-opt [1 2 (3 [4 5 6] 7)] + "{1, 2, [3, {4, 5, 6}, 7]}")) + +(defun erlang-test-format-opt (elisp &optional expected-erlang) + (let ((erlang (inferior-erlang-format-opt elisp))) + (message "%s -> %s" elisp erlang) + (when expected-erlang + (should (equal erlang expected-erlang))) + erlang)) + (provide 'erlang-test) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index a2062180f3..a0f9512c15 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -743,6 +743,7 @@ resulting regexp is surrounded by \\_< and \\_>." "bitsize" "bitstring_to_list" "byte_size" + "ceil" "check_old_code" "check_process_code" "date" @@ -753,6 +754,7 @@ resulting regexp is surrounded by \\_< and \\_>." "erase" "error" "exit" + "floor" "float" "float_to_binary" "float_to_list" @@ -1436,8 +1438,6 @@ Other commands: (erlang-skel-init) (when (fboundp 'tempo-use-tag-list) (tempo-use-tag-list 'erlang-tempo-tags)) - (when (boundp 'xref-backend-functions) - (add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t)) (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) (run-hooks 'erlang-new-file-hook))) @@ -1548,9 +1548,7 @@ Other commands: (set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$") (set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'add-log-current-defun-function) - 'erlang-current-defun) - (set (make-local-variable 'find-tag-default-function) - 'erlang-find-tag-for-completion)) + 'erlang-current-defun)) (defun erlang-font-lock-init () "Initialize Font Lock for Erlang mode." @@ -3233,18 +3231,16 @@ With argument, do this that many times." (interactive "p") (or arg (setq arg 1)) (while (and (looking-at "[ \t]*[%\n]") - (zerop (forward-line 1)))) + (zerop (forward-line 1)))) ;; Move to the next clause. (erlang-beginning-of-clause (- arg)) (beginning-of-line);; Just to be sure... (let ((continue t)) (while (and (not (bobp)) continue) (forward-line -1) - (skip-chars-forward " \t") - (if (looking-at "[%\n]") - nil - (end-of-line) - (setq continue nil))))) + (unless (looking-at "[ \t]*[%\n]") + (end-of-line) + (setq continue nil))))) (defun erlang-mark-clause () "Put mark at end of clause, point at beginning." @@ -4352,11 +4348,6 @@ as on the old form `tag'. In the completion list, `module:tag' and `module:' shows up. -Call this function from an appropriate init file, or add it to -Erlang mode hook with the commands: - (add-hook 'erlang-mode-hook 'erlang-tags-init) - (add-hook 'erlang-shell-mode-hook 'erlang-tags-init) - This function only works under Emacs 18 and Emacs 19. Currently, It is not implemented under XEmacs. (Hint: The Emacs 19 etags module works under XEmacs.)" @@ -4367,11 +4358,16 @@ works under XEmacs.)" (setq erlang-tags-installed t)) (t (require 'etags) - ;; Test on a function available in the Emacs 19 version - ;; of tags but not in the XEmacs version. - (when (fboundp 'find-tag-noselect) - (erlang-tags-define-keys (current-local-map)) - (setq erlang-tags-installed t))))) + (set (make-local-variable 'find-tag-default-function) + 'erlang-find-tag-for-completion) + (if (>= emacs-major-version 25) + (add-hook 'xref-backend-functions + #'erlang-etags--xref-backend nil t) + ;; Test on a function available in the Emacs 19 version + ;; of tags but not in the XEmacs version. + (when (fboundp 'find-tag-noselect) + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t)))))) @@ -4775,8 +4771,6 @@ for a tag on the form `module:tag'." ;;; completion-table' containing all normal tags plus tags on the form ;;; `module:tag' and `module:'. -;; PENDING - Should probably make use of the -;; `completion-at-point-functions' hook instead of this advice. (when (and (locate-library "etags") (require 'etags) (fboundp 'etags-tags-completion-table) @@ -4784,11 +4778,7 @@ for a tag on the form `module:tag'." (if (fboundp 'advice-add) ;; Emacs 24.4+ (advice-add 'etags-tags-completion-table :around - (lambda (oldfun) - (if erlang-replace-etags-tags-completion-table - (erlang-etags-tags-completion-table) - (funcall oldfun))) - (list :name 'erlang-replace-tags-table)) + #'erlang-etags-tags-completion-table-advice) ;; Emacs 23.1-24.3 (defadvice etags-tags-completion-table (around erlang-replace-tags-table @@ -4797,6 +4787,11 @@ for a tag on the form `module:tag'." (setq ad-return-value (erlang-etags-tags-completion-table)) ad-do-it)))) +(defun erlang-etags-tags-completion-table-advice (oldfun) + (if erlang-replace-etags-tags-completion-table + (erlang-etags-tags-completion-table) + (funcall oldfun))) + (defun erlang-complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. @@ -4807,8 +4802,7 @@ about Erlang modules." (condition-case nil (require 'etags) (error nil)) - (cond ((and erlang-tags-installed - (fboundp 'etags-tags-completion-table) + (cond ((and (fboundp 'etags-tags-completion-table) (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ (let ((erlang-replace-etags-tags-completion-table t)) (complete-tag))) @@ -5213,19 +5207,10 @@ The following special commands are available: (setq comint-input-ignoredups t) (setq comint-scroll-show-maximum-output t) (setq comint-scroll-to-bottom-on-output t) - ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If - ;; the call fails, just call the normal `add-hook'. - (condition-case nil - (progn - (add-hook 'comint-output-filter-functions - 'inferior-erlang-strip-delete nil t) - (add-hook 'comint-output-filter-functions - 'inferior-erlang-strip-ctrl-m nil t)) - (error - (funcall (symbol-function 'make-local-hook) - 'comint-output-filter-functions) ; obsolete as of Emacs 21.1 - (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete) - (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m))) + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-delete nil t) + (add-hook 'comint-output-filter-functions + 'inferior-erlang-strip-ctrl-m nil t) ;; Some older versions of comint don't have an input ring. (if (fboundp 'comint-read-input-ring) (progn @@ -5251,6 +5236,7 @@ The following special commands are available: (define-key map [menu-bar compilation] (cons "Errors" compilation-menu-map))) map))))) + (erlang-tags-init) (run-hooks 'erlang-shell-mode-hook)) @@ -5730,31 +5716,29 @@ unless the optional NO-DISPLAY is non-nil." (defun inferior-erlang-format-comma-opts (opts) (if (null opts) "" - (concat ", " (inferior-erlang-format-opts opts)))) - -(defun inferior-erlang-format-opts (opts) - (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt - opts) - ", ") - "]")) + (concat ", " (inferior-erlang-format-opt opts)))) (defun inferior-erlang-format-opt (opt) (cond ((stringp opt) (concat "\"" opt "\"")) - ((atom opt) (format "%s" opt)) - ((consp opt) (concat "{" (inferior-erlang-string-join - (mapcar 'inferior-erlang-format-opt - (list (car opt) (cdr opt))) - ", ") - "}")) - (t (error (format "Unexpected opt %s" opt))))) - -(defun inferior-erlang-string-join (strs sep) - (let ((result (or (car strs) ""))) - (setq strs (cdr strs)) - (while strs - (setq result (concat result sep (car strs))) - (setq strs (cdr strs))) - result)) + ((vectorp opt) (inferior-erlang-tuple (append opt nil))) + ((atom opt) (format "%s" opt)) + ((consp opt) (if (listp (cdr opt)) + (inferior-erlang-list opt) + (inferior-erlang-tuple (list (car opt) (cdr opt))))) + (t (error "Unexpected erlang compile option %s" opt)))) + +(defun inferior-erlang-tuple (opts) + (concat "{" (mapconcat 'inferior-erlang-format-opt + opts + ", ") + "}")) + +(defun inferior-erlang-list (opts) + (concat "[" (mapconcat 'inferior-erlang-format-opt + opts + ", ") + "]")) + (defun erlang-local-buffer-file-name () ;; When editing a file remotely via tramp, |