From 4c26733f60877130c49bd79fff5fb1e02cff3b1c Mon Sep 17 00:00:00 2001 From: Simeon Simeonov Date: Wed, 22 May 2019 08:31:21 +0200 Subject: Update php-mode and yasnippet --- .emacs.d/lisp/php-face.el | 142 ++++++++++++ .emacs.d/lisp/php-mode.el | 462 ++++++------------------------------- .emacs.d/lisp/php-project.el | 2 +- .emacs.d/lisp/php.el | 207 +++++++++++++++++ .emacs.d/lisp/yasnippet.el | 536 ++++++++++++++++++++++++++----------------- 5 files changed, 741 insertions(+), 608 deletions(-) create mode 100644 .emacs.d/lisp/php-face.el create mode 100644 .emacs.d/lisp/php.el diff --git a/.emacs.d/lisp/php-face.el b/.emacs.d/lisp/php-face.el new file mode 100644 index 0000000..e01d517 --- /dev/null +++ b/.emacs.d/lisp/php-face.el @@ -0,0 +1,142 @@ +;;; php-face.el --- Face definitions for PHP script -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Friends of Emacs-PHP development + +;; Author: USAMI Kenta +;; Created: 5 May 2019 +;; Version: 1.21.2 +;; Keywords: faces, php +;; Homepage: https://github.com/emacs-php/php-mode +;; Package-Requires: ((emacs "24.3")) +;; License: GPL-3.0-or-later + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Face definitions for PHP script. + +;;; Code: + +;;;###autoload +(defgroup php-faces nil + "Faces used in PHP Mode" + :tag "PHP Faces" + :group 'php-mode + :group 'faces) + +(defface php-string '((t (:inherit font-lock-string-face))) + "PHP Mode face used to highlight string literals." + :group 'php-faces) + +(defface php-keyword '((t (:inherit font-lock-keyword-face))) + "PHP Mode face used to highlight keywords." + :group 'php-faces) + +(defface php-builtin '((t (:inherit font-lock-builtin-face))) + "PHP Mode face used to highlight builtins." + :group 'php-faces) + +(defface php-function-name '((t (:inherit font-lock-function-name-face))) + "PHP Mode face used to highlight function names." + :group 'php-faces) + +(defface php-function-call '((t (:inherit default))) + "PHP Mode face used to highlight function names in calles." + :group 'php-faces) + +(defface php-method-call '((t (:inherit php-function-call))) + "PHP Mode face used to highlight method names in calles." + :group 'php-faces) + +(defface php-static-method-call '((t (:inherit php-method-call))) + "PHP Mode face used to highlight static method names in calles." + :group 'php-faces) + +(defface php-variable-name '((t (:inherit font-lock-variable-name-face))) + "PHP Mode face used to highlight variable names." + :group 'php-faces) + +(defface php-property-name '((t (:inherit php-variable-name))) + "PHP Mode face used to highlight property names." + :group 'php-faces) + +(defface php-variable-sigil '((t (:inherit default))) + "PHP Mode face used to highlight variable sigils ($)." + :group 'php-faces) + +(defface php-object-op '((t (:inherit default))) + "PHP Mode face used to object operators (->)." + :group 'php-faces) + +(defface php-paamayim-nekudotayim '((t (:inherit default))) + "PHP Mode face used to highlight \"Paamayim Nekudotayim\" scope resolution operators (::)." + :group 'php-faces) + +(defface php-type '((t (:inherit font-lock-type-face))) + "PHP Mode face used to highlight types." + :group 'php-faces) + +(defface php-constant '((t (:inherit font-lock-constant-face))) + "PHP Mode face used to highlight constants." + :group 'php-faces) + +(defface php-constant-assign '((t (:inherit font-lock-type-face))) + "PHP Mode face used to highlight constant assigning (\"const\" statement)." + :group 'php-faces) + +(defface php-magical-constant '((t (:inherit font-lock-builtin-face))) + "PHP Mode face used to highlight magical constants." + :group 'php-faces) + +(defface php-$this '((t (:inherit php-constant))) + "PHP Mode face used to highlight $this variables." + :group 'php-faces) + +(defface php-$this-sigil '((t (:inherit php-constant))) + "PHP Mode face used to highlight sigils($) of $this variable." + :group 'php-faces) + +(defface php-errorcontrol-op '((t (:inherit font-lock-type-face))) + "PHP Mode face used to highlight errorcontrol operators (@).." + :group 'php-face) + +(defface php-php-tag '((t (:inherit font-lock-preprocessor-face))) + "PHP Mode face used to highlight PHP tags." + :group 'php-faces) + +(defface php-doc-annotation-tag '((t . (:inherit font-lock-constant-face))) + "Face used to highlight annotation tags in doc-comment." + :group 'php-faces) + +(defface php-doc-variable-sigil '((t (:inherit font-lock-variable-name-face))) + "PHP Mode face used to highlight variable sigils($)." + :group 'php-faces) + +(defface php-doc-$this '((t (:inherit php-type))) + "PHP Mode face used to highlight $this variable in doc-comment." + :group 'php-faces) + +(defface php-doc-$this-sigil '((t (:inherit php-type))) + "PHP Mode face used to highlight sigil of $this variable in doc-comment." + :group 'php-faces) + +(defface php-doc-class-name '((t (:inherit php-string))) + "Face used to class names in doc-comment." + :group 'php-faces) + +(define-obsolete-face-alias 'php-annotations-annotation-face 'php-doc-annotation-tag "1.19.0") + +(provide 'php-face) +;;; php-face.el ends here diff --git a/.emacs.d/lisp/php-mode.el b/.emacs.d/lisp/php-mode.el index 8e72fe3..2fa1ab5 100644 --- a/.emacs.d/lisp/php-mode.el +++ b/.emacs.d/lisp/php-mode.el @@ -9,30 +9,28 @@ ;; Maintainer: USAMI Kenta ;; URL: https://github.com/emacs-php/php-mode ;; Keywords: languages php -;; Version: 1.21.0 +;; Version: 1.21.2 ;; Package-Requires: ((emacs "24.3") (cl-lib "0.5")) ;; License: GPL-3.0-or-later -(defconst php-mode-version-number "1.21.0" +(defconst php-mode-version-number "1.21.2" "PHP Mode version number.") -(defconst php-mode-modified "2019-02-28" +(defconst php-mode-modified "2019-05-11" "PHP Mode build date.") -;; This file 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. +;; This program 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. -;; This file is distributed in the hope that it will be useful, +;; This program 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 this file; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301, USA. +;; along with this program. If not, see . ;;; Commentary: @@ -65,6 +63,8 @@ ;;; Code: +(require 'php) +(require 'php-face) (require 'cc-mode) (require 'cc-langs) @@ -80,12 +80,10 @@ (require 'font-lock) (require 'add-log) (require 'custom) -(require 'flymake) (require 'etags) (require 'speedbar) (require 'imenu) (require 'nadvice nil t) -(require 'package) (require 'cl-lib) (require 'mode-local) @@ -93,14 +91,13 @@ (eval-when-compile (require 'regexp-opt) - (autoload 'pkg-info-version-info "pkg-info") (defvar c-vsemi-status-unknown-p) (defvar syntax-propertize-via-font-lock)) ;; Work around emacs bug#18845, cc-mode expects cl to be loaded ;; while php-mode only uses cl-lib (without compatibility aliases) (eval-and-compile - (if (and (= emacs-major-version 24) (>= emacs-minor-version 4)) + (when (and (= emacs-major-version 24) (>= emacs-minor-version 4)) (require 'cl))) ;; Work around https://github.com/emacs-php/php-mode/issues/310. @@ -120,16 +117,10 @@ ;; need it in php-mode, just return nil. nil))) +(autoload 'php-mode-debug "php-mode-debug" + "Display informations useful for debugging PHP Mode." t) ;; Local variables -;;;###autoload -(defgroup php nil - "Language support for PHP." - :tag "PHP" - :group 'languages - :group 'php - :link '(url-link :tag "Official Site" "https://github.com/emacs-php/php-mode") - :link '(url-link :tag "PHP Mode Wiki" "https://github.com/emacs-php/php-mode/wiki")) ;;;###autoload (defgroup php-mode nil @@ -141,11 +132,6 @@ :link '(url-link :tag "Official Site" "https://github.com/emacs-php/php-mode") :link '(url-link :tag "PHP Mode Wiki" "https://github.com/emacs-php/php-mode/wiki")) -(defcustom php-executable (or (executable-find "php") - "/usr/bin/php") - "The location of the PHP executable." - :type 'string) - (define-obsolete-variable-alias 'php-default-face 'php-mode-default-face "1.20.0") (defcustom php-mode-default-face 'default "Default face in `php-mode' buffers." @@ -180,20 +166,11 @@ Turning this on will open it whenever `php-mode' is loaded." :group 'php-mode :type 'boolean) -(defsubst php-in-string-p () - (nth 3 (syntax-ppss))) - -(defsubst php-in-comment-p () - (nth 4 (syntax-ppss))) - -(defsubst php-in-string-or-comment-p () - (nth 8 (syntax-ppss))) - (defun php-mode-extra-constants-create-regexp (kwds) "Create regexp for the list of extra constant keywords KWDS." (concat "[^_$]?\\<\\(" (regexp-opt - (append kwds + (append kwds (when (boundp 'web-mode-extra-php-constants) web-mode-extra-php-constants))) "\\)\\>[^_]?")) @@ -227,67 +204,6 @@ of constants when set." :type '(repeat string) :set 'php-mode-extra-constants-set) -(defun php-create-regexp-for-method (visibility) - "Make a regular expression for methods with the given VISIBILITY. - -VISIBILITY must be a string that names the visibility for a PHP -method, e.g. 'public'. The parameter VISIBILITY can itself also -be a regular expression. - -The regular expression this function returns will check for other -keywords that can appear in method signatures, e.g. 'final' and -'static'. The regular expression will have one capture group -which will be the name of the method." - (concat - ;; Initial space with possible 'abstract' or 'final' keywords - "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?" - ;; 'static' keyword may come either before or after visibility - "\\(?:" visibility "\\(?:\\s-+static\\)?\\|\\(?:static\\s-+\\)?" visibility "\\)\\s-+" - ;; Make sure 'function' comes next with some space after - "function\\s-+" - ;; Capture the name as the first group and the regexp and make sure - ;; by the end we see the opening parenthesis for the parameters. - "\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(")) - -(defun php-create-regexp-for-classlike (type) - "Accepts a `TYPE' of a 'classlike' object as a string, such as -'class' or 'interface', and returns a regexp as a string which -can be used to match against definitions for that classlike." - (concat - ;; First see if 'abstract' or 'final' appear, although really these - ;; are not valid for all values of `type' that the function - ;; accepts. - "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?" - ;; The classlike type - type - ;; Its name, which is the first captured group in the regexp. We - ;; allow backslashes in the name to handle namespaces, but again - ;; this is not necessarily correct for all values of `type'. - "\\s-+\\(\\(?:\\sw\\|\\\\\\|\\s_\\)+\\)")) - -(defvar php-imenu-generic-expression - `(("Namespaces" - ,(php-create-regexp-for-classlike "namespace") 1) - ("Classes" - ,(php-create-regexp-for-classlike "class") 1) - ("Interfaces" - ,(php-create-regexp-for-classlike "interface") 1) - ("Traits" - ,(php-create-regexp-for-classlike "trait") 1) - ("All Methods" - ,(php-create-regexp-for-method "\\(?:\\sw\\|\\s_\\)+") 1) - ("Private Methods" - ,(php-create-regexp-for-method "private") 1) - ("Protected Methods" - ,(php-create-regexp-for-method "protected") 1) - ("Public Methods" - ,(php-create-regexp-for-method "public") 1) - ("Anonymous Functions" - "\\<\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*=\\s-*function\\s-*(" 1) - ("Named Functions" - "^\\s-*function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)) - "Imenu generic expression for PHP Mode. See `imenu-generic-expression'.") - (define-obsolete-variable-alias 'php-do-not-use-semantic-imenu 'php-mode-do-not-use-semantic-imenu "1.20.0") (defcustom php-mode-do-not-use-semantic-imenu t "Customize `imenu-create-index-function' for `php-mode'. @@ -299,34 +215,6 @@ parent. Set this variable to t if you want to use enabled." :type 'boolean) -(defcustom php-site-url "https://secure.php.net/" - "Default PHP.net site URL. - -The URL to use open PHP manual and search word. -You can find a mirror site closer to you." - :type 'string - :link '(url-link :tag "List of Mirror Sites" "https://secure.php.net/mirrors.php")) - -(defcustom php-manual-url 'en - "URL at which to find PHP manual. -You can replace \"en\" with your ISO language code." - :type '(choice (const :tag "English" 'en) - (const :tag "Brazilian Portuguese" 'pt_BR) - (const :tag "Chinese (Simplified)" 'zh) - (const :tag "French" 'fr) - (const :tag "German" 'de) - (const :tag "Japanese" 'ja) - (const :tag "Romanian" 'ro) - (const :tag "Russian" 'ru) - (const :tag "Spanish" 'es) - (const :tag "Turkish" 'tr) - (string :tag "PHP manual URL"))) - -(defcustom php-search-url nil - "URL at which to search for documentation on a word." - :type '(choice (string :tag "URL to search PHP documentation") - (const :tag "Use `php-site-url' variable" nil))) - (defcustom php-completion-file "" "Path to the file which contains the function names known to PHP." :type 'string) @@ -524,6 +412,10 @@ In that case set to `NIL'." (left-assoc "\\" "::" "->") (prefix "\\" "::"))) +(c-lang-defconst c-operators + php (delete '(postfix-if-paren "<" ">") + (c-lang-const c-operators))) + ;; Allow '\' when scanning from open brace back to defining ;; construct like class (c-lang-defconst c-block-prefix-disallowed-chars @@ -580,40 +472,35 @@ PHP does not have an \"enum\"-like keyword." php '("implements" "extends")) (c-lang-defconst c-type-list-kwds - php '("new" "use" "implements" "extends" "namespace" "instanceof" "insteadof")) + php '("@new" ;; @new is *NOT* language construct, it's workaround for coloring. + "new" "use" "implements" "extends" "namespace" "instanceof" "insteadof")) (c-lang-defconst c-ref-list-kwds php nil) (c-lang-defconst c-block-stmt-2-kwds - php (append '("elseif" "foreach" "declare") - (remove "synchronized" (c-lang-const c-block-stmt-2-kwds)))) + php '("catch" "declare" "elseif" "for" "foreach" "if" "switch" "while")) (c-lang-defconst c-simple-stmt-kwds - php (append '("include" "include_once" "require" "require_once" - "echo" "print" "die" "exit") - (c-lang-const c-simple-stmt-kwds))) + php '("break" "continue" "die" "echo" "exit" "goto" "return" "throw" + "include" "include_once" "print" "require" "require_once")) (c-lang-defconst c-constant-kwds - php '("true" - "false" - "null")) + php '("true" "false" "null")) (c-lang-defconst c-lambda-kwds - php '("function" - "use")) + php '("function" "use")) (c-lang-defconst c-other-block-decl-kwds php '("namespace")) (c-lang-defconst c-other-kwds "Keywords not accounted for by any other `*-kwds' language constant." - php '( + php + '( "__halt_compiler" "and" "array" - "callable" - "iterable" "as" "break" "catch" @@ -627,6 +514,7 @@ PHP does not have an \"enum\"-like keyword." "endswitch" "endwhile" "eval" + "fn" ;; NOT c-lambda-kwds "global" "isset" "list" @@ -656,6 +544,12 @@ PHP does not have an \"enum\"-like keyword." (c-lang-defconst c-recognize-<>-arglists php nil) +(c-lang-defconst c-<>-type-kwds + php nil) + +(c-lang-defconst c-inside-<>-type-kwds + php nil) + (c-lang-defconst c-enums-contain-decls php nil) @@ -679,6 +573,13 @@ might be to handle switch and goto labels differently." php (cl-remove-if (lambda (elm) (and (listp elm) (equal (car elm) "\\s|"))) (c-lang-const c-basic-matchers-before php))) +(c-lang-defconst c-basic-matchers-after + php (cl-remove-if (lambda (elm) (and (listp elm) (memq 'c-annotation-face elm))) + (c-lang-const c-basic-matchers-after php))) + +(c-lang-defconst c-opt-<>-sexp-key + php nil) + (defun php-lineup-cascaded-calls (langelem) "Line up chained methods using `c-lineup-cascaded-calls', but only if the setting is enabled" @@ -788,10 +689,10 @@ but only if the setting is enabled" "Move to the beginning of the ARGth PHP function from point. Implements PHP version of `beginning-of-defun-function'." (interactive "p") - (let ((arg (or arg 1))) + (let (found-p (arg (or arg 1))) (while (> arg 0) - (re-search-backward php-beginning-of-defun-regexp - nil 'noerror) + (setq found-p (re-search-backward php-beginning-of-defun-regexp + nil 'noerror)) (setq arg (1- arg))) (while (< arg 0) (end-of-line 1) @@ -800,9 +701,10 @@ Implements PHP version of `beginning-of-defun-function'." (forward-list 2) (forward-line 1) (if (eq opoint (point)) - (re-search-forward php-beginning-of-defun-regexp - nil 'noerror)) - (setq arg (1+ arg)))))) + (setq found-p (re-search-forward php-beginning-of-defun-regexp + nil 'noerror))) + (setq arg (1+ arg)))) + (not (null found-p)))) (defun php-end-of-defun (&optional arg) "Move the end of the ARGth PHP function from point. @@ -988,7 +890,7 @@ this ^ lineup" "Build a regular expression for the end of a heredoc started by the string HEREDOC-START." ;; Extract just the identifier without <<< and quotes. (string-match "\\_<.+?\\_>" heredoc-start) - (concat "^\\(" (match-string 0 heredoc-start) "\\)\\W")) + (concat "^\\s-*\\(" (match-string 0 heredoc-start) "\\)\\W")) (defun php-syntax-propertize-function (start end) "Apply propertize rules from START to END." @@ -1000,12 +902,7 @@ this ^ lineup" (while (re-search-forward "['\"]" end t) (when (php-in-comment-p) (c-put-char-property (match-beginning 0) - 'syntax-table (string-to-syntax "_")))) - (funcall - (syntax-propertize-rules - ("\\(\"\\)\\(\\\\.\\|[^\"\n\\]\\)*\\(\"\\)" (1 "\"") (3 "\"")) - ("\\('\\)\\(\\\\.\\|[^'\n\\]\\)*\\('\\)" (1 "\"") (3 "\""))) - start end)) + 'syntax-table (string-to-syntax "_"))))) (defun php-heredoc-syntax () "Mark the boundaries of searched heredoc." @@ -1041,106 +938,6 @@ this ^ lineup" (easy-menu-define php-mode-menu php-mode-map "PHP Mode Commands" (cons "PHP" (c-lang-const c-mode-menu php))) - -;; Faces - -;;;###autoload -(defgroup php-faces nil - "Faces used in PHP Mode" - :tag "PHP Faces" - :group 'php-mode - :group 'faces) - -(defface php-string '((t (:inherit font-lock-string-face))) - "PHP Mode face used to highlight string literals." - :group 'php-faces) - -(defface php-keyword '((t (:inherit font-lock-keyword-face))) - "PHP Mode face used to highlight keywords." - :group 'php-faces) - -(defface php-builtin '((t (:inherit font-lock-builtin-face))) - "PHP Mode face used to highlight builtins." - :group 'php-faces) - -(defface php-function-name '((t (:inherit font-lock-function-name-face))) - "PHP Mode face used to highlight function names." - :group 'php-faces) - -(defface php-function-call '((t (:inherit default))) - "PHP Mode face used to highlight function names in calles." - :group 'php-faces) - -(defface php-method-call '((t (:inherit php-function-call))) - "PHP Mode face used to highlight method names in calles." - :group 'php-faces) - -(defface php-static-method-call '((t (:inherit php-method-call))) - "PHP Mode face used to highlight static method names in calles." - :group 'php-faces) - -(defface php-variable-name '((t (:inherit font-lock-variable-name-face))) - "PHP Mode face used to highlight variable names." - :group 'php-faces) - -(defface php-property-name '((t (:inherit php-variable-name))) - "PHP Mode face used to highlight property names." - :group 'php-faces) - -(defface php-variable-sigil '((t (:inherit default))) - "PHP Mode face used to highlight variable sigils ($)." - :group 'php-faces) - -(defface php-object-op '((t (:inherit default))) - "PHP Mode face used to object operators (->)." - :group 'php-faces) - -(defface php-paamayim-nekudotayim '((t (:inherit default))) - "PHP Mode face used to highlight \"Paamayim Nekudotayim\" scope resolution operators (::)." - :group 'php-faces) - -(defface php-type '((t (:inherit font-lock-type-face))) - "PHP Mode face used to highlight types." - :group 'php-faces) - -(defface php-constant '((t (:inherit font-lock-constant-face))) - "PHP Mode face used to highlight constants." - :group 'php-faces) - -(defface php-$this '((t (:inherit php-constant))) - "PHP Mode face used to highlight $this variables." - :group 'php-faces) - -(defface php-$this-sigil '((t (:inherit php-constant))) - "PHP Mode face used to highlight sigils($) of $this variable." - :group 'php-faces) - -(defface php-php-tag '((t (:inherit font-lock-preprocessor-face))) - "PHP Mode face used to highlight PHP tags." - :group 'php-faces) - -(defface php-doc-annotation-tag '((t . (:inherit font-lock-constant-face))) - "Face used to highlight annotation tags in doc-comment." - :group 'php-faces) - -(defface php-doc-variable-sigil '((t (:inherit font-lock-variable-name-face))) - "PHP Mode face used to highlight variable sigils($)." - :group 'php-faces) - -(defface php-doc-$this '((t (:inherit php-type))) - "PHP Mode face used to highlight $this variable in doc-comment." - :group 'php-faces) - -(defface php-doc-$this-sigil '((t (:inherit php-type))) - "PHP Mode face used to highlight sigil of $this variable in doc-comment." - :group 'php-faces) - -(defface php-doc-class-name '((t (:inherit php-string))) - "Face used to class names in doc-comment." - :group 'php-faces) - -(define-obsolete-face-alias 'php-annotations-annotation-face 'php-doc-annotation-tag "1.19.0") - (defvar-local php-mode--delayed-set-style nil) (defun php-set-style (stylename &optional dont-override) @@ -1199,70 +996,6 @@ After setting the stylevars run hooks according to STYLENAME (prog1 (php-set-style (symbol-name coding-style)) (remove-hook 'hack-local-variables-hook #'php-mode-set-style-delay))))) -(defun php-mode-debug--buffer (&optional command &rest args) - "Return buffer for php-mode-debug, and execute `COMMAND' with `ARGS'." - (with-current-buffer (get-buffer-create "*PHP Mode DEBUG*") - (cl-case command - (init (erase-buffer) - (goto-address-mode)) - (top (goto-char (point-min))) - (insert (goto-char (point-max)) - (apply #'insert args))) - (current-buffer))) - -(defun php-mode-debug--message (format-string &rest args) - "Write message `FORMAT-STRING' and `ARGS' to debug buffer, like `message'." - (declare (indent 1)) - (php-mode-debug--buffer 'insert (apply #'format format-string args) "\n")) - -(declare-function custom-group-members "cus-edit" (symbol groups-only)) - -(defun php-mode-debug () - "Display informations useful for debugging PHP Mode." - (interactive) - (require 'cus-edit) - (require 'pkg-info nil t) - (php-mode-debug--buffer 'init) - (php-mode-debug--message "Feel free to report on GitHub what you noticed!") - (php-mode-debug--message "https://github.com/emacs-php/php-mode/issues/new") - (php-mode-debug--message "") - (php-mode-debug--message "Pasting the following information on the issue will help us to investigate the cause.") - (php-mode-debug--message "```") - (php-mode-debug--message "--- PHP-MODE DEBUG BEGIN ---") - (php-mode-debug--message "versions: %s; %s" (emacs-version) (php-mode-version)) - (php-mode-debug--message "package-version: %s" - (if (fboundp 'pkg-info) - (pkg-info-version-info 'php-mode) - (let ((pkg (and (boundp 'package-alist) - (cadr (assq 'php-mode package-alist))))) - (when (and pkg (member (package-desc-status pkg) '("unsigned" "dependency"))) - (package-version-join (package-desc-version pkg)))))) - - (php-mode-debug--message "major-mode: %s" major-mode) - (php-mode-debug--message "minor-modes: %s" - (cl-loop for s in minor-mode-list - unless (string-match-p "global" (symbol-name s)) - if (and (boundp s) (symbol-value s)) - collect s)) - (php-mode-debug--message "variables: %s" - (cl-loop for v in '(indent-tabs-mode tab-width) - collect (list v (symbol-value v)))) - (php-mode-debug--message "custom variables: %s" - (cl-loop for (v type) in (custom-group-members 'php nil) - if (eq type 'custom-variable) - collect (list v (symbol-value v)))) - (php-mode-debug--message "c-indentation-style: %s" c-indentation-style) - (php-mode-debug--message "c-style-variables: %s" - (cl-loop for v in c-style-variables - unless (memq v '(c-doc-comment-style c-offsets-alist)) - collect (list v (symbol-value v)))) - (php-mode-debug--message "c-doc-comment-style: %s" c-doc-comment-style) - (php-mode-debug--message "c-offsets-alist: %s" c-offsets-alist) - (php-mode-debug--message "--- PHP-MODE DEBUG END ---") - (php-mode-debug--message "```\n") - (php-mode-debug--message "Thank you!") - (pop-to-buffer (php-mode-debug--buffer 'top))) - ;;;###autoload (define-derived-mode php-mode c-mode "PHP" "Major mode for editing PHP code. @@ -1657,21 +1390,16 @@ a completion list." ;; Highlight variables, e.g. 'var' in '$var' and '$obj->var', but ;; not in $obj->var() ("\\(->\\)\\(\\sw+\\)\\s-*(" (1 'php-object-op) (2 'php-method-call)) + ("\\<\\(const\\)\\s-+\\(\\_<.+?\\_>\\)" (1 'php-keyword) (2 'php-constant-assign)) ;; Highlight special variables - ("\\(\\$\\)\\(this\\|that\\)\\_>" (1 'php-$this-sigil) (2 'php-$this)) - ("\\(\\$\\)\\([a-zA-Z0-9_]+\\)" (1 'php-variable-sigil) (2 'php-variable-name)) + ("\\(\\$\\)\\(this\\)\\>" (1 'php-$this-sigil) (2 'php-$this)) + ("\\(\\$+\\)\\(\\sw+\\)" (1 'php-variable-sigil) (2 'php-variable-name)) ("\\(->\\)\\([a-zA-Z0-9_]+\\)" (1 'php-object-op) (2 'php-property-name)) ;; Highlight function/method names ("\\" 1 'php-constant) @@ -1756,34 +1490,12 @@ a completion list." (defvar php-font-lock-keywords php-font-lock-keywords-3 "Default expressions to highlight in PHP Mode.") -;;; Provide support for Flymake so that users can see warnings and -;;; errors in real-time as they write code. - -(defun php-flymake-php-init () - "PHP specific init-cleanup routines. - -This is an alternative function of `flymake-php-init'. -Look at the `php-executable' variable instead of the constant \"php\" command." - (let* ((temp-file - (funcall - (eval-when-compile - (if (fboundp 'flymake-proc-init-create-temp-buffer-copy) - 'flymake-proc-init-create-temp-buffer-copy - 'flymake-init-create-temp-buffer-copy)) - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list php-executable (list "-f" local-file "-l")))) - -(add-to-list 'flymake-allowed-file-name-masks - '("\\.php[345s]?\\'" - php-flymake-php-init - flymake-simple-cleanup - flymake-get-real-file-name)) - -(add-to-list 'flymake-err-line-patterns - '("\\(Parse\\|Fatal\\) error: \\(.*?\\) in \\(.*?\\) on line \\([0-9]+\\)" 3 4 nil 2)) +(add-to-list + (eval-when-compile + (if (boundp 'flymake-proc-allowed-file-name-masks) + 'flymake-proc-allowed-file-name-masks + 'flymake-allowed-file-name-masks)) + '("\\.php[345s]?\\'" php-flymake-php-init)) (defun php-send-region (start end) @@ -1836,46 +1548,6 @@ The output will appear in the buffer *PHP*." (ad-activate 'fixup-whitespace) - -(defcustom php-class-suffix-when-insert "::" - "Suffix for inserted class." - :group 'php - :type 'string) - -(defcustom php-namespace-suffix-when-insert "\\" - "Suffix for inserted namespace." - :group 'php - :type 'string) - -(defvar php--re-namespace-pattern - (php-create-regexp-for-classlike "namespace")) - -(defvar php--re-classlike-pattern - (php-create-regexp-for-classlike (regexp-opt '("class" "interface" "trait")))) - -(defun php-get-current-element (re-pattern) - "Return backward matched element by RE-PATTERN." - (save-excursion - (when (re-search-backward re-pattern nil t) - (match-string-no-properties 1)))) - -;;;###autoload -(defun php-current-class () - "Insert current class name if cursor in class context." - (interactive) - (let ((matched (php-get-current-element php--re-classlike-pattern))) - (when matched - (insert (concat matched php-class-suffix-when-insert))))) - -;;;###autoload -(defun php-current-namespace () - "Insert current namespace if cursor in namespace context." - (interactive) - (let ((matched (php-get-current-element php--re-namespace-pattern))) - (when matched - (insert (concat matched php-namespace-suffix-when-insert))))) - - ;;;###autoload (add-to-list 'auto-mode-alist (cons diff --git a/.emacs.d/lisp/php-project.el b/.emacs.d/lisp/php-project.el index a2aa253..e12d83a 100644 --- a/.emacs.d/lisp/php-project.el +++ b/.emacs.d/lisp/php-project.el @@ -5,7 +5,7 @@ ;; Author: USAMI Kenta ;; Keywords: tools, files ;; URL: https://github.com/emacs-php/php-mode -;; Version: 1.21.0 +;; Version: 1.21.2 ;; Package-Requires: ((emacs "24.3") (cl-lib "0.5")) ;; License: GPL-3.0-or-later diff --git a/.emacs.d/lisp/php.el b/.emacs.d/lisp/php.el new file mode 100644 index 0000000..db9e46d --- /dev/null +++ b/.emacs.d/lisp/php.el @@ -0,0 +1,207 @@ +;;; php.el --- PHP support for friends -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Friends of Emacs-PHP development + +;; Author: USAMI Kenta +;; Created: 5 Dec 2018 +;; Version: 1.21.2 +;; Keywords: languages, php +;; Homepage: https://github.com/emacs-php/php-mode +;; Package-Requires: ((emacs "24.3") (cl-lib "0.5")) +;; License: GPL-3.0-or-later + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; This file provides common variable and functions for PHP packages. + +;;; Code: +(require 'flymake) + +;;;###autoload +(defgroup php nil + "Language support for PHP." + :tag "PHP" + :group 'languages + :link '(url-link :tag "Official Site" "https://github.com/emacs-php/php-mode") + :link '(url-link :tag "PHP Mode Wiki" "https://github.com/emacs-php/php-mode/wiki")) + +(defcustom php-executable (or (executable-find "php") "/usr/bin/php") + "The location of the PHP executable." + :type 'string) + +(defcustom php-site-url "https://php.net/" + "Default PHP.net site URL. + +The URL to use open PHP manual and search word." + :type 'string) + +(defcustom php-manual-url 'en + "URL at which to find PHP manual. +You can replace \"en\" with your ISO language code." + :type '(choice (const :tag "English" 'en) + (const :tag "Brazilian Portuguese" 'pt_BR) + (const :tag "Chinese (Simplified)" 'zh) + (const :tag "French" 'fr) + (const :tag "German" 'de) + (const :tag "Japanese" 'ja) + (const :tag "Romanian" 'ro) + (const :tag "Russian" 'ru) + (const :tag "Spanish" 'es) + (const :tag "Turkish" 'tr) + (string :tag "PHP manual URL"))) + +(defcustom php-search-url nil + "URL at which to search for documentation on a word." + :group 'php + :type '(choice (string :tag "URL to search PHP documentation") + (const :tag "Use `php-site-url' variable" nil))) + +(defcustom php-class-suffix-when-insert "::" + "Suffix for inserted class." + :group 'php + :type 'string) + +(defcustom php-namespace-suffix-when-insert "\\" + "Suffix for inserted namespace." + :group 'php + :type 'string) + +;;; PHP Keywords +(defconst php-magical-constants + (list "__LINE__" "__FILE__" "__FUNCTION__" "__CLASS__" "__TRAIT__" "__METHOD__" "__NAMESPACE__") + "Magical keyword that is expanded at compile time. + +These are different from \"constants\" in strict terms. +see https://www.php.net/manual/language.constants.predefined.php") + +;;; Utillity for locate language construction +(defsubst php-in-string-p () + "Return non-nil if inside a string. +it is the character that will terminate the string, or t if the string should be terminated by a generic string delimiter." + (nth 3 (syntax-ppss))) + +(defsubst php-in-comment-p () + "Return nil if outside a comment, t if inside a non-nestable comment, else an integer (the current comment nesting)." + (nth 4 (syntax-ppss))) + +(defsubst php-in-string-or-comment-p () + "Return character address of start of comment or string; nil if not in one." + (nth 8 (syntax-ppss))) + +(defun php-create-regexp-for-method (visibility) + "Make a regular expression for methods with the given VISIBILITY. + +VISIBILITY must be a string that names the visibility for a PHP +method, e.g. 'public'. The parameter VISIBILITY can itself also +be a regular expression. + +The regular expression this function returns will check for other +keywords that can appear in method signatures, e.g. 'final' and +'static'. The regular expression will have one capture group +which will be the name of the method." + (concat + ;; Initial space with possible 'abstract' or 'final' keywords + "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?" + ;; 'static' keyword may come either before or after visibility + "\\(?:" visibility "\\(?:\\s-+static\\)?\\|\\(?:static\\s-+\\)?" visibility "\\)\\s-+" + ;; Make sure 'function' comes next with some space after + "function\\s-+" + ;; Capture the name as the first group and the regexp and make sure + ;; by the end we see the opening parenthesis for the parameters. + "\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(")) + +(defun php-create-regexp-for-classlike (type) + "Accepts a `TYPE' of a 'classlike' object as a string, such as +'class' or 'interface', and returns a regexp as a string which +can be used to match against definitions for that classlike." + (concat + ;; First see if 'abstract' or 'final' appear, although really these + ;; are not valid for all values of `type' that the function + ;; accepts. + "^\\s-*\\(?:\\(?:abstract\\|final\\)\\s-+\\)?" + ;; The classlike type + type + ;; Its name, which is the first captured group in the regexp. We + ;; allow backslashes in the name to handle namespaces, but again + ;; this is not necessarily correct for all values of `type'. + "\\s-+\\(\\(?:\\sw\\|\\\\\\|\\s_\\)+\\)")) + +(defvar php-imenu-generic-expression + `(("Namespaces" + ,(php-create-regexp-for-classlike "namespace") 1) + ("Classes" + ,(php-create-regexp-for-classlike "class") 1) + ("Interfaces" + ,(php-create-regexp-for-classlike "interface") 1) + ("Traits" + ,(php-create-regexp-for-classlike "trait") 1) + ("All Methods" + ,(php-create-regexp-for-method "\\(?:\\sw\\|\\s_\\)+") 1) + ("Private Methods" + ,(php-create-regexp-for-method "private") 1) + ("Protected Methods" + ,(php-create-regexp-for-method "protected") 1) + ("Public Methods" + ,(php-create-regexp-for-method "public") 1) + ("Anonymous Functions" + "\\<\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*=\\s-*function\\s-*(" 1) + ("Named Functions" + "^\\s-*function\\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" 1)) + "Imenu generic expression for PHP Mode. See `imenu-generic-expression'.") + +(defvar php--re-namespace-pattern + (php-create-regexp-for-classlike "namespace")) + +(defvar php--re-classlike-pattern + (php-create-regexp-for-classlike (regexp-opt '("class" "interface" "trait")))) + +(defun php-get-current-element (re-pattern) + "Return backward matched element by RE-PATTERN." + (save-excursion + (when (re-search-backward re-pattern nil t) + (match-string-no-properties 1)))) + +;;; Provide support for Flymake so that users can see warnings and +;;; errors in real-time as they write code. +(defun php-flymake-php-init () + "PHP specific init-cleanup routines. + +This is an alternative function of `flymake-php-init'. +Look at the `php-executable' variable instead of the constant \"php\" command." + (let* ((init (funcall (eval-when-compile + (if (fboundp 'flymake-proc-php-init) + 'flymake-proc-php-init + 'flymake-php-init))))) + (list php-executable (cdr init)))) + +;;;###autoload +(defun php-current-class () + "Insert current class name if cursor in class context." + (interactive) + (let ((matched (php-get-current-element php--re-classlike-pattern))) + (when matched + (insert (concat matched php-class-suffix-when-insert))))) + +;;;###autoload +(defun php-current-namespace () + "Insert current namespace if cursor in namespace context." + (interactive) + (let ((matched (php-get-current-element php--re-namespace-pattern))) + (when matched + (insert (concat matched php-namespace-suffix-when-insert))))) + +(provide 'php) +;;; php.el ends here diff --git a/.emacs.d/lisp/yasnippet.el b/.emacs.d/lisp/yasnippet.el index 065e709..9951940 100644 --- a/.emacs.d/lisp/yasnippet.el +++ b/.emacs.d/lisp/yasnippet.el @@ -413,15 +413,25 @@ This can be used as a key definition in keymaps to bind a key to `yas-clear-field' only when at the beginning of an unmodified snippet field.") -(defvar yas-keymap (let ((map (make-sparse-keymap))) - (define-key map [(tab)] 'yas-next-field-or-maybe-expand) - (define-key map (kbd "TAB") 'yas-next-field-or-maybe-expand) - (define-key map [(shift tab)] 'yas-prev-field) - (define-key map [backtab] 'yas-prev-field) - (define-key map (kbd "C-g") 'yas-abort-snippet) - (define-key map (kbd "C-d") yas-maybe-skip-and-clear-field) - (define-key map (kbd "DEL") yas-maybe-clear-field) - map) +(defun yas-filtered-definition (def) + "Return a condition key definition. +The condition will respect the value of `yas-keymap-disable-hook'." + `(menu-item "" ,def + :filter ,(lambda (cmd) (unless (run-hook-with-args-until-success + 'yas-keymap-disable-hook) + cmd)))) + +(defvar yas-keymap + (let ((map (make-sparse-keymap))) + (define-key map [(tab)] (yas-filtered-definition 'yas-next-field-or-maybe-expand)) + (define-key map (kbd "TAB") (yas-filtered-definition 'yas-next-field-or-maybe-expand)) + (define-key map [(shift tab)] (yas-filtered-definition 'yas-prev-field)) + (define-key map [backtab] (yas-filtered-definition 'yas-prev-field)) + (define-key map (kbd "C-g") (yas-filtered-definition 'yas-abort-snippet)) + ;; Yes, filters can be chained! + (define-key map (kbd "C-d") (yas-filtered-definition yas-maybe-skip-and-clear-field)) + (define-key map (kbd "DEL") (yas-filtered-definition yas-maybe-clear-field)) + map) "The active keymap while a snippet expansion is in progress.") (defvar yas-key-syntaxes (list #'yas-try-key-from-whitespace @@ -481,10 +491,8 @@ Attention: These hooks are not run when exiting nested/stacked snippet expansion "Hooks to run just before expanding a snippet.") (defconst yas-not-string-or-comment-condition - '(if (and (let ((ppss (syntax-ppss))) - (or (nth 3 ppss) (nth 4 ppss))) - (memq this-command '(yas-expand yas-expand-from-trigger-key - yas-expand-from-keymap))) + '(if (let ((ppss (syntax-ppss))) + (or (nth 3 ppss) (nth 4 ppss))) '(require-snippet-condition . force-in-comment) t) "Disables snippet expansion in strings and comments. @@ -547,12 +555,28 @@ conditions. (const :tag "Disable all snippet expansion" nil) sexp)) +(defcustom yas-keymap-disable-hook nil + "The `yas-keymap' bindings are disabled if any function in this list returns non-nil. +This is useful to control whether snippet navigation bindings +override bindings from other packages (e.g., `company-mode')." + :type 'hook) + (defcustom yas-overlay-priority 100 "Priority to use for yasnippets overlays. This is useful to control whether snippet navigation bindings -override bindings from other packages (e.g., `company-mode')." +override `keymap' overlay property bindings from other packages." :type 'integer) +(defcustom yas-inhibit-overlay-modification-protection nil + "If nil, changing text outside the active field aborts the snippet. +This protection is intended to prevent yasnippet from ending up +in an inconsistent state. However, some packages (e.g., the +company completion package) may trigger this protection when it +is not needed. In that case, setting this variable to non-nil +can be useful." + ;; See also `yas--on-protection-overlay-modification'. + :type 'boolean) + ;;; Internal variables @@ -918,9 +942,12 @@ activate snippets associated with that mode." (remove mode yas--extra-modes))) +(defun yas-temp-buffer-p (&optional buffer) + (eq (aref (buffer-name buffer) 0) ?\s)) + (define-obsolete-variable-alias 'yas-dont-activate 'yas-dont-activate-functions "0.9.2") -(defvar yas-dont-activate-functions (list #'minibufferp) +(defvar yas-dont-activate-functions (list #'minibufferp #'yas-temp-buffer-p) "Special hook to control which buffers `yas-global-mode' affects. Functions are called with no argument, and should return non-nil to prevent `yas-global-mode' from enabling yasnippet in this buffer. @@ -1665,10 +1692,8 @@ Here's a list of currently recognized directives: (let ((where (if (region-active-p) (cons (region-beginning) (region-end)) (cons (point) (point))))) - (yas-expand-snippet (yas--template-content yas--current-template) - (car where) - (cdr where) - (yas--template-expand-env yas--current-template))))))) + (yas-expand-snippet yas--current-template + (car where) (cdr where))))))) (defun yas--key-from-desc (text) "Return a yasnippet key from a description string TEXT." @@ -2345,6 +2370,10 @@ object satisfying `yas--field-p' to restrict the expansion to." (yas--fallback)))) (defun yas--maybe-expand-from-keymap-filter (cmd) + "Check whether a snippet may be expanded. +If there are expandable snippets, return CMD (this is useful for +conditional keybindings) or the list of expandable snippet +template objects if CMD is nil (this is useful as a more general predicate)." (let* ((yas--condition-cache-timestamp (current-time)) (vec (cl-subseq (this-command-keys-vector) (if current-prefix-arg @@ -2369,14 +2398,12 @@ object satisfying `yas--field-p' to restrict the expansion to." Prompt the user if TEMPLATES has more than one element, else expand immediately. Common gateway for `yas-expand-from-trigger-key' and `yas-expand-from-keymap'." - (let ((yas--current-template (or (and (cl-rest templates) ;; more than one - (yas--prompt-for-template (mapcar #'cdr templates))) - (cdar templates)))) + (let ((yas--current-template + (or (and (cl-rest templates) ;; more than one + (yas--prompt-for-template (mapcar #'cdr templates))) + (cdar templates)))) (when yas--current-template - (yas-expand-snippet (yas--template-content yas--current-template) - start - end - (yas--template-expand-env yas--current-template))))) + (yas-expand-snippet yas--current-template start end)))) ;; Apropos the trigger key and the fallback binding: ;; @@ -2521,10 +2548,7 @@ by condition." (cons (region-beginning) (region-end)) (cons (point) (point))))) (if yas--current-template - (yas-expand-snippet (yas--template-content yas--current-template) - (car where) - (cdr where) - (yas--template-expand-env yas--current-template)) + (yas-expand-snippet yas--current-template (car where) (cdr where)) (yas--message 1 "No snippets can be inserted here!")))) (defun yas-visit-snippet-file () @@ -2812,17 +2836,17 @@ DEBUG is for debugging the YASnippet engine itself." :name (nth 2 parsed) :expand-env (nth 5 parsed))))) (cond (yas--current-template - (let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template)))) + (let ((buffer-name + (format "*testing snippet: %s*" + (yas--template-name yas--current-template)))) (kill-buffer (get-buffer-create buffer-name)) (switch-to-buffer (get-buffer-create buffer-name)) (setq buffer-undo-list nil) (condition-case nil (funcall test-mode) (error nil)) (yas-minor-mode 1) (setq buffer-read-only nil) - (yas-expand-snippet (yas--template-content yas--current-template) - (point-min) - (point-max) - (yas--template-expand-env yas--current-template)) + (yas-expand-snippet yas--current-template + (point-min) (point-max)) (when (and debug (require 'yasnippet-debug nil t)) (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation) @@ -3502,10 +3526,7 @@ This renders the snippet as ordinary text." (dolist (snippet snippets) (yas--snippet-map-markers (lambda (m) - (goto-char m) - (beginning-of-line) - (prog1 (cons (count-lines (point-min) (point)) - (yas--snapshot-marker-location m)) + (prog1 (cons m (yas--snapshot-line-location m)) (set-marker m nil))) snippet) (let ((ctrl-ov (yas--snapshot-overlay-line-location @@ -3513,23 +3534,27 @@ This renders the snippet as ordinary text." (push (list ctrl-ov dst-base-line snippet) to-move) (delete-overlay (car ctrl-ov)))) (with-current-buffer buf - (setq yas--snippets-to-move (nconc to-move yas--snippets-to-move)))))) + (cl-callf2 nconc to-move yas--snippets-to-move))))) (defun yas--on-buffer-kill () ;; Org mode uses temp buffers for fontification and "native tab", ;; move all the snippets to the original org-mode buffer when it's ;; killed. - (let ((org-marker nil)) + (let ((org-marker nil) + (org-buffer nil)) (when (and yas-minor-mode (or (bound-and-true-p org-edit-src-from-org-mode) (bound-and-true-p org-src--from-org-mode)) (markerp (setq org-marker (or (bound-and-true-p org-edit-src-beg-marker) - (bound-and-true-p org-src--beg-marker))))) + (bound-and-true-p org-src--beg-marker)))) + ;; If the org source buffer is killed before the temp + ;; fontification one, org-marker might point nowhere. + (setq org-buffer (marker-buffer org-marker))) (yas--prepare-snippets-for-move (point-min) (point-max) - (marker-buffer org-marker) org-marker)))) + org-buffer org-marker)))) (add-hook 'kill-buffer-hook #'yas--on-buffer-kill) @@ -3539,18 +3564,16 @@ This renders the snippet as ordinary text." for base-pos = (progn (goto-char (point-min)) (forward-line base-line) (point)) do (yas--snippet-map-markers - (lambda (l-m-r-w) - (goto-char base-pos) - (forward-line (nth 0 l-m-r-w)) - (save-restriction - (narrow-to-region (line-beginning-position) - (line-end-position)) - (yas--restore-marker-location (cdr l-m-r-w))) - (nth 1 l-m-r-w)) + (lambda (saved-location) + (let ((m (pop saved-location))) + (set-marker m (yas--goto-saved-line-location + base-pos saved-location)) + m)) snippet) (goto-char base-pos) - (yas--restore-overlay-location ctrl-ov) - (yas--maybe-move-to-active-field snippet)) + (yas--restore-overlay-line-location base-pos ctrl-ov) + (yas--maybe-move-to-active-field snippet) + (push snippet yas--active-snippets)) (setq yas--snippets-to-move nil)) (defun yas--safely-call-fun (fun) @@ -3755,13 +3778,49 @@ BEG, END and LENGTH like overlay modification hooks." (= beg (yas--field-start field)) ; Insertion at field start? (not (yas--field-modified-p field)))) + +(defun yas--merge-and-drop-dups (list1 list2 cmp key) + ;; `delete-consecutive-dups' + `cl-merge'. + (funcall (if (fboundp 'delete-consecutive-dups) + #'delete-consecutive-dups ; 24.4 + #'delete-dups) + (cl-merge 'list list1 list2 cmp :key key))) + +(defvar yas--before-change-modified-snippets nil) +(make-variable-buffer-local 'yas--before-change-modified-snippets) + +(defun yas--gather-active-snippets (overlay beg end then-delete) + ;; Add active snippets in BEG..END into an OVERLAY keyed entry of + ;; `yas--before-change-modified-snippets'. Return accumulated list. + ;; If THEN-DELETE is non-nil, delete the entry. + (let ((new (yas-active-snippets beg end)) + (old (assq overlay yas--before-change-modified-snippets))) + (prog1 (cond ((and new old) + (setf (cdr old) + (yas--merge-and-drop-dups + (cdr old) new + ;; Sort like `yas-active-snippets'. + #'>= #'yas--snippet-id))) + (new (unless then-delete + ;; Don't add new entry if we're about to + ;; remove it anyway. + (push (cons overlay new) + yas--before-change-modified-snippets)) + new) + (old (cdr old)) + (t nil)) + (when then-delete + (cl-callf2 delq old yas--before-change-modified-snippets))))) + +(defvar yas--todo-snippet-indent nil nil) +(make-variable-buffer-local 'yas--todo-snippet-indent) + (defun yas--on-field-overlay-modification (overlay after? beg end &optional length) "Clears the field and updates mirrors, conditionally. Only clears the field if it hasn't been modified and point is at field start. This hook does nothing if an undo is in progress." - (unless (or (not after?) - yas--inhibit-overlay-hooks + (unless (or yas--inhibit-overlay-hooks (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824. ;; If a single change hits multiple overlays of the same ;; snippet, then we delete the snippet the first time, @@ -3774,28 +3833,52 @@ field start. This hook does nothing if an undo is in progress." (field (overlay-get overlay 'yas--field)) (snippet (overlay-get yas--active-field-overlay 'yas--snippet))) (if (yas--snippet-live-p snippet) - (save-match-data - (yas--letenv (yas--snippet-expand-env snippet) - (when (yas--skip-and-clear-field-p field beg end length) - ;; We delete text starting from the END of insertion. - (yas--skip-and-clear field end)) - (setf (yas--field-modified-p field) t) - ;; Adjust any pending active fields in case of stacked - ;; expansion. - (let ((pfield field) - (psnippets (yas-active-snippets beg end))) - (while (and pfield psnippets) - (let ((psnippet (pop psnippets))) - (cl-assert (memq pfield (yas--snippet-fields psnippet))) - (yas--advance-end-maybe pfield (overlay-end overlay)) - (setq pfield (yas--snippet-previous-active-field psnippet))))) - (save-excursion - (yas--field-update-display field)) - (yas--update-mirrors snippet))) + (if after? + (save-match-data + (yas--letenv (yas--snippet-expand-env snippet) + (when (yas--skip-and-clear-field-p field beg end length) + ;; We delete text starting from the END of insertion. + (yas--skip-and-clear field end)) + (setf (yas--field-modified-p field) t) + ;; Adjust any pending active fields in case of stacked + ;; expansion. + (let ((pfield field) + (psnippets (yas--gather-active-snippets + overlay beg end t))) + (while (and pfield psnippets) + (let ((psnippet (pop psnippets))) + (cl-assert (memq pfield (yas--snippet-fields psnippet))) + (yas--advance-end-maybe pfield (overlay-end overlay)) + (setq pfield (yas--snippet-previous-active-field psnippet))))) + ;; Update fields now, but delay auto indentation until + ;; post-command. We don't want to run indentation on + ;; the intermediate state where field text might be + ;; removed (and hence the field could be deleted along + ;; with leading indentation). + (let ((yas-indent-line nil)) + (save-excursion + (yas--field-update-display field)) + (yas--update-mirrors snippet)) + (unless (or (not (eq yas-indent-line 'auto)) + (memq snippet yas--todo-snippet-indent)) + (push snippet yas--todo-snippet-indent)))) + ;; Remember active snippets to use for after the change. + (yas--gather-active-snippets overlay beg end nil)) (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!") (delete-overlay overlay))))) +(defun yas--do-todo-snippet-indent () + ;; Do pending indentation of snippet fields, called from + ;; `yas--post-command-handler'. + (when yas--todo-snippet-indent + (save-excursion + (cl-loop for snippet in yas--todo-snippet-indent + do (yas--indent-mirrors-of-snippet + snippet (yas--snippet-field-mirrors snippet))) + (setq yas--todo-snippet-indent nil)))) + (defun yas--auto-fill () + ;; Preserve snippet markers during auto-fill. (let* ((orig-point (point)) (end (progn (forward-paragraph) (point))) (beg (progn (backward-paragraph) (point))) @@ -3805,57 +3888,59 @@ field start. This hook does nothing if an undo is in progress." (dolist (snippet snippets) (dolist (m (yas--collect-snippet-markers snippet)) (when (and (<= beg m) (<= m end)) - (push (yas--snapshot-marker-location m beg end) remarkers))) + (push (cons m (yas--snapshot-location m beg end)) remarkers))) (push (yas--snapshot-overlay-location (yas--snippet-control-overlay snippet) beg end) reoverlays)) (goto-char orig-point) (let ((yas--inhibit-overlay-hooks t)) - (if (null yas--original-auto-fill-function) - ;; Try to get more info on #873/919. - (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) - (fill-fun-values `((t ,(default-value 'auto-fill-function)))) - ;; Listing 2 buffers with the same value is enough - (print-length 3)) - (save-current-buffer - (dolist (buf (let ((bufs (buffer-list))) - ;; List the current buffer first. - (setq bufs (cons (current-buffer) - (remq (current-buffer) bufs))))) - (set-buffer buf) - (let* ((yf-cell (assq yas--original-auto-fill-function - yas--fill-fun-values)) - (af-cell (assq auto-fill-function fill-fun-values))) - (when (local-variable-p 'yas--original-auto-fill-function) - (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) - (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) - (when (local-variable-p 'auto-fill-function) - (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) - (push (list auto-fill-function buf) fill-fun-values)))))) - (lwarn '(yasnippet auto-fill bug) :error - "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. + (if yas--original-auto-fill-function + (funcall yas--original-auto-fill-function) + ;; Shouldn't happen, gather more info about it (see #873/919). + (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) + (fill-fun-values `((t ,(default-value 'auto-fill-function)))) + ;; Listing 2 buffers with the same value is enough + (print-length 3)) + (save-current-buffer + (dolist (buf (let ((bufs (buffer-list))) + ;; List the current buffer first. + (setq bufs (cons (current-buffer) + (remq (current-buffer) bufs))))) + (set-buffer buf) + (let* ((yf-cell (assq yas--original-auto-fill-function + yas--fill-fun-values)) + (af-cell (assq auto-fill-function fill-fun-values))) + (when (local-variable-p 'yas--original-auto-fill-function) + (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) + (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) + (when (local-variable-p 'auto-fill-function) + (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) + (push (list auto-fill-function buf) fill-fun-values)))))) + (lwarn '(yasnippet auto-fill bug) :error + "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. %S `auto-fill-function': %S\n%s" - (current-buffer) yas--fill-fun-values fill-fun-values - (if (fboundp 'backtrace--print-frame) - (with-output-to-string - (mapc (lambda (frame) - (apply #'backtrace--print-frame frame)) - yas--watch-auto-fill-backtrace)) - "")) - ;; Try to avoid repeated triggering of this bug. - (auto-fill-mode -1) - ;; Don't pop up more than once in a session (still log though). - (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. - (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) - (funcall yas--original-auto-fill-function))) + (current-buffer) yas--fill-fun-values fill-fun-values + (if (fboundp 'backtrace--print-frame) + (with-output-to-string + (mapc (lambda (frame) + (apply #'backtrace--print-frame frame)) + yas--watch-auto-fill-backtrace)) + "")) + ;; Try to avoid repeated triggering of this bug. + (auto-fill-mode -1) + ;; Don't pop up more than once in a session (still log though). + (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. + (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))))) (save-excursion (setq end (progn (forward-paragraph) (point))) (setq beg (progn (backward-paragraph) (point)))) (save-excursion (save-restriction (narrow-to-region beg end) - (mapc #'yas--restore-marker-location remarkers) + (dolist (remarker remarkers) + (set-marker (car remarker) + (yas--goto-saved-location (cdr remarker)))) (mapc #'yas--restore-overlay-location reoverlays)) (mapc (lambda (snippet) (yas--letenv (yas--snippet-expand-env snippet) @@ -3909,6 +3994,7 @@ Move the overlays, or create them if they do not exit." (defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) "Commit the snippet if the protection overlay is being killed." (unless (or yas--inhibit-overlay-hooks + yas-inhibit-overlay-modification-protection (not after?) (= length (- end beg)) ; deletion or insertion (yas--undo-in-progress)) @@ -4334,35 +4420,54 @@ Meant to be called in a narrowed buffer, does various passes" ;; current paragraph instead of line. ;; ;; 2. Moving snippets from an `org-src' temp buffer into the main org -;; buffer, in this case we need to count the line offsets (because org -;; may add indentation on each line making character positions -;; unreliable). +;; buffer, in this case we need to count the relative line number +;; (because org may add indentation on each line making character +;; positions unreliable). +;; +;; Data formats: +;; (LOCATION) = (REGEXP WS-COUNT) +;; MARKER -> (MARKER . (LOCATION)) +;; OVERLAY -> (OVERLAY LOCATION-BEG LOCATION-END) +;; +;; For `org-src' temp buffer, add a line number to format: +;; (LINE-LOCATION) = (LINE . (LOCATION)) +;; MARKER@LINE -> (MARKER . (LINE-LOCATION)) +;; OVERLAY@LINE -> (OVERLAY LINE-LOCATION-BEG LINE-LOCATION-END) ;; ;; This is all best-effort heuristic stuff, but it should cover 99% of ;; use-cases. -(defun yas--snapshot-marker-location (marker &optional beg end) - "Returns info for restoring MARKER's location after indent. -The returned value is a list of the form (MARKER REGEXP WS-COUNT)." +(defun yas--snapshot-location (position &optional beg end) + "Returns info for restoring POSITIONS's location after indent. +The returned value is a list of the form (REGEXP WS-COUNT). +POSITION may be either a marker or just a buffer position. The +REGEXP matches text between BEG..END which default to the current +line if omitted." + (goto-char position) (unless beg (setq beg (line-beginning-position))) (unless end (setq end (line-end-position))) - (let ((before (split-string (buffer-substring-no-properties beg marker) + (let ((before (split-string (buffer-substring-no-properties beg position) "[[:space:]\n]+" t)) - (after (split-string (buffer-substring-no-properties marker end) + (after (split-string (buffer-substring-no-properties position end) "[[:space:]\n]+" t))) - (list marker - (concat "[[:space:]\n]*" + (list (concat "[[:space:]\n]*" (mapconcat (lambda (s) - (if (eq s marker) "\\(\\)" + (if (eq s position) "\\(\\)" (regexp-quote s))) - (nconc before (list marker) after) + (nconc before (list position) after) "[[:space:]\n]*")) - (progn (goto-char marker) - (skip-chars-forward "[:space:]\n" end) - (- (point) marker))))) + (progn (skip-chars-forward "[:space:]\n" end) + (- (point) position))))) + +(defun yas--snapshot-line-location (position &optional beg end) + "Like `yas--snapshot-location', but return also line number. +Returned format is (LINE REGEXP WS-COUNT)." + (goto-char position) + (cons (count-lines (point-min) (line-beginning-position)) + (yas--snapshot-location position beg end))) (defun yas--snapshot-overlay-location (overlay beg end) - "Like `yas--snapshot-marker-location' for overlays. + "Like `yas--snapshot-location' for overlays. The returned format is (OVERLAY (RE WS) (RE WS)). Either of the (RE WS) lists may be nil if the start or end, respectively, of the overlay is outside the range BEG .. END." @@ -4370,67 +4475,59 @@ of the overlay is outside the range BEG .. END." (oend (overlay-end overlay))) (list overlay (when (and (<= beg obeg) (< obeg end)) - (cdr (yas--snapshot-marker-location obeg beg end))) + (yas--snapshot-location obeg beg end)) (when (and (<= beg oend) (< oend end)) - (cdr (yas--snapshot-marker-location oend beg end)))))) + (yas--snapshot-location oend beg end))))) (defun yas--snapshot-overlay-line-location (overlay) "Return info for restoring OVERLAY's line based location. The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))." - (let ((loc-beg (progn (goto-char (overlay-start overlay)) - (yas--snapshot-marker-location (point)))) - (loc-end (progn (goto-char (overlay-end overlay)) - (yas--snapshot-marker-location (point))))) - (setcar loc-beg (count-lines (point-min) (progn (goto-char (car loc-beg)) - (line-beginning-position)))) - (setcar loc-end (count-lines (point-min) (progn (goto-char (car loc-end)) - (line-beginning-position)))) - (list overlay loc-beg loc-end))) - -(defun yas--goto-saved-location (regexp ws-count) - "Move point to location saved by `yas--snapshot-marker-location'. -Buffer must be narrowed to BEG..END used to create the snapshot info." - (goto-char (point-min)) - (if (not (looking-at regexp)) - (lwarn '(yasnippet re-marker) :warning - "Couldn't find: %S" regexp) - (goto-char (match-beginning 1)) - (skip-chars-forward "[:space:]\n") - (skip-chars-backward "[:space:]\n" (- (point) ws-count)))) - -(defun yas--restore-marker-location (re-marker) - "Restores marker based on info from `yas--snapshot-marker-location'. + (list overlay + (yas--snapshot-line-location (overlay-start overlay)) + (yas--snapshot-line-location (overlay-end overlay)))) + +(defun yas--goto-saved-location (re-count) + "Move to and return point saved by `yas--snapshot-location'. Buffer must be narrowed to BEG..END used to create the snapshot info." - (apply #'yas--goto-saved-location (cdr re-marker)) - (set-marker (car re-marker) (point))) + (let ((regexp (pop re-count)) + (ws-count (pop re-count))) + (goto-char (point-min)) + (if (not (looking-at regexp)) + (lwarn '(yasnippet re-marker) :warning + "Couldn't find: %S" regexp) + (goto-char (match-beginning 1)) + (skip-chars-forward "[:space:]\n") + (skip-chars-backward "[:space:]\n" (- (point) ws-count))) + (point))) (defun yas--restore-overlay-location (ov-locations) - "Restores marker based on info from `yas--snapshot-marker-location'. + "Restores marker based on info from `yas--snapshot-overlay-location'. Buffer must be narrowed to BEG..END used to create the snapshot info." (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations (move-overlay overlay (if (not loc-beg) (overlay-start overlay) - (apply #'yas--goto-saved-location loc-beg) - (point)) + (yas--goto-saved-location loc-beg)) (if (not loc-end) (overlay-end overlay) - (apply #'yas--goto-saved-location loc-end) - (point))))) - - -(defun yas--restore-overlay-line-location (ov-locations) - "Restores overlay based on info from `yas--snapshot-overlay-line-location'." + (yas--goto-saved-location loc-end))))) + +(defun yas--goto-saved-line-location (base-pos l-re-count) + "Move to and return point saved by `yas--snapshot-line-location'. +Additionally requires BASE-POS to tell where the line numbers are +relative to." + (goto-char base-pos) + (forward-line (pop l-re-count)) (save-restriction - (move-overlay (car ov-locations) - (save-excursion - (forward-line (car (nth 1 ov-locations))) - (narrow-to-region (line-beginning-position) (line-end-position)) - (apply #'yas--goto-saved-location (cdr (nth 1 ov-locations))) - (point)) - (save-excursion - (forward-line (car (nth 2 ov-locations))) - (narrow-to-region (line-beginning-position) (line-end-position)) - (apply #'yas--goto-saved-location (cdr (nth 2 ov-locations))) - (point))))) + (narrow-to-region (line-beginning-position) + (line-end-position)) + (yas--goto-saved-location l-re-count))) + +(defun yas--restore-overlay-line-location (base-pos ov-locations) + "Restores marker based on info from `yas--snapshot-overlay-line-location'." + (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w) + ov-locations + (move-overlay overlay + (yas--goto-saved-line-location base-pos beg-l-r-w) + (yas--goto-saved-line-location base-pos end-l-r-w)))) (defun yas--indent-region (from to snippet) "Indent the lines between FROM and TO with `indent-according-to-mode'. @@ -4449,14 +4546,16 @@ The SNIPPET's markers are preserved." (let ((remarkers nil)) (dolist (m snippet-markers) (when (and (<= bol m) (<= m eol)) - (push (yas--snapshot-marker-location m bol eol) + (push (cons m (yas--snapshot-location m bol eol)) remarkers))) (unwind-protect (progn (back-to-indentation) (indent-according-to-mode)) (save-restriction (narrow-to-region bol (line-end-position)) - (mapc #'yas--restore-marker-location remarkers)))) + (dolist (remarker remarkers) + (set-marker (car remarker) + (yas--goto-saved-location (cdr remarker))))))) while (and (zerop (forward-line 1)) (< (point) to))))))) @@ -4754,46 +4853,58 @@ When multiple expressions are found, only the last one counts." (parent 1) (t 0)))))) +(defun yas--snippet-field-mirrors (snippet) + ;; Make a list of (FIELD . MIRROR). + (cl-sort + (cl-mapcan (lambda (field) + (mapcar (lambda (mirror) + (cons field mirror)) + (yas--field-mirrors field))) + (yas--snippet-fields snippet)) + ;; Then sort this list so that entries with mirrors with + ;; parent fields appear before. This was important for + ;; fixing #290, and also handles the case where a mirror in + ;; a field causes another mirror to need reupdating. + #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm))))) + +(defun yas--indent-mirrors-of-snippet (snippet &optional f-ms) + ;; Indent mirrors of SNIPPET. F-MS is the return value of + ;; (yas--snippet-field-mirrors SNIPPET). + (when (eq yas-indent-line 'auto) + (let ((yas--inhibit-overlay-hooks t)) + (cl-loop for (beg . end) in + (cl-sort (mapcar (lambda (f-m) + (let ((mirror (cdr f-m))) + (cons (yas--mirror-start mirror) + (yas--mirror-end mirror)))) + (or f-ms + (yas--snippet-field-mirrors snippet))) + #'< :key #'car) + do (yas--indent-region beg end snippet))))) + (defun yas--update-mirrors (snippet) "Update all the mirrors of SNIPPET." (yas--save-restriction-and-widen (save-excursion - (cl-loop - for (field . mirror) - in (cl-sort - ;; Make a list of (FIELD . MIRROR). - (cl-mapcan (lambda (field) - (mapcar (lambda (mirror) - (cons field mirror)) - (yas--field-mirrors field))) - (yas--snippet-fields snippet)) - ;; Then sort this list so that entries with mirrors with - ;; parent fields appear before. This was important for - ;; fixing #290, and also handles the case where a mirror in - ;; a field causes another mirror to need reupdating. - #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm)))) - ;; Before updating a mirror with a parent-field, maybe advance - ;; its start (#290). - do (let ((parent-field (yas--mirror-parent-field mirror))) - (when parent-field - (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) - ;; Update this mirror. - do (yas--mirror-update-display mirror field) - ;; Delay indenting until we're done all mirrors. We must do - ;; this to avoid losing whitespace between fields that are - ;; still empty (i.e., they will be non-empty after updating). - when (eq yas-indent-line 'auto) - collect (cons (yas--mirror-start mirror) (yas--mirror-end mirror)) - into indent-regions - ;; `yas--place-overlays' is needed since the active field and - ;; protected overlays might have been changed because of insertions - ;; in `yas--mirror-update-display'. - do (let ((active-field (yas--snippet-active-field snippet))) - (when active-field (yas--place-overlays snippet active-field))) - finally do - (let ((yas--inhibit-overlay-hooks t)) - (cl-loop for (beg . end) in (cl-sort indent-regions #'< :key #'car) - do (yas--indent-region beg end snippet))))))) + (let ((f-ms (yas--snippet-field-mirrors snippet))) + (cl-loop + for (field . mirror) in f-ms + ;; Before updating a mirror with a parent-field, maybe advance + ;; its start (#290). + do (let ((parent-field (yas--mirror-parent-field mirror))) + (when parent-field + (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) + ;; Update this mirror. + do (yas--mirror-update-display mirror field) + ;; `yas--place-overlays' is needed since the active field and + ;; protected overlays might have been changed because of insertions + ;; in `yas--mirror-update-display'. + do (let ((active-field (yas--snippet-active-field snippet))) + (when active-field (yas--place-overlays snippet active-field)))) + ;; Delay indenting until we're done all mirrors. We must do + ;; this to avoid losing whitespace between fields that are + ;; still empty (i.e., they will be non-empty after updating). + (yas--indent-mirrors-of-snippet snippet f-ms))))) (defun yas--mirror-update-display (mirror field) "Update MIRROR according to FIELD (and mirror transform)." @@ -4851,6 +4962,7 @@ When multiple expressions are found, only the last one counts." ;; Don't pop up more than once in a session (still log though). (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) + (yas--do-todo-snippet-indent) (condition-case err (progn (yas--finish-moving-snippets) (cond ((eq 'undo this-command) -- cgit v1.3