commit 5f7a2a90536557e3dcb3bb64d4bbbd49ea7b3fee (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Nov 14 10:38:58 2015 +0200 Increment Emacs version on master branch * lisp/cus-edit.el (customize-changed-options-previous-release): Increase previous version to 24.5. * configure.ac: * msdos/sed2v2.inp: Bump version to 25.1.50. diff --git a/README b/README index 1f3de15..82a5a8f 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2015 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 25.0.50 of GNU Emacs, the extensible, +This directory tree holds version 25.1.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index 94ee9b7..0348c06 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 25.0.50, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 25.1.50, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index aa26ac3..22f12ba 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1164,7 +1164,7 @@ Show the buffer in another window, but don't select it." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "24.1" +(defvar customize-changed-options-previous-release "24.5" "Version for `customize-changed-options' to refer back to by default.") ;; Packages will update this variable, so make it available. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index e1609f2..c82b27a 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ /^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/ /^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/ -/^#undef VERSION/s/^.*$/#define VERSION "25.0.50"/ +/^#undef VERSION/s/^.*$/#define VERSION "25.1.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ commit ed2e7e20ae0945288c98091f308f5460c3453873 Author: Xue Fuqiao Date: Sat Nov 14 12:49:17 2015 +0800 Mention CONTRIBUTE in README Mention CONTRIBUTE in README, since it was moved from etc/ to root. * etc/TODO: Remove the reference to `etc/CONTRIBUTE'. * README: Mention CONTRIBUTE. diff --git a/README b/README index be99852..1f3de15 100644 --- a/README +++ b/README @@ -15,6 +15,9 @@ user-visible changes in recent versions of Emacs. The file etc/PROBLEMS contains information on many common problems that occur in building, installing and running Emacs. +The file CONTRIBUTE contains information on contributing to Emacs as a +developer. + You may encounter bugs in this release. If you do, please report them; your bug reports are valuable contributions to the FSF, since they allow us to notice and fix problems on machines we don't have, or diff --git a/etc/TODO b/etc/TODO index 946a4fe..7045731 100644 --- a/etc/TODO +++ b/etc/TODO @@ -13,9 +13,12 @@ the latest version of this file in the Emacs source code repository. Since Emacs is an FSF-copyrighted package, please be prepared to sign legal papers to transfer the copyright on your work to the FSF. -For more details on this, see the section "Copyright Assignment" -in etc/CONTRIBUTE. That file also contains some more practical -details about getting involved. +Copyright assignment is a simple process. Residents of some countries +can do it entirely electronically. We can help you get started, and +answer any questions you may have (or point you to the people with the +answers), at the emacs-devel@gnu.org mailing list. + +For more information about getting involved, see the CONTRIBUTE file. As well as the issues listed here, there are bug reports at . Bugs tagged "easy" ought to be suitable for commit 9e00a029c4d7a8fa510fca878102623c74b50f85 Author: Wilson Snyder Date: Fri Nov 13 21:17:57 2015 -0500 Update verilog-mode.el to 2015-11-09-b121d60-vpo. * verilog-mode.el (verilog-auto, verilog-delete-auto) (verilog-modi-cache-results, verilog-save-buffer-state) (verilog-save-font-no-change-functions): When internally suppressing change functions, use `inhibit-modification-hooks' and call `after-change-funtions' to more nicely work with user hooks. Reported by Stefan Monnier. (verilog-auto, verilog-delete-auto, verilog-delete-auto-buffer): Create `verilog-delete-auto-buffer' to avoid double-calling fontification hooks. (verilog-restore-buffer-modified-p, verilog-auto) (verilog-save-buffer-state): Prefer restore-buffer-modified-p over set-buffer-modified-p. Reported by Stefan Monnier. (verilog-diff-auto, verilog-diff-buffers-p) (verilog-diff-ignore-regexp): Add `verilog-diff-ignore-regexp'. (verilog-auto-inst-port, verilog-read-sub-decls-expr): Fix AUTOINST with unpacked dimensional parameters, bug981. Reported by by Amol Nagapurkar. (verilog-read-decls, verilog-read-sub-decls-line): Avoid unneeded properties inside internal structures. No functional change intended. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 489094b..5e03cf4 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,7 +123,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2015-09-18-314cf1d-vpo-GNU" +(defconst verilog-mode-version "2015-11-09-b121d60-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -230,10 +230,9 @@ STRING should be given if the last search was by `string-match' on STRING." `(customize ,var)) ) - (unless (boundp 'inhibit-point-motion-hooks) - (defvar inhibit-point-motion-hooks nil)) - (unless (boundp 'deactivate-mark) - (defvar deactivate-mark nil)) + (defvar inhibit-modification-hooks) + (defvar inhibit-point-motion-hooks) + (defvar deactivate-mark) ) ;; ;; OK, do this stuff if we are NOT XEmacs: @@ -327,6 +326,14 @@ wherever possible, since it is slow." (not (null pos))))))) (eval-and-compile + (cond + ((fboundp 'restore-buffer-modified-p) + ;; Faster, as does not update mode line when nothing changes + (defalias 'verilog-restore-buffer-modified-p 'restore-buffer-modified-p)) + (t + (defalias 'verilog-restore-buffer-modified-p 'set-buffer-modified-p)))) + +(eval-and-compile ;; Both xemacs and emacs (condition-case nil (require 'diff) ; diff-command and diff-switches @@ -827,6 +834,10 @@ Function takes three arguments, the original buffer, the difference buffer, and the point in original buffer with the first difference.") +(defvar verilog-diff-ignore-regexp nil + "Non-nil specifies regexp which `verilog-diff-auto' will ignore. +This is typically nil.") + ;;; Compile support: ;; @@ -2937,8 +2948,6 @@ find the errors." (modify-syntax-entry ?> "." table) (modify-syntax-entry ?& "." table) (modify-syntax-entry ?| "." table) - ;; FIXME: This goes against Emacs conventions. Use "_" syntax instead and - ;; then use regexps with things like "\\_<...\\_>". (modify-syntax-entry ?` "w" table) ; ` is part of definition symbols in Verilog (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\' "." table) @@ -3230,9 +3239,10 @@ user-visible changes to the buffer must not be within a (buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) (verilog-no-change-functions t) - before-change-functions - after-change-functions + before-change-functions ; XEmacs ignores inhibit-modification-hooks + after-change-functions ; XEmacs ignores inhibit-modification-hooks deactivate-mark buffer-file-name ; Prevent primitives checking buffer-file-truename) ; for file modification @@ -3240,41 +3250,44 @@ user-visible changes to the buffer must not be within a (progn ,@body) (and (not modified) (buffer-modified-p) - (set-buffer-modified-p nil))))) + (verilog-restore-buffer-modified-p nil))))) -(defmacro verilog-save-no-change-functions (&rest body) - "Execute BODY forms, disabling all change hooks in BODY. -For insignificant changes, see instead `verilog-save-buffer-state'." - `(let* ((inhibit-point-motion-hooks t) - (verilog-no-change-functions t) - before-change-functions - after-change-functions) - (progn ,@body))) (defvar verilog-save-font-mod-hooked nil - "Local variable when inside a `verilog-save-font-mods' block.") + "Local variable when inside a `verilog-save-font-no-change-functions' block.") (make-variable-buffer-local 'verilog-save-font-mod-hooked) -(defmacro verilog-save-font-mods (&rest body) - "Execute BODY forms, disabling text modifications to allow performing BODY. +(defmacro verilog-save-font-no-change-functions (&rest body) + "Execute BODY forms, disabling all change hooks in BODY. Includes temporary disabling of `font-lock' to restore the buffer to full text form for parsing. Additional actions may be specified with -`verilog-before-save-font-hook' and `verilog-after-save-font-hook'." - ;; Before version 20, match-string with font-lock returns a - ;; vector that is not equal to the string. IE if on "input" - ;; nil==(equal "input" (progn (looking-at "input") (match-string 0))) - `(let* ((hooked (unless verilog-save-font-mod-hooked - (verilog-run-hooks 'verilog-before-save-font-hook) - t)) - (verilog-save-font-mod-hooked t) - (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode 0) - t))) - (unwind-protect - (progn ,@body) - ;; Unwind forms - (when fontlocked (font-lock-mode t)) - (when hooked (verilog-run-hooks 'verilog-after-save-font-hook))))) +`verilog-before-save-font-hook' and `verilog-after-save-font-hook'. +For insignificant changes, see instead `verilog-save-buffer-state'." + `(if verilog-save-font-mod-hooked ; A recursive call? + (progn ,@body) + ;; Before version 20, match-string with font-lock returns a + ;; vector that is not equal to the string. IE if on "input" + ;; nil==(equal "input" (progn (looking-at "input") (match-string 0))) + ;; Therefore we must remove and restore font-lock mode + (verilog-run-hooks 'verilog-before-save-font-hook) + (let* ((verilog-save-font-mod-hooked (- (point-max) (point-min))) + (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode) + (font-lock-mode 0) + t))) + (run-hook-with-args 'before-change-functions (point-min) (point-max)) + (unwind-protect + ;; Must inhibit and restore hooks before restoring font-lock + (let* ((inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + (verilog-no-change-functions t) + before-change-functions ; XEmacs ignores inhibit-modification-hooks + after-change-functions) ; XEmacs ignores inhibit-modification-hooks + (progn ,@body)) + ;; Unwind forms + (run-hook-with-args 'after-change-functions (point-min) (point-max) + verilog-save-font-mod-hooked) ; old length + (when fontlocked (font-lock-mode t)) + (verilog-run-hooks 'verilog-after-save-font-hook))))) ;; ;; Comment detection and caching @@ -8074,7 +8087,7 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]." (when (and sv-busstring (not (equal sv-busstring (verilog-sig-bits sig)))) (when nil ; Debugging - (message (concat "Warning, can't merge into single bus %s%s" + (message (concat "Warning, can't merge into single bus `%s%s'" ", the AUTOs may be wrong") sv-name bus)) (setq buswarn ", Couldn't Merge")) @@ -8377,18 +8390,18 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setcar (cdr (cdr (cdr newsig))) (if (verilog-sig-memory newsig) (concat (verilog-sig-memory newsig) (match-string 1)) - (match-string 1)))) + (match-string-no-properties 1)))) (vec ; Multidimensional (setq multidim (cons vec multidim)) (setq vec (verilog-string-replace-matches - "\\s-+" "" nil nil (match-string 1)))) + "\\s-+" "" nil nil (match-string-no-properties 1)))) (t ; Bit width (setq vec (verilog-string-replace-matches - "\\s-+" "" nil nil (match-string 1)))))) + "\\s-+" "" nil nil (match-string-no-properties 1)))))) ;; Normal or escaped identifier -- note we remember the \ if escaped ((looking-at "\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)") (goto-char (match-end 0)) - (setq keywd (match-string 1)) + (setq keywd (match-string-no-properties 1)) (when (string-match "^\\\\" (match-string 1)) (setq keywd (concat keywd " "))) ; Escaped ID needs space at end ;; Add any :: package names to same identifier @@ -8573,11 +8586,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." (defvar sigs-out-unk) (defvar sigs-temp) ;; These are known to be from other packages and may not be defined - (defvar diff-command nil) + (defvar diff-command) ;; There are known to be from newer versions of Emacs - (defvar create-lockfiles)) + (defvar create-lockfiles) + (defvar which-func-modes)) -(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim) +(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim mem) "For `verilog-read-sub-decls-line', add a signal." ;; sig eq t to indicate .name syntax ;;(message "vrsds: %s(%S)" port sig) @@ -8588,6 +8602,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq sig (if dotname port (verilog-symbol-detick-denumber sig))) (if vec (setq vec (verilog-symbol-detick-denumber vec))) (if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim))) + (if mem (setq mem (verilog-symbol-detick-denumber mem))) (unless (or (not sig) (equal sig "")) ; Ignore .foo(1'b1) assignments (cond ((or (setq portdata (assoc port (verilog-decls-get-inouts submoddecls))) @@ -8597,7 +8612,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) (unless (member (verilog-sig-type portdata) '("wire" "reg")) @@ -8611,7 +8626,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "From " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) ;; Though ok in SV, in V2K code, propagating the @@ -8630,7 +8645,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) (unless (member (verilog-sig-type portdata) '("wire" "reg")) @@ -8643,7 +8658,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) (verilog-sig-type portdata) @@ -8656,7 +8671,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." sig (if dotname (verilog-sig-bits portdata) vec) (concat "To/From " comment) - (verilog-sig-memory portdata) + mem nil (verilog-sig-signed portdata) (verilog-sig-type portdata) @@ -8669,7 +8684,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." "For `verilog-read-sub-decls-line', parse a subexpression and add signals." ;;(message "vrsde: `%s'" expr) ;; Replace special /*[....]*/ comments inserted by verilog-auto-inst-port - (setq expr (verilog-string-replace-matches "/\\*\\(\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr)) + (setq expr (verilog-string-replace-matches "/\\*\\(\\.?\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr)) ;; Remove front operators (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) ;; @@ -8683,7 +8698,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (while (setq mstr (pop mlst)) (verilog-read-sub-decls-expr submoddecls comment port mstr))))) (t - (let (sig vec multidim) + (let (sig vec multidim mem) ;; Remove leading reduction operators, etc (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) ;;(message "vrsde-ptop: `%s'" expr) @@ -8703,10 +8718,15 @@ Return an array of [outputs inouts inputs wire reg assign const]." (when vec (setq multidim (cons vec multidim))) (setq vec (match-string 1 expr) expr (substring expr (match-end 0)))) + ;; Find .[unpacked_memory] or .[unpacked][unpacked]... + (while (string-match "^\\s-*\\.\\(\\[[^]]+\\]\\)" expr) + ;;(message "vrsde-m: `%s'" (match-string 1 expr)) + (setq mem (match-string 1 expr) + expr (substring expr (match-end 0)))) ;; If found signal, and nothing unrecognized, add the signal ;;(message "vrsde-rem: `%s'" expr) (when (and sig (string-match "^\\s-*$" expr)) - (verilog-read-sub-decls-sig submoddecls comment port sig vec multidim)))))) + (verilog-read-sub-decls-sig submoddecls comment port sig vec multidim mem)))))) (defun verilog-read-sub-decls-line (submoddecls comment) "For `verilog-read-sub-decls', read lines of port defs until none match. @@ -8717,23 +8737,23 @@ Inserts the list of signals found, using submodi to look up each port." (while (not done) ;; Get port name (cond ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*(\\s-*") - (setq port (match-string 1)) + (setq port (match-string-no-properties 1)) (goto-char (match-end 0))) ;; .\escaped ( ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*(\\s-*") - (setq port (concat (match-string 1) " ")) ; escaped id's need trailing space + (setq port (concat (match-string-no-properties 1) " ")) ; escaped id's need trailing space (goto-char (match-end 0))) ;; .name ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*[,)/]") (verilog-read-sub-decls-sig - submoddecls comment (match-string 1) t ; sig==t for .name - nil nil) ; vec multidim + submoddecls comment (match-string-no-properties 1) t ; sig==t for .name + nil nil nil) ; vec multidim mem (setq port nil)) ;; .\escaped_name ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*[,)/]") (verilog-read-sub-decls-sig - submoddecls comment (concat (match-string 1) " ") t ; sig==t for .name - nil nil) ; vec multidim + submoddecls comment (concat (match-string-no-properties 1) " ") t ; sig==t for .name + nil nil nil) ; vec multidim mem (setq port nil)) ;; random ((looking-at "\\s-*\\.[^(]*(") @@ -8748,20 +8768,20 @@ Inserts the list of signals found, using submodi to look up each port." (cond ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls comment port - (verilog-string-remove-spaces (match-string 1)) ; sig - nil nil)) ; vec multidim + (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig + nil nil nil)) ; vec multidim mem ;; ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls comment port - (verilog-string-remove-spaces (match-string 1)) ; sig - (match-string 2) nil)) ; vec multidim + (verilog-string-remove-spaces (match-string-no-properties 1)) ; sig + (match-string-no-properties 2) nil nil)) ; vec multidim mem ;; Fastpath was above looking-at's. ;; For something more complicated invoke a parser ((looking-at "[^)]+") (verilog-read-sub-decls-expr submoddecls comment port - (buffer-substring + (buffer-substring-no-properties (point) (1- (progn (search-backward "(") ; start at ( (verilog-forward-sexp-ign-cmt 1) (point)))))))) ; expr @@ -9894,7 +9914,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (or mif ignore-error (error (concat - "%s: Can't locate %s module definition%s" + "%s: Can't locate `%s' module definition%s" "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t%s") (verilog-point-text) module @@ -9959,9 +9979,9 @@ Cache the output of function so next call may have faster access." (t ;; Read from file ;; Clear then restore any highlighting to make emacs19 happy - (let (func-returns) - (verilog-save-font-mods - (setq func-returns (funcall function))) + (let ((func-returns + (verilog-save-font-no-change-functions + (funcall function)))) ;; Cache for next time (setq verilog-modi-cache-list (cons (list (list modi function) @@ -10003,7 +10023,7 @@ Report errors unless optional IGNORE-ERROR." (let* ((realname (verilog-symbol-detick name t)) (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi))))) (or modport ignore-error - (error "%s: Can't locate %s modport definition%s" + (error "%s: Can't locate `%s' modport definition%s" (verilog-point-text) name (if (not (equal name realname)) (concat " (Expanded macro to " realname ")") @@ -10193,7 +10213,7 @@ When MODI is non-null, also add to modi-cache, for tracking." ((equal direction "parameter") (verilog-modi-cache-add-gparams modi sigs)) (t - (error "Unsupported verilog-insert-definition direction: %s" direction)))) + (error "Unsupported verilog-insert-definition direction: `%s'" direction)))) (or dont-sort (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare))) (while sigs @@ -10224,7 +10244,7 @@ When MODI is non-null, also add to modi-cache, for tracking." (eval-when-compile (if (not (boundp 'indent-pt)) - (defvar indent-pt nil "Local used by insert-indent"))) + (defvar indent-pt nil "Local used by `verilog-insert-indent'."))) (defun verilog-insert-indent (&rest stuff) "Indent to position stored in local `indent-pt' variable, then insert STUFF. @@ -10510,6 +10530,41 @@ removed." (re-search-backward ",") (delete-char 1)))))) +(defun verilog-delete-auto-buffer () + "Perform `verilog-delete-auto' on the current buffer. +Intended for internal use inside a `verilog-save-font-no-change-functions' block." + ;; Allow user to customize + (verilog-run-hooks 'verilog-before-delete-auto-hook) + + ;; Remove those that have multi-line insertions, possibly with parameters + ;; We allow anything beginning with AUTO, so that users can add their own + ;; patterns + (verilog-auto-re-search-do + (concat "/\\*AUTO[A-Za-z0-9_]+" + ;; Optional parens or quoted parameter or .* for (((...))) + "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" + "\\*/") + 'verilog-delete-autos-lined) + ;; Remove those that are in parenthesis + (verilog-auto-re-search-do + (concat "/\\*" + (eval-when-compile + (verilog-regexp-words + `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" + "AUTOSENSE"))) + "\\*/") + 'verilog-delete-to-paren) + ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments + (verilog-auto-re-search-do "\\.\\*" + 'verilog-delete-auto-star-all) + ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed + (goto-char (point-min)) + (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([ \tLT0-9]*\\| LHS: .*\\)?$" nil t) + (replace-match "")) + + ;; Final customize + (verilog-run-hooks 'verilog-delete-auto-hook)) + (defun verilog-delete-auto () "Delete the automatic outputs, regs, and wires created by \\[verilog-auto]. Use \\[verilog-auto] to re-insert the updated AUTOs. @@ -10520,39 +10575,10 @@ called before and after this function, respectively." (save-excursion (if (buffer-file-name) (find-file-noselect (buffer-file-name))) ; To check we have latest version - (verilog-save-no-change-functions + (verilog-save-font-no-change-functions (verilog-save-scan-cache - ;; Allow user to customize - (verilog-run-hooks 'verilog-before-delete-auto-hook) - - ;; Remove those that have multi-line insertions, possibly with parameters - ;; We allow anything beginning with AUTO, so that users can add their own - ;; patterns - (verilog-auto-re-search-do - (concat "/\\*AUTO[A-Za-z0-9_]+" - ;; Optional parens or quoted parameter or .* for (((...))) - "\\(\\|([^)]*)\\|(\"[^\"]*\")\\).*?" - "\\*/") - 'verilog-delete-autos-lined) - ;; Remove those that are in parenthesis - (verilog-auto-re-search-do - (concat "/\\*" - (eval-when-compile - (verilog-regexp-words - `("AS" "AUTOARG" "AUTOCONCATWIDTH" "AUTOINST" "AUTOINSTPARAM" - "AUTOSENSE"))) - "\\*/") - 'verilog-delete-to-paren) - ;; Do .* instantiations, but avoid removing any user pins by looking for our magic comments - (verilog-auto-re-search-do "\\.\\*" - 'verilog-delete-auto-star-all) - ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed - (goto-char (point-min)) - (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([ \tLT0-9]*\\| LHS: .*\\)?$" nil t) - (replace-match "")) + (verilog-delete-auto-buffer))))) - ;; Final customize - (verilog-run-hooks 'verilog-delete-auto-hook))))) ;;; Auto inject: ;; @@ -10679,10 +10705,11 @@ Typing \\[verilog-inject-auto] will make this into: ;; Auto diff: ;; -(defun verilog-diff-buffers-p (b1 b2 &optional whitespace) +(defun verilog-diff-buffers-p (b1 b2 &optional whitespace regexp) "Return nil if buffers B1 and B2 have same contents. Else, return point in B1 that first mismatches. -If optional WHITESPACE true, ignore whitespace." +If optional WHITESPACE true, ignore whitespace. +If optional REGEXP, ignore differences matching it." (save-excursion (let* ((case-fold-search nil) ; compare-buffer-substrings cares (p1 (with-current-buffer b1 (goto-char (point-min)))) @@ -10703,6 +10730,15 @@ If optional WHITESPACE true, ignore whitespace." (goto-char p2) (skip-chars-forward " \t\n\r\f\v") (setq p2 (point)))) + (when regexp + (with-current-buffer b1 + (goto-char p1) + (when (looking-at regexp) + (setq p1 (match-end 0)))) + (with-current-buffer b2 + (goto-char p2) + (when (looking-at regexp) + (setq p2 (match-end 0))))) (setq size (min (- maxp1 p1) (- maxp2 p2))) (setq progress (compare-buffer-substrings b2 p2 (+ size p2) b1 p1 (+ size p1))) @@ -10723,7 +10759,7 @@ Ignores WHITESPACE if t, and writes output to stdout if SHOW." ;; call `diff' as `diff' has different calling semantics on different ;; versions of Emacs. (if (not (file-exists-p f1)) - (message "Buffer %s has no associated file on disc" (buffer-name b2)) + (message "Buffer `%s' has no associated file on disk" (buffer-name b2)) (with-temp-buffer "*Verilog-Diff*" (let ((outbuf (current-buffer)) (f2 (make-temp-file "vm-diff-auto-"))) @@ -10791,7 +10827,7 @@ or `diff' in batch mode." ;; Restore name if unwind (with-current-buffer b1 (setq buffer-file-name name1))))) ;; - (setq diffpt (verilog-diff-buffers-p b1 b2 t)) + (setq diffpt (verilog-diff-buffers-p b1 b2 t verilog-diff-ignore-regexp)) (cond ((not diffpt) (unless noninteractive (message "AUTO expansion identical")) (kill-buffer newname)) ; Nice to cleanup after oneself @@ -11054,6 +11090,7 @@ If PAR-VALUES replace final strings with these parameter values." (vl-name (verilog-sig-name port-st)) (vl-width (verilog-sig-width port-st)) (vl-modport (verilog-sig-modport port-st)) + (vl-memory (verilog-sig-memory port-st)) (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) (vl-bits (if (or verilog-auto-inst-vector @@ -11078,15 +11115,25 @@ If PAR-VALUES replace final strings with these parameter values." (concat "\\<" (nth 0 (car check-values)) "\\>") (concat "(" (nth 1 (car check-values)) ")") t t vl-mbits) + vl-memory (when vl-memory + (verilog-string-replace-matches + (concat "\\<" (nth 0 (car check-values)) "\\>") + (concat "(" (nth 1 (car check-values)) ")") + t t vl-memory)) check-values (cdr check-values))) (setq vl-bits (verilog-simplify-range-expression vl-bits) vl-mbits (verilog-simplify-range-expression vl-mbits) + vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory)) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed ;; Default net value if not found - (setq dflt-bits (if (and (verilog-sig-bits port-st) - (or (verilog-sig-multidim port-st) - (verilog-sig-memory port-st))) - (concat "/*" vl-mbits vl-bits "*/") + (setq dflt-bits (if (or (and (verilog-sig-bits port-st) + (verilog-sig-multidim port-st)) + (verilog-sig-memory port-st)) + (concat "/*" vl-mbits vl-bits + ;; .[ used to separate packed from unpacked + (if vl-memory "." "") + (if vl-memory vl-memory "") + "*/") (concat vl-bits)) tpl-net (concat port (if (and vl-modport @@ -11157,7 +11204,7 @@ If PAR-VALUES replace final strings with these parameter values." (for-star (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16) verilog-auto-inst-column)) - (verilog-insert " // Implicit .\*\n")) ;For some reason the . or * must be escaped... + (verilog-insert " // Implicit .*\n")) (t (insert "\n"))))) ;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3") @@ -13316,13 +13363,16 @@ Typing \\[verilog-auto] will make this into: (sig-list-all (verilog-decls-get-iovars moddecls)) ;; (undecode-sig (or (assoc undecode-name sig-list-all) - (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name))) + (error "%s: Signal `%s' not found in design" + (verilog-point-text) undecode-name))) (undecode-enum (or (verilog-sig-enum undecode-sig) - (error "%s: Signal %s does not have an enum tag" (verilog-point-text) undecode-name))) + (error "%s: Signal `%s' does not have an enum tag" + (verilog-point-text) undecode-name))) ;; (enum-sigs (verilog-signals-not-in (or (verilog-signals-matching-enum sig-list-consts undecode-enum) - (error "%s: No state definitions for %s" (verilog-point-text) undecode-enum)) + (error "%s: No state definitions for `%s'" + (verilog-point-text) undecode-enum)) nil)) ;; (one-hot (or @@ -13518,120 +13568,115 @@ Wilson Snyder (wsnyder@wsnyder.org)." (unless noninteractive (message "Updating AUTOs...")) (if (fboundp 'dinotrace-unannotate-all) (dinotrace-unannotate-all)) - (verilog-save-font-mods + ;; Disable change hooks for speed + ;; This let can't be part of above let; must restore + ;; after-change-functions before font-lock resumes + (verilog-save-font-no-change-functions (let ((oldbuf (if (not (buffer-modified-p)) - (buffer-string))) - (case-fold-search verilog-case-fold) - ;; Cache directories; we don't write new files, so can't change - (verilog-dir-cache-preserving t) - ;; Cache current module - (verilog-modi-cache-current-enable t) - (verilog-modi-cache-current-max (point-min)) ; IE it's invalid - verilog-modi-cache-current) - (unwind-protect - ;; Disable change hooks for speed - ;; This let can't be part of above let; must restore - ;; after-change-functions before font-lock resumes - (verilog-save-no-change-functions - (verilog-save-scan-cache - (save-excursion - ;; Wipe cache; otherwise if we AUTOed a block above this one, - ;; we'll misremember we have generated IOs, confusing AUTOOUTPUT - (setq verilog-modi-cache-list nil) - ;; Local state - (verilog-read-auto-template-init) - ;; If we're not in verilog-mode, change syntax table so parsing works right - (unless (eq major-mode `verilog-mode) (verilog-mode)) - ;; Allow user to customize - (verilog-run-hooks 'verilog-before-auto-hook) - ;; Try to save the user from needing to revert-file to reread file local-variables - (verilog-auto-reeval-locals) - (verilog-read-auto-lisp-present) - (verilog-read-auto-lisp (point-min) (point-max)) - (verilog-getopt-flags) - ;; From here on out, we can cache anything we read from disk - (verilog-preserve-dir-cache - ;; These two may seem obvious to do always, but on large includes it can be way too slow - (when verilog-auto-read-includes - (verilog-read-includes) - (verilog-read-defines nil nil t)) - ;; Setup variables due to SystemVerilog expansion - (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup) - ;; This particular ordering is important - ;; INST: Lower modules correct, no internal dependencies, FIRST - (verilog-preserve-modi-cache - ;; Clear existing autos else we'll be screwed by existing ones - (verilog-delete-auto) - ;; Injection if appropriate - (when inject - (verilog-inject-inst) - (verilog-inject-sense) - (verilog-inject-arg)) - ;; - ;; Do user inserts first, so their code can insert AUTOs - (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" - 'verilog-auto-insert-lisp) - ;; Expand instances before need the signals the instances input/output - (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) - (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) - (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) - ;; Doesn't matter when done, but combine it with a common changer - (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) - (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) - ;; Must be done before autoin/out as creates a reg - (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) - ;; - ;; first in/outs from other files - (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) - (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) - (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) - (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) - (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) - ;; next in/outs which need previous sucked inputs first - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) - ;; Then tie off those in/outs - (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) - ;; These can be anywhere after AUTOINSERTLISP - (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) - ;; Wires/regs must be after inputs/outputs - (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) - (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) - (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) - (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) - (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) - ;; outputevery needs AUTOOUTPUTs done first - (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) - ;; After we've created all new variables - (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) - ;; Must be after all inputs outputs are generated - (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) - ;; User inserts - (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last) - ;; Fix line numbers (comments only) - (when verilog-auto-inst-template-numbers - (verilog-auto-templated-rel)) - (when verilog-auto-template-warn-unused - (verilog-auto-template-lint)))) - ;; - (verilog-run-hooks 'verilog-auto-hook) - ;; - (when verilog-auto-delete-trailing-whitespace - (verilog-delete-trailing-whitespace)) - ;; - (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)) - ;; - ;; If end result is same as when started, clear modified flag - (cond ((and oldbuf (equal oldbuf (buffer-string))) - (set-buffer-modified-p nil) - (unless noninteractive (message "Updating AUTOs...done (no changes)"))) - (t (unless noninteractive (message "Updating AUTOs...done")))) - ;; End of after-change protection - ))) - ;; Unwind forms - ;; Currently handled in verilog-save-font-mods - )))) + (buffer-string))) + (case-fold-search verilog-case-fold) + ;; Cache directories; we don't write new files, so can't change + (verilog-dir-cache-preserving t) + ;; Cache current module + (verilog-modi-cache-current-enable t) + (verilog-modi-cache-current-max (point-min)) ; IE it's invalid + verilog-modi-cache-current) + (verilog-save-scan-cache + (save-excursion + ;; Wipe cache; otherwise if we AUTOed a block above this one, + ;; we'll misremember we have generated IOs, confusing AUTOOUTPUT + (setq verilog-modi-cache-list nil) + ;; Local state + (verilog-read-auto-template-init) + ;; If we're not in verilog-mode, change syntax table so parsing works right + (unless (eq major-mode `verilog-mode) (verilog-mode)) + ;; Allow user to customize + (verilog-run-hooks 'verilog-before-auto-hook) + ;; Try to save the user from needing to revert-file to reread file local-variables + (verilog-auto-reeval-locals) + (verilog-read-auto-lisp-present) + (verilog-read-auto-lisp (point-min) (point-max)) + (verilog-getopt-flags) + ;; From here on out, we can cache anything we read from disk + (verilog-preserve-dir-cache + ;; These two may seem obvious to do always, but on large includes it can be way too slow + (when verilog-auto-read-includes + (verilog-read-includes) + (verilog-read-defines nil nil t)) + ;; Setup variables due to SystemVerilog expansion + (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic-setup) + ;; This particular ordering is important + ;; INST: Lower modules correct, no internal dependencies, FIRST + (verilog-preserve-modi-cache + ;; Clear existing autos else we'll be screwed by existing ones + (verilog-delete-auto-buffer) + ;; Injection if appropriate + (when inject + (verilog-inject-inst) + (verilog-inject-sense) + (verilog-inject-arg)) + ;; + ;; Do user inserts first, so their code can insert AUTOs + (verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/" + 'verilog-auto-insert-lisp) + ;; Expand instances before need the signals the instances input/output + (verilog-auto-re-search-do "/\\*AUTOINSTPARAM\\*/" 'verilog-auto-inst-param) + (verilog-auto-re-search-do "/\\*AUTOINST\\*/" 'verilog-auto-inst) + (verilog-auto-re-search-do "\\.\\*" 'verilog-auto-star) + ;; Doesn't matter when done, but combine it with a common changer + (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) + (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) + ;; Must be done before autoin/out as creates a reg + (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) + ;; + ;; first in/outs from other files + (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) + (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) + (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) + ;; next in/outs which need previous sucked inputs first + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) + ;; Then tie off those in/outs + (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) + ;; These can be anywhere after AUTOINSERTLISP + (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) + ;; Wires/regs must be after inputs/outputs + (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) + (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) + (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) + (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) + (verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input) + ;; outputevery needs AUTOOUTPUTs done first + (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every) + ;; After we've created all new variables + (verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused) + ;; Must be after all inputs outputs are generated + (verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg) + ;; User inserts + (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last) + ;; Fix line numbers (comments only) + (when verilog-auto-inst-template-numbers + (verilog-auto-templated-rel)) + (when verilog-auto-template-warn-unused + (verilog-auto-template-lint)))) + ;; + (verilog-run-hooks 'verilog-auto-hook) + ;; + (when verilog-auto-delete-trailing-whitespace + (verilog-delete-trailing-whitespace)) + ;; + (set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick)) + ;; + ;; If end result is same as when started, clear modified flag + (cond ((and oldbuf (equal oldbuf (buffer-string))) + (verilog-restore-buffer-modified-p nil) + (unless noninteractive (message "Updating AUTOs...done (no changes)"))) + (t (unless noninteractive (message "Updating AUTOs...done")))) + ;; End of save-cache + ))))) ;;; Skeletons: ;; commit 138ad3d93b7abe08ac399f582aa6c8aac869e17e Author: Dmitry Gutov Date: Sat Nov 14 03:03:58 2015 +0200 ; Fix warnings * lisp/vc/diff-mode.el (diff-kill-applied-hunks): Fix unused variable warnings. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 464e375..f4d7fe7 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1821,7 +1821,7 @@ With a prefix argument, try to REVERSE the hunk." "Kill all hunks that have already been applied starting at point." (interactive) (while (not (eobp)) - (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (pcase-let ((`(,_buf ,line-offset ,_pos ,_src ,_dst ,switched) (diff-find-source-location nil nil))) (if (and line-offset switched) (diff-hunk-kill) commit 7126e9a40b7ffbf336dcb0209020db112696a871 Author: Dmitry Gutov Date: Sat Nov 14 02:40:06 2015 +0200 ; Update xref-etags-mode for the latest change diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 489a2ec..6a3b42f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -812,14 +812,9 @@ and just use etags." :lighter "" (if xref-etags-mode (progn - (setq xref-etags-mode--saved - (cons xref-find-function - xref-identifier-completion-table-function)) - (kill-local-variable 'xref-find-function) - (kill-local-variable 'xref-identifier-completion-table-function)) - (setq-local xref-find-function (car xref-etags-mode--saved)) - (setq-local xref-identifier-completion-table-function - (cdr xref-etags-mode--saved)))) + (setq xref-etags-mode--saved xref-backend-functions) + (kill-local-variable 'xref-backend-functions)) + (setq-local xref-backend-functions xref-etags-mode--saved))) (declare-function semantic-symref-find-references-by-name "semantic/symref") (declare-function semantic-find-file-noselect "semantic/fw") commit 246d6605f72810b1d4977947f266cf48b933446f Author: Dmitry Gutov Date: Sat Nov 14 02:37:01 2015 +0200 Use generic dispatch for xref backends * lisp/progmodes/xref.el (xref-backend-functions): New variable. (xref-find-function): Remove. (xref-find-backend) (xref--etags-backend): New functions. (xref-identifier-at-point-function) (xref-identifier-completion-table-function): Remove. (xref-backend-definitions, xref-backend-references) (xref-backend-apropos, xref-backend-identifier-at-point) (xref-backend-identifier-completion-table): New generic functions. * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Add `elisp--xref-backend' to the beginning of `xref-backend-functions', locally. Delete references to removed functions and vars. (elisp-xref-find): Remove. (elisp--xref-backend): New function. (elisp--xref-find-references, elisp--xref-find-apropos) (elisp--xref-identifier-completion-table): Turn into appropriately named generic methods. * lisp/progmodes/etags.el (etags-xref-find): Remove. (xref-backend-identifier-completion-table) (xref-backend-references, xref-backend-definitions) (xref-backend-apropos): New generic methods. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index af2ea56..2c22483 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -228,8 +228,7 @@ Blank lines separate paragraphs. Semicolons start comments. \\{emacs-lisp-mode-map}" :group 'lisp - (defvar xref-find-function) - (defvar xref-identifier-completion-table-function) + (defvar xref-backend-functions) (defvar project-library-roots-function) (lisp-mode-variables nil nil 'elisp) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) @@ -239,9 +238,7 @@ Blank lines separate paragraphs. Semicolons start comments. (setq imenu-case-fold-search nil) (add-function :before-until (local 'eldoc-documentation-function) #'elisp-eldoc-documentation-function) - (setq-local xref-find-function #'elisp-xref-find) - (setq-local xref-identifier-completion-table-function - #'elisp--xref-identifier-completion-table) + (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-library-roots-function #'elisp-library-roots) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local)) @@ -588,21 +585,7 @@ It can be quoted, or be inside a quoted form." (declare-function xref-make "xref" (summary location)) (declare-function xref-collect-references "xref" (symbol dir)) -(defun elisp-xref-find (action id) - (require 'find-func) - ;; FIXME: use information in source near point to filter results: - ;; (dvc-log-edit ...) - exclude 'feature - ;; (require 'dvc-log-edit) - only 'feature - ;; Semantic may provide additional information - (pcase action - (`definitions - (let ((sym (intern-soft id))) - (when sym - (elisp--xref-find-definitions sym)))) - (`references - (elisp--xref-find-references id)) - (`apropos - (elisp--xref-find-apropos id)))) +(defun elisp--xref-backend () 'elisp) ;; WORKAROUND: This is nominally a constant, but the text properties ;; are not preserved thru dump if use defconst. See bug#21237. @@ -638,7 +621,17 @@ Each function should return a list of xrefs, or nil; the first non-nil result supercedes the xrefs produced by `elisp--xref-find-definitions'.") -;; FIXME: name should be singular; match xref-find-definition +(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier) + (require 'find-func) + ;; FIXME: use information in source near point to filter results: + ;; (dvc-log-edit ...) - exclude 'feature + ;; (require 'dvc-log-edit) - only 'feature + ;; Semantic may provide additional information + ;; + (let ((sym (intern-soft identifier))) + (when sym + (elisp--xref-find-definitions sym)))) + (defun elisp--xref-find-definitions (symbol) ;; The file name is not known when `symbol' is defined via interactive eval. (let (xrefs) @@ -805,7 +798,7 @@ non-nil result supercedes the xrefs produced by (declare-function project-roots "project") (declare-function project-current "project") -(defun elisp--xref-find-references (symbol) +(cl-defmethod xref-backend-references ((_backend (eql elisp)) symbol) "Find all references to SYMBOL (a string) in the current project." (cl-mapcan (lambda (dir) @@ -815,7 +808,7 @@ non-nil result supercedes the xrefs produced by (project-roots pr) (project-library-roots pr))))) -(defun elisp--xref-find-apropos (regexp) +(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp) (apply #'nconc (let (lst) (dolist (sym (apropos-internal regexp)) @@ -832,7 +825,7 @@ non-nil result supercedes the xrefs produced by (facep sym))) 'strict)) -(defun elisp--xref-identifier-completion-table () +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp))) elisp--xref-identifier-completion-table) (cl-defstruct (xref-elisp-location diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 38c5cc2..ae1aa11 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2084,17 +2084,12 @@ for \\[find-tag] (which see)." (defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p tag-implicit-name-match-p) - "Tag order used in `etags-xref-find' to look for definitions.") + "Tag order used in `xref-backend-definitions' to look for definitions.") -;;;###autoload -(defun etags-xref-find (action id) - (pcase action - (`definitions (etags--xref-find-definitions id)) - (`references (etags--xref-find-references id)) - (`apropos (etags--xref-find-definitions id t)))) - -(defun etags--xref-find-references (symbol) - ;; TODO: Merge together with the Elisp impl. +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags))) + (tags-lazy-completion-table)) + +(cl-defmethod xref-backend-references ((_backend (eql etags)) symbol) (cl-mapcan (lambda (dir) (xref-collect-references symbol dir)) @@ -2103,6 +2098,12 @@ for \\[find-tag] (which see)." (project-roots pr) (project-library-roots pr))))) +(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol) + (etags--xref-find-definitions symbol)) + +(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol) + (etags--xref-find-definitions symbol t)) + (defun etags--xref-find-definitions (pattern &optional regexp?) ;; This emulates the behaviour of `find-tag-in-order' but instead of ;; returning one match at a time all matches are returned as list. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 8675c95..489a2ec 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -23,14 +23,21 @@ ;; referencing commands, in particular "find-definition". ;; ;; Some part of the functionality must be implemented in a language -;; dependent way and that's done by defining `xref-find-function', -;; `xref-identifier-at-point-function' and -;; `xref-identifier-completion-table-function', which see. +;; dependent way and that's done by defining an xref backend. ;; -;; A major mode should make these variables buffer-local first. +;; That consists of a constructor function, which should return a +;; backend value, and a set of implementations for the generic +;; functions: ;; -;; `xref-find-function' can be called in several ways, see its -;; description. It has to operate with "xref" and "location" values. +;; `xref-backend-identifier-at-point', +;; `xref-backend-identifier-completion-table', +;; `xref-backend-definitions', `xref-backend-references', +;; `xref-backend-apropos', which see. +;; +;; A major mode would normally use `add-hook' to add the backend +;; constructor to `xref-backend-functions'. +;; +;; The last three methods operate with "xref" and "location" values. ;; ;; One would usually call `make-xref' and `xref-make-file-location', ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create @@ -46,12 +53,11 @@ ;; Each identifier must be represented as a string. Implementers can ;; use string properties to store additional information about the ;; identifier, but they should keep in mind that values returned from -;; `xref-identifier-completion-table-function' should still be +;; `xref-backend-identifier-completion-table' should still be ;; distinct, because the user can't see the properties when making the ;; choice. ;; -;; See the functions `etags-xref-find' and `elisp-xref-find' for full -;; examples. +;; See the etags and elisp-mode implementations for full examples. ;;; Code: @@ -195,35 +201,46 @@ LENGTH is the match length, in characters." ;;; API -(declare-function etags-xref-find "etags" (action id)) -(declare-function tags-lazy-completion-table "etags" ()) +;; We make the etags backend the default for now, until something +;; better comes along. +(defvar xref-backend-functions (list #'xref--etags-backend) + "Special hook to find the xref backend for the current context. +Each functions on this hook is called in turn with no arguments +and should return either nil to mean that it is not applicable, +or an xref backend, which is a value to be used to dispatch the +generic functions.") -;; For now, make the etags backend the default. -(defvar xref-find-function #'etags-xref-find - "Function to look for cross-references. -It can be called in several ways: +(defun xref-find-backend () + (run-hook-with-args-until-success 'xref-backend-functions)) - (definitions IDENTIFIER): Find definitions of IDENTIFIER. The -result must be a list of xref objects. If IDENTIFIER contains -sufficient information to determine a unique definition, returns -only that definition. If there are multiple possible definitions, -return all of them. If no definitions can be found, return nil. +(defun xref--etags-backend () 'etags) - (references IDENTIFIER): Find references of IDENTIFIER. The -result must be a list of xref objects. If no references can be -found, return nil. +(cl-defgeneric xref-backend-definitions (backend identifier) + "Find definitions of IDENTIFIER. - (apropos PATTERN): Find all symbols that match PATTERN. PATTERN -is a regexp. +The result must be a list of xref objects. If IDENTIFIER +contains sufficient information to determine a unique definition, +return only that definition. If there are multiple possible +definitions, return all of them. If no definitions can be found, +return nil. IDENTIFIER can be any string returned by -`xref-identifier-at-point-function', or from the table returned -by `xref-identifier-completion-table-function'. +`xref-backend-identifier-at-point', or from the table returned by +`xref-backend-identifier-completion-table'. To create an xref object, call `xref-make'.") -(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point - "Function to get the relevant identifier at point. +(cl-defgeneric xref-backend-references (backend identifier) + "Find references of IDENTIFIER. +The result must be a list of xref objects. If no references can +be found, return nil.") + +(cl-defgeneric xref-backend-apropos (backend pattern) + "Find all symbols that match PATTERN. +PATTERN is a regexp") + +(cl-defgeneric xref-backend-identifier-at-point (_backend) + "Return the relevant identifier at point. The return value must be a string or nil. nil means no identifier at point found. @@ -231,16 +248,14 @@ identifier at point found. If it's hard to determine the identifier precisely (e.g., because it's a method call on unknown type), the implementation can return a simple string (such as symbol at point) marked with a -special text property which `xref-find-function' would recognize -and then delegate the work to an external process.") - -(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table - "Function that returns the completion table for identifiers.") - -(defun xref-default-identifier-at-point () +special text property which e.g. `xref-backend-definitions' would +recognize and then delegate the work to an external process." (let ((thing (thing-at-point 'symbol))) (and thing (substring-no-properties thing)))) +(cl-defgeneric xref-backend-identifier-completion-table (backend) + "Returns the completion table for identifiers.") + ;;; misc utilities (defun xref--alistify (list key test) @@ -690,7 +705,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--read-identifier (prompt) "Return the identifier at point or read it from the minibuffer." - (let ((id (funcall xref-identifier-at-point-function))) + (let* ((backend (xref-find-backend)) + (id (xref-backend-identifier-at-point backend))) (cond ((or current-prefix-arg (not id) (xref--prompt-p this-command)) @@ -700,7 +716,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." "[ :]+\\'" prompt)) id) prompt) - (funcall xref-identifier-completion-table-function) + (xref-backend-identifier-completion-table backend) nil nil nil 'xref--read-identifier-history id)) (t id)))) @@ -709,7 +725,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." ;;; Commands (defun xref--find-xrefs (input kind arg window) - (let ((xrefs (funcall xref-find-function kind arg))) + (let ((xrefs (funcall (intern (format "xref-backend-%s" kind)) + (xref-find-backend) + arg))) (unless xrefs (user-error "No %s found for: %s" (symbol-name kind) input)) (xref--show-xrefs xrefs window))) @@ -824,6 +842,8 @@ tools are used, and when." (cl-mapcan (lambda (hit) (xref--collect-matches hit (format "\\_<%s\\_>" (regexp-quote symbol)))) hits) + ;; TODO: Implement "lightweight" buffer visiting, so that we + ;; don't have to kill them. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -856,6 +876,7 @@ IGNORES is a list of glob patterns." (unwind-protect (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp)) (nreverse hits)) + ;; TODO: Same as above. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) commit 31f6e939334180add7bc11240343615a2e6350f6 Author: Juri Linkov Date: Sat Nov 14 01:28:03 2015 +0200 Support rectangular regions for more commands * lisp/simple.el (region-extract-function): Handle the arg value ‘bounds’. (region-insert-function): New function. (shell-command-on-region): Add arg ‘region-noncontiguous-p’. If non-nil, operate on multiple chunks. (region-noncontiguous-p): New function. * lisp/rect.el: Add function rectangle--insert-region around region-insert-function. (extract-rectangle-bounds): New function. (rectangle--extract-region): Handle the arg value ‘bounds’. (rectangle--insert-region): New function. * lisp/emulation/cua-rect.el: Add function cua--insert-rectangle around region-insert-function. (cua--extract-rectangle-bounds): New function. (cua--rectangle-region-extract): Handle the arg value ‘bounds’. * lisp/replace.el (query-replace, query-replace-regexp): Add arg ‘region-noncontiguous-p’. Use ‘use-region-p’. (query-replace-regexp-eval, map-query-replace-regexp) (replace-string, replace-regexp): Use ‘use-region-p’. (keep-lines, flush-lines, how-many): Use ‘use-region-p’. (perform-replace): Add arg ‘region-noncontiguous-p’. If non-nil, operate on multiple chunks. * src/casefiddle.c (Fdowncase_region): Add arg ‘region-noncontiguous-p’. If non-nil, operate on multiple chunks. (Bug#19829) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index ea8b524..d389f6e 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -666,6 +666,22 @@ If command is repeated at same position, delete the rectangle." (setq rect (cons row rect)))))) (nreverse rect))) +(defun cua--extract-rectangle-bounds () + (let (rect) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil nil nil nil ; do not tabify + (lambda (s e _l _r) + (setq rect (cons (cons s e) rect)))) + (cua--rectangle-operation nil 1 nil nil nil ; do not tabify + (lambda (s e l r _v) + (goto-char s) + (move-to-column l) + (setq s (point)) + (move-to-column r) + (setq e (point)) + (setq rect (cons (cons s e) rect))))) + (nreverse rect))) + (defun cua--insert-rectangle (rect &optional below paste-column line-count) ;; Insert rectangle as insert-rectangle, but don't set mark and exit with ;; point at either next to top right or below bottom left corner @@ -1394,6 +1410,8 @@ With prefix arg, indent to that column." (add-function :around region-extract-function #'cua--rectangle-region-extract) +(add-function :around region-insert-function + #'cua--insert-rectangle) (add-function :around redisplay-highlight-region-function #'cua--rectangle-highlight-for-redisplay) @@ -1405,8 +1423,12 @@ With prefix arg, indent to that column." (defun cua--rectangle-region-extract (orig &optional delete) (cond - ((not cua--rectangle) (funcall orig delete)) - ((eq delete 'delete-only) (cua--delete-rectangle)) + ((not cua--rectangle) + (funcall orig delete)) + ((eq delete 'bounds) + (cua--extract-rectangle-bounds)) + ((eq delete 'delete-only) + (cua--delete-rectangle)) (t (let* ((strs (cua--extract-rectangle)) (str (mapconcat #'identity strs "\n"))) diff --git a/lisp/rect.el b/lisp/rect.el index acd3a48..46ebbf2 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -257,6 +257,19 @@ Return it as a list of strings, one for each line of the rectangle." (apply-on-rectangle 'extract-rectangle-line start end lines) (nreverse (cdr lines)))) +(defun extract-rectangle-bounds (start end) + "Return the bounds of the rectangle with corners at START and END. +Return it as a list of (START . END) positions, one for each line of +the rectangle." + (let (bounds) + (apply-on-rectangle + (lambda (startcol endcol) + (move-to-column startcol) + (push (cons (prog1 (point) (move-to-column endcol)) (point)) + bounds)) + start end) + (nreverse bounds))) + (defvar killed-rectangle nil "Rectangle for `yank-rectangle' to insert.") @@ -563,6 +576,8 @@ with a prefix argument, prompt for START-AT and FORMAT." #'rectangle--unhighlight-for-redisplay) (add-function :around region-extract-function #'rectangle--extract-region) +(add-function :around region-insert-function + #'rectangle--insert-region) (defvar rectangle-mark-mode-map (let ((map (make-sparse-keymap))) @@ -681,8 +696,12 @@ Ignores `line-move-visual'." (defun rectangle--extract-region (orig &optional delete) - (if (not rectangle-mark-mode) - (funcall orig delete) + (cond + ((not rectangle-mark-mode) + (funcall orig delete)) + ((eq delete 'bounds) + (extract-rectangle-bounds (region-beginning) (region-end))) + (t (let* ((strs (funcall (if delete #'delete-extract-rectangle #'extract-rectangle) @@ -696,7 +715,14 @@ Ignores `line-move-visual'." (put-text-property 0 (length str) 'yank-handler `(rectangle--insert-for-yank ,strs t) str) - str)))) + str))))) + +(defun rectangle--insert-region (orig strings) + (cond + ((not rectangle-mark-mode) + (funcall orig strings)) + (t + (funcall #'insert-rectangle strings)))) (defun rectangle--insert-for-yank (strs) (push (point) buffer-undo-list) diff --git a/lisp/replace.el b/lisp/replace.el index d6590c5..b6802ae 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -284,7 +284,7 @@ the original string if not." (and current-prefix-arg (not (eq current-prefix-arg '-))) (and current-prefix-arg (eq current-prefix-arg '-))))) -(defun query-replace (from-string to-string &optional delimited start end backward) +(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -328,22 +328,21 @@ To customize possible responses, change the bindings in `query-replace-map'." (if current-prefix-arg (if (eq current-prefix-arg '-) " backward" " word") "") - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace from-string to-string t nil delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map "%" 'query-replace) -(defun query-replace-regexp (regexp to-string &optional delimited start end backward) +(defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -408,18 +407,17 @@ Use \\[repeat-complex-command] after this command for details." (if (eq current-prefix-arg '-) " backward" " word") "") " regexp" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace regexp to-string t t delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map [?\C-%] 'query-replace-regexp) @@ -485,10 +483,8 @@ for Lisp calls." "22.1")) ;; and the user might enter a single token. (replace-match-string-symbols to) (list from (car to) current-prefix-arg - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)))))) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)))))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) t 'literal delimited nil nil start end)) @@ -523,10 +519,8 @@ Fourth and fifth arg START and END specify the region to operate on." (list from to (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end))))) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end))))) (let (replacements) (if (listp to-strings) (setq replacements to-strings) @@ -587,13 +581,11 @@ and TO-STRING is also null.)" (if (eq current-prefix-arg '-) " backward" " word") "") " string" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) (nth 3 common)))) (perform-replace from-string to-string nil nil delimited nil nil start end backward)) @@ -661,13 +653,11 @@ which will run faster and will not set the mark or print anything." (if (eq current-prefix-arg '-) " backward" " word") "") " regexp" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) (nth 3 common)))) (perform-replace regexp to-string nil t delimited nil nil start end backward)) @@ -832,7 +822,7 @@ a previously found match." (unless (or (bolp) (eobp)) (forward-line 0)) (point-marker))))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (progn (goto-char (region-end)) @@ -901,7 +891,7 @@ starting on the same line at which another match ended is ignored." (progn (goto-char (min rstart rend)) (setq rend (copy-marker (max rstart rend)))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (copy-marker (region-end))) (setq rstart (point) @@ -951,7 +941,7 @@ a previously found match." (setq rend (max rstart rend))) (goto-char rstart) (setq rend (point-max))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (region-end)) (setq rstart (point) @@ -2068,7 +2058,7 @@ It is called with three arguments, as if it were (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag - &optional repeat-count map start end backward) + &optional repeat-count map start end backward region-noncontiguous-p) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: @@ -2115,6 +2105,9 @@ It must return a string." ;; If non-nil, it is marker saying where in the buffer to stop. (limit nil) + ;; Use local binding in add-function below. + (isearch-filter-predicate isearch-filter-predicate) + (region-bounds nil) ;; Data for the next match. If a cons, it has the same format as ;; (match-data); otherwise it is t if a match is possible at point. @@ -2127,6 +2120,24 @@ It must return a string." "Query replacing %s with %s: (\\\\[help] for help) ") minibuffer-prompt-properties)))) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (when region-noncontiguous-p + (setq region-bounds + (mapcar (lambda (position) + (cons (copy-marker (car position)) + (copy-marker (cdr position)))) + (funcall region-extract-function 'bounds))) + (add-function :after-while isearch-filter-predicate + (lambda (start end) + (delq nil (mapcar + (lambda (bounds) + (and + (>= start (car bounds)) + (<= start (cdr bounds)) + (>= end (car bounds)) + (<= end (cdr bounds)))) + region-bounds))))) + ;; If region is active, in Transient Mark mode, operate on region. (if backward (when end diff --git a/lisp/simple.el b/lisp/simple.el index b115a2a..deb5c88 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -970,15 +970,34 @@ instead of deleted." (defvar region-extract-function (lambda (delete) (when (region-beginning) - (if (eq delete 'delete-only) - (delete-region (region-beginning) (region-end)) - (filter-buffer-substring (region-beginning) (region-end) delete)))) + (cond + ((eq delete 'bounds) + (list (cons (region-beginning) (region-end)))) + ((eq delete 'delete-only) + (delete-region (region-beginning) (region-end))) + (t + (filter-buffer-substring (region-beginning) (region-end) delete))))) "Function to get the region's content. Called with one argument DELETE. If DELETE is `delete-only', then only delete the region and the return value is undefined. If DELETE is nil, just return the content as a string. +If DELETE is `bounds', then don't delete, but just return the +boundaries of the region as a list of (START . END) positions. If anything else, delete the region and return its content as a string.") +(defvar region-insert-function + (lambda (lines) + (let ((first t)) + (while lines + (or first + (insert ?\n)) + (insert-for-yank (car lines)) + (setq lines (cdr lines) + first nil)))) + "Function to insert the region's content. +Called with one argument LINES. +Insert the region as a list of lines.") + (defun delete-backward-char (n &optional killflag) "Delete the previous N characters (following if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, @@ -3419,7 +3438,8 @@ and only used if a buffer is displayed." (defun shell-command-on-region (start end command &optional output-buffer replace - error-buffer display-error-buffer) + error-buffer display-error-buffer + region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. Return the exit code of @@ -3482,7 +3502,8 @@ interactively, this is t." current-prefix-arg current-prefix-arg shell-command-default-error-buffer - t))) + t + (region-noncontiguous-p)))) (let ((error-file (if error-buffer (make-temp-file @@ -3491,96 +3512,109 @@ interactively, this is t." temporary-file-directory))) nil)) exit-status) - (if (or replace - (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer))))) - ;; Replace specified region with output from command. - (let ((swap (and replace (< start end)))) - ;; Don't muck with mark unless REPLACE says we should. - (goto-char start) - (and replace (push-mark (point) 'nomsg)) - (setq exit-status - (call-process-region start end shell-file-name replace - (if error-file - (list t error-file) - t) - nil shell-command-switch command)) - ;; It is rude to delete a buffer which the command is not using. - ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) - ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) - ;; (kill-buffer shell-buffer))) - ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark))) - ;; No prefix argument: put the output in a temp buffer, - ;; replacing its entire contents. - (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) - (unwind-protect - (if (eq buffer (current-buffer)) - ;; If the input is the same buffer as the output, - ;; delete everything but the specified region, - ;; then replace that region with the output. - (progn (setq buffer-read-only nil) - (delete-region (max start end) (point-max)) - (delete-region (point-min) (min start end)) - (setq exit-status - (call-process-region (point-min) (point-max) - shell-file-name t - (if error-file - (list t error-file) - t) - nil shell-command-switch - command))) - ;; Clear the output buffer, then run the command with - ;; output there. - (let ((directory default-directory)) - (with-current-buffer buffer - (setq buffer-read-only nil) - (if (not output-buffer) - (setq default-directory directory)) - (erase-buffer))) - (setq exit-status - (call-process-region start end shell-file-name nil - (if error-file - (list buffer error-file) - buffer) - nil shell-command-switch command))) - ;; Report the output. - (with-current-buffer buffer - (setq mode-line-process - (cond ((null exit-status) - " - Error") - ((stringp exit-status) - (format " - Signal [%s]" exit-status)) - ((not (equal 0 exit-status)) - (format " - Exit [%d]" exit-status))))) - (if (with-current-buffer buffer (> (point-max) (point-min))) - ;; There's some output, display it - (display-message-or-buffer buffer) - ;; No output; error? - (let ((output - (if (and error-file - (< 0 (nth 7 (file-attributes error-file)))) - (format "some error output%s" - (if shell-command-default-error-buffer - (format " to the \"%s\" buffer" - shell-command-default-error-buffer) - "")) - "no output"))) - (cond ((null exit-status) - (message "(Shell command failed with error)")) - ((equal 0 exit-status) - (message "(Shell command succeeded with %s)" - output)) - ((stringp exit-status) - (message "(Shell command killed by signal %s)" - exit-status)) - (t - (message "(Shell command failed with code %d and %s)" - exit-status output)))) - ;; Don't kill: there might be useful info in the undo-log. - ;; (kill-buffer buffer) - )))) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (if region-noncontiguous-p + (let ((input (concat (funcall region-extract-function 'delete) "\n")) + output) + (with-temp-buffer + (insert input) + (call-process-region (point-min) (point-max) + shell-file-name t t + nil shell-command-switch + command) + (setq output (split-string (buffer-string) "\n"))) + (goto-char start) + (funcall region-insert-function output)) + (if (or replace + (and output-buffer + (not (or (bufferp output-buffer) (stringp output-buffer))))) + ;; Replace specified region with output from command. + (let ((swap (and replace (< start end)))) + ;; Don't muck with mark unless REPLACE says we should. + (goto-char start) + (and replace (push-mark (point) 'nomsg)) + (setq exit-status + (call-process-region start end shell-file-name replace + (if error-file + (list t error-file) + t) + nil shell-command-switch command)) + ;; It is rude to delete a buffer which the command is not using. + ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) + ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) + ;; (kill-buffer shell-buffer))) + ;; Don't muck with mark unless REPLACE says we should. + (and replace swap (exchange-point-and-mark))) + ;; No prefix argument: put the output in a temp buffer, + ;; replacing its entire contents. + (let ((buffer (get-buffer-create + (or output-buffer "*Shell Command Output*")))) + (unwind-protect + (if (eq buffer (current-buffer)) + ;; If the input is the same buffer as the output, + ;; delete everything but the specified region, + ;; then replace that region with the output. + (progn (setq buffer-read-only nil) + (delete-region (max start end) (point-max)) + (delete-region (point-min) (min start end)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (if error-file + (list t error-file) + t) + nil shell-command-switch + command))) + ;; Clear the output buffer, then run the command with + ;; output there. + (let ((directory default-directory)) + (with-current-buffer buffer + (setq buffer-read-only nil) + (if (not output-buffer) + (setq default-directory directory)) + (erase-buffer))) + (setq exit-status + (call-process-region start end shell-file-name nil + (if error-file + (list buffer error-file) + buffer) + nil shell-command-switch command))) + ;; Report the output. + (with-current-buffer buffer + (setq mode-line-process + (cond ((null exit-status) + " - Error") + ((stringp exit-status) + (format " - Signal [%s]" exit-status)) + ((not (equal 0 exit-status)) + (format " - Exit [%d]" exit-status))))) + (if (with-current-buffer buffer (> (point-max) (point-min))) + ;; There's some output, display it + (display-message-or-buffer buffer) + ;; No output; error? + (let ((output + (if (and error-file + (< 0 (nth 7 (file-attributes error-file)))) + (format "some error output%s" + (if shell-command-default-error-buffer + (format " to the \"%s\" buffer" + shell-command-default-error-buffer) + "")) + "no output"))) + (cond ((null exit-status) + (message "(Shell command failed with error)")) + ((equal 0 exit-status) + (message "(Shell command succeeded with %s)" + output)) + ((stringp exit-status) + (message "(Shell command killed by signal %s)" + exit-status)) + (t + (message "(Shell command failed with code %d and %s)" + exit-status output)))) + ;; Don't kill: there might be useful info in the undo-log. + ;; (kill-buffer buffer) + ))))) (when (and error-file (file-exists-p error-file)) (if (< 0 (nth 7 (file-attributes error-file))) @@ -5175,6 +5209,11 @@ also checks the value of `use-empty-active-region'." ;; region is active when there's no mark. (progn (cl-assert (mark)) t))) +(defun region-noncontiguous-p () + "Return non-nil if the region contains several pieces. +An example is a rectangular region handled as a list of +separate contiguous regions for each line." + (> (length (funcall region-extract-function 'bounds)) 1)) (defvar redisplay-unhighlight-region-function (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) diff --git a/src/casefiddle.c b/src/casefiddle.c index b94ea8e..6a2983e 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -306,14 +306,30 @@ See also `capitalize-region'. */) return Qnil; } -DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", +DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, + "(list (region-beginning) (region-end) (region-noncontiguous-p))", doc: /* Convert the region to lower case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. */) - (Lisp_Object beg, Lisp_Object end) + (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) { - casify_region (CASE_DOWN, beg, end); + Lisp_Object bounds = Qnil; + + if (!NILP (region_noncontiguous_p)) + { + bounds = call1 (Fsymbol_value (intern ("region-extract-function")), + intern ("bounds")); + + while (CONSP (bounds)) + { + casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds))); + bounds = XCDR (bounds); + } + } + else + casify_region (CASE_DOWN, beg, end); + return Qnil; } commit f103a2771bc8691f00b331ec25aa5c0477c2089a Author: Dmitry Gutov Date: Mon Nov 9 05:24:23 2015 +0200 Handle multiple matches on the same line; add highlighting * lisp/progmodes/xref.el (xref-location-marker): Interpret the column value in characters. (xref--collect-matches): Rename from `xref--collect-match'. Search for all matches in the hit line. Add `highlight' face to the matched region in the summary. Update both callers. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index c6af6c2..8675c95 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -114,7 +114,7 @@ Line numbers start from 1 and columns from 0.") (save-excursion (goto-char (point-min)) (beginning-of-line line) - (move-to-column column) + (forward-char column) (point-marker)))))) (cl-defmethod xref-location-group ((l xref-file-location)) @@ -821,10 +821,9 @@ tools are used, and when." (hits (and res (oref res hit-lines))) (orig-buffers (buffer-list))) (unwind-protect - (delq nil - (mapcar (lambda (hit) (xref--collect-match - hit (format "\\_<%s\\_>" (regexp-quote symbol)))) - hits)) + (cl-mapcan (lambda (hit) (xref--collect-matches + hit (format "\\_<%s\\_>" (regexp-quote symbol)))) + hits) (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -855,9 +854,8 @@ IGNORES is a list of glob patterns." (match-string 1)) hits))) (unwind-protect - (delq nil - (mapcar (lambda (hit) (xref--collect-match hit regexp)) - (nreverse hits))) + (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp)) + (nreverse hits)) (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -913,7 +911,7 @@ IGNORES is a list of glob patterns." (match-string 1 str))))) str t t)) -(defun xref--collect-match (hit regexp) +(defun xref--collect-matches (hit regexp) (pcase-let* ((`(,line . ,file) hit) (buf (or (find-buffer-visiting file) (semantic-find-file-noselect file)))) @@ -921,18 +919,22 @@ IGNORES is a list of glob patterns." (save-excursion (goto-char (point-min)) (forward-line (1- line)) - (syntax-propertize (line-end-position)) - ;; TODO: Handle multiple matches per line. - (when (re-search-forward regexp (line-end-position) t) - (goto-char (match-beginning 0)) - (let ((loc (xref-make-file-location file line - (current-column)))) - (goto-char (match-end 0)) - (xref-make-match (buffer-substring - (line-beginning-position) - (line-end-position)) - loc - (- (match-end 0) (match-beginning 0))))))))) + (let ((line-end (line-end-position)) + (line-beg (line-beginning-position)) + matches) + (syntax-propertize line-end) + ;; FIXME: This results in several lines with the same + ;; summary. Solve with composite pattern? + (while (re-search-forward regexp line-end t) + (let* ((beg-column (- (match-beginning 0) line-beg)) + (end-column (- (match-end 0) line-beg)) + (loc (xref-make-file-location file line beg-column)) + (summary (buffer-substring line-beg line-end))) + (add-face-text-property beg-column end-column 'highlight + t summary) + (push (xref-make-match summary loc (- end-column beg-column)) + matches))) + (nreverse matches)))))) (provide 'xref) commit fe973fc270f231f386fc5b26c9fced8925593ecb Author: Dmitry Gutov Date: Sun Nov 8 05:01:05 2015 +0200 Replace xref-match-bounds with xref-match-length Relying on xref-location-marker to point to the beginning of the match * lisp/progmodes/xref.el (xref-match-bounds): Remove. (xref-match-length): Add. (xref-make-match): Change the arguments. (xref--match-buffer-bounds): Remove. (xref-match-item): Store length, instead of end-column. (xref-pulse-momentarily) (xref--collect-match) (xref--query-replace-1): Update accordingly. (xref-query-replace): Ditto. And check that the search results are up-to-date. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 89a0604..c6af6c2 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -38,6 +38,11 @@ ;; class inheriting from `xref-location' and implementing ;; `xref-location-group' and `xref-location-marker'. ;; +;; There's a special kind of xrefs we call "match xrefs", which +;; correspond to search results. For these values, +;; `xref-match-length' must be defined, and `xref-location-marker' +;; must return the beginning of the match. +;; ;; Each identifier must be represented as a string. Implementers can ;; use string properties to store additional information about the ;; identifier, but they should keep in mind that values returned from @@ -79,8 +84,8 @@ This is typically the filename.") "Return the line number corresponding to the location." nil) -(cl-defgeneric xref-match-bounds (_item) - "Return a cons with columns of the beginning and end of the match." +(cl-defgeneric xref-match-length (_item) + "Return the length of the match." nil) ;;;; Commonly needed location classes are defined here: @@ -176,22 +181,16 @@ LOCATION is an `xref-location'." (location :initarg :location :type xref-file-location :reader xref-item-location) - (end-column :initarg :end-column)) - :comment "An xref item describes a reference to a location -somewhere.") - -(cl-defmethod xref-match-bounds ((i xref-match-item)) - (with-slots (end-column location) i - (cons (xref-file-location-column location) - end-column))) + (length :initarg :length :reader xref-match-length)) + :comment "A match xref item describes a search result.") -(defun xref-make-match (summary end-column location) +(defun xref-make-match (summary location length) "Create and return a new `xref-match-item'. SUMMARY is a short string to describe the xref. -END-COLUMN is the match end column number inside SUMMARY. -LOCATION is an `xref-location'." - (make-instance 'xref-match-item :summary summary :location location - :end-column end-column)) +LOCATION is an `xref-location'. +LENGTH is the match length, in characters." + (make-instance 'xref-match-item :summary summary + :location location :length length)) ;;; API @@ -345,22 +344,14 @@ elements is negated." (pcase-let ((`(,beg . ,end) (save-excursion (or - (xref--match-buffer-bounds xref--current-item) + (let ((length (xref-match-length xref--current-item))) + (and length (cons (point) (+ (point) length)))) (back-to-indentation) (if (eolp) (cons (line-beginning-position) (1+ (point))) (cons (point) (line-end-position))))))) (pulse-momentary-highlight-region beg end 'next-error))) -(defun xref--match-buffer-bounds (item) - (save-excursion - (let ((bounds (xref-match-bounds item))) - (when bounds - (cons (progn (move-to-column (car bounds)) - (point)) - (progn (move-to-column (cdr bounds)) - (point))))))) - ;; etags.el needs this (defun xref-clear-marker-stack () "Discard all markers from the marker stack." @@ -487,50 +478,54 @@ WINDOW controls how the buffer is displayed: (progn (save-excursion (goto-char (point-min)) - ;; TODO: Check that none of the matches are out of date; - ;; offer to re-scan otherwise. Note that saving the last - ;; modification tick won't work, as long as not all of the - ;; buffers are kept open. (while (setq item (xref--search-property 'xref-item)) - (when (xref-match-bounds item) + (when (xref-match-length item) (save-excursion - ;; FIXME: Get rid of xref--goto-location, by making - ;; xref-match-bounds return markers already. - (xref--goto-location (xref-item-location item)) - (let ((bounds (xref--match-buffer-bounds item)) - (beg (make-marker)) - (end (make-marker))) - (move-marker beg (car bounds)) - (move-marker end (cdr bounds)) - (push (cons beg end) pairs))))) + (let* ((loc (xref-item-location item)) + (beg (xref-location-marker loc)) + (len (xref-match-length item))) + ;; Perform sanity check first. + (xref--goto-location loc) + ;; FIXME: The check should probably be a generic + ;; function, instead of the assumption that all + ;; matches contain the full line as summary. + ;; TODO: Offer to re-scan otherwise. + (unless (equal (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)) + (xref-item-summary item)) + (user-error "Search results out of date")) + (push (cons beg len) pairs))))) (setq pairs (nreverse pairs))) (unless pairs (user-error "No suitable matches here")) (xref--query-replace-1 from to pairs)) (dolist (pair pairs) - (move-marker (car pair) nil) - (move-marker (cdr pair) nil))))) + (move-marker (car pair) nil))))) +;; FIXME: Write a nicer UI. (defun xref--query-replace-1 (from to pairs) (let* ((query-replace-lazy-highlight nil) - current-pair current-buf + current-beg current-len current-buf ;; Counteract the "do the next match now" hack in ;; `perform-replace'. And still, it'll report that those ;; matches were "filtered out" at the end. (isearch-filter-predicate (lambda (beg end) - (and current-pair + (and current-beg (eq (current-buffer) current-buf) - (>= beg (car current-pair)) - (<= end (cdr current-pair))))) + (>= beg current-beg) + (<= end (+ current-beg current-len))))) (replace-re-search-function (lambda (from &optional _bound noerror) - (let (found) + (let (found pair) (while (and (not found) pairs) - (setq current-pair (pop pairs) - current-buf (marker-buffer (car current-pair))) + (setq pair (pop pairs) + current-beg (car pair) + current-len (cdr pair) + current-buf (marker-buffer current-beg)) (pop-to-buffer current-buf) - (goto-char (car current-pair)) - (when (re-search-forward from (cdr current-pair) noerror) + (goto-char current-beg) + (when (re-search-forward from (+ current-beg current-len) noerror) (setq found t))) found)))) ;; FIXME: Despite this being a multi-buffer replacement, `N' @@ -936,8 +931,8 @@ IGNORES is a list of glob patterns." (xref-make-match (buffer-substring (line-beginning-position) (line-end-position)) - (current-column) - loc))))))) + loc + (- (match-end 0) (match-beginning 0))))))))) (provide 'xref) commit 92a501022e0154cd9de41240680b7f003a833c96 Author: Paul Eggert Date: Fri Nov 13 12:39:13 2015 -0800 Merge from gnulib This incorporates: 2015-11-13 xalloc-oversized: improve performance with GCC 5 * lib/xalloc-oversized.h: Copy from gnulib. diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index f0e9778..0e579de 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -16,9 +16,13 @@ along with this program. If not, see . */ #ifndef XALLOC_OVERSIZED_H_ -# define XALLOC_OVERSIZED_H_ +#define XALLOC_OVERSIZED_H_ -# include +#include + +#ifndef __has_builtin +# define __has_builtin(x) 0 +#endif /* Return 1 if an array of N objects, each of size S, cannot exist due to size arithmetic overflow. S must be positive and N must be @@ -32,7 +36,12 @@ sizeof (ptrdiff_t) <= sizeof (size_t), so do not bother to test for exactly-SIZE_MAX allocations on such hosts; this avoids a test and branch when S is known to be 1. */ +#if 5 <= __GNUC__ || __has_builtin (__builtin_mul_overflow) +# define xalloc_oversized(n, s) \ + ({ size_t __xalloc_size; __builtin_mul_overflow (n, s, &__xalloc_size); }) +#else # define xalloc_oversized(n, s) \ ((size_t) (sizeof (ptrdiff_t) <= sizeof (size_t) ? -1 : -2) / (s) < (n)) +#endif #endif /* !XALLOC_OVERSIZED_H_ */ commit 04ac097f34d887e1ae8dea1e884118728e931c7a Author: Paul Eggert Date: Fri Nov 13 12:02:21 2015 -0800 Spruce up ftfont.c memory allocation * src/ftfont.c (setup_otf_gstring): Avoid O(N**2) behavior when reallocating. (ftfont_shape_by_flt): Prefer xpalloc to xrealloc when reallocating buffers; this simplifies the code. Do not trust mflt_run to leave the output areas unchanged on failure, as this isn’t part of its interface spec. diff --git a/src/ftfont.c b/src/ftfont.c index 57ded17..17e41a9 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -1776,9 +1776,11 @@ setup_otf_gstring (int size) { if (otf_gstring.size < size) { - otf_gstring.glyphs = xnrealloc (otf_gstring.glyphs, - size, sizeof (OTF_Glyph)); - otf_gstring.size = size; + ptrdiff_t new_size = otf_gstring.size; + xfree (otf_gstring.glyphs); + otf_gstring.glyphs = xpalloc (NULL, &new_size, size - otf_gstring.size, + INT_MAX, sizeof *otf_gstring.glyphs); + otf_gstring.size = new_size; } otf_gstring.used = size; memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * size); @@ -2505,8 +2507,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, ptrdiff_t i; struct MFLTFontFT flt_font_ft; MFLT *flt = NULL; - bool with_variation_selector = 0; - MFLTGlyphFT *glyphs; + bool with_variation_selector = false; if (! m17n_flt_initialized) { @@ -2527,7 +2528,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, break; c = LGLYPH_CHAR (g); if (CHAR_VARIATION_SELECTOR_P (c)) - with_variation_selector = 1; + with_variation_selector = true; } len = i; @@ -2561,39 +2562,6 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, } } - int len2; - if (INT_MULTIPLY_WRAPV (len, 2, &len2)) - memory_full (SIZE_MAX); - - if (gstring.allocated == 0) - { - gstring.glyph_size = sizeof (MFLTGlyphFT); - gstring.glyphs = xnmalloc (len2, sizeof (MFLTGlyphFT)); - gstring.allocated = len2; - } - else if (gstring.allocated < len2) - { - gstring.glyphs = xnrealloc (gstring.glyphs, len2, - sizeof (MFLTGlyphFT)); - gstring.allocated = len2; - } - glyphs = (MFLTGlyphFT *) (gstring.glyphs); - memset (glyphs, 0, len * sizeof (MFLTGlyphFT)); - for (i = 0; i < len; i++) - { - Lisp_Object g = LGSTRING_GLYPH (lgstring, i); - - glyphs[i].g.c = LGLYPH_CHAR (g); - if (with_variation_selector) - { - glyphs[i].g.code = LGLYPH_CODE (g); - glyphs[i].g.encoded = 1; - } - } - - gstring.used = len; - gstring.r2l = 0; - { Lisp_Object family = Ffont_get (LGSTRING_FONT (lgstring), QCfamily); @@ -2614,24 +2582,50 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font, flt_font_ft.ft_face = ft_face; flt_font_ft.otf = otf; flt_font_ft.matrix = matrix->xx != 0 ? matrix : 0; - if (len > 1 - && gstring.glyphs[1].c >= 0x300 && gstring.glyphs[1].c <= 0x36F) - /* A little bit ad hoc. Perhaps, shaper must get script and - language information, and select a proper flt for them - here. */ - flt = mflt_get (msymbol ("combining")); - for (i = 0; i < 3; i++) - { - int result = mflt_run (&gstring, 0, len, &flt_font_ft.flt_font, flt); - if (result != -2) - break; - int len2; - if (INT_MULTIPLY_WRAPV (gstring.allocated, 2, &len2)) - memory_full (SIZE_MAX); - gstring.glyphs = xnrealloc (gstring.glyphs, - gstring.allocated, 2 * sizeof (MFLTGlyphFT)); - gstring.allocated = len2; + + if (1 < len) + { + /* A little bit ad hoc. Perhaps, shaper must get script and + language information, and select a proper flt for them + here. */ + int c1 = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 1)); + if (0x300 <= c1 && c1 <= 0x36F) + flt = mflt_get (msymbol ("combining")); + } + + MFLTGlyphFT *glyphs = (MFLTGlyphFT *) gstring.glyphs; + ptrdiff_t allocated = gstring.allocated; + ptrdiff_t incr_min = len - allocated; + + do + { + if (0 < incr_min) + { + xfree (glyphs); + glyphs = xpalloc (NULL, &allocated, incr_min, INT_MAX, sizeof *glyphs); + } + incr_min = 1; + + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (lgstring, i); + memset (&glyphs[i], 0, sizeof glyphs[i]); + glyphs[i].g.c = LGLYPH_CHAR (g); + if (with_variation_selector) + { + glyphs[i].g.code = LGLYPH_CODE (g); + glyphs[i].g.encoded = 1; + } + } + + gstring.glyph_size = sizeof *glyphs; + gstring.glyphs = (MFLTGlyph *) glyphs; + gstring.allocated = allocated; + gstring.used = len; + gstring.r2l = 0; } + while (mflt_run (&gstring, 0, len, &flt_font_ft.flt_font, flt) == -2); + if (gstring.used > LGSTRING_GLYPH_LEN (lgstring)) return Qnil; for (i = 0; i < gstring.used; i++) commit 4c4b520520cf6b99ce7128331a4e108e58095705 Author: Paul Eggert Date: Fri Nov 13 09:28:53 2015 -0800 Port recent XCB changes to 64-bit ‘long int’ For historical reasons, libX11 represents 32-bit values like Atoms as ‘long int’ even on platforms where ‘long int’ is 64 bits. XCB doesn’t do that, so adapt the recent XCB code to behave properly on 64-bit platforms. Also, fix what appears to be a bug in the interpretation of xcb_get_property_value_length, at least on my Fedora platform which is running libxcb-1.11-5.fc21. * src/xfns.c (x_real_pos_and_offsets): * src/xterm.c (get_current_wm_state): xcb_get_property_value_length returns a byte count, not a word count. For 32-bit quantities, xcb_get_property_value returns a vector of 32-bit words, not of (possibly 64-bit) long int. diff --git a/src/xfns.c b/src/xfns.c index 9d90b7b..313ac52 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -450,10 +450,11 @@ x_real_pos_and_offsets (struct frame *f, if (prop) { if (prop->type == target_type - && xcb_get_property_value_length (prop) == 4 - && prop->format == 32) + && prop->format == 32 + && (xcb_get_property_value_length (prop) + == 4 * sizeof (int32_t))) { - long *fe = xcb_get_property_value (prop); + int32_t *fe = xcb_get_property_value (prop); outer_x = -fe[0]; outer_y = -fe[2]; diff --git a/src/xterm.c b/src/xterm.c index 36a914c..acb6566 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10101,17 +10101,19 @@ get_current_wm_state (struct frame *f, bool is_hidden = false; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); long max_len = 65536; - unsigned char *tmp_data = NULL; Atom target_type = XA_ATOM; /* If XCB is available, we can avoid three XSync calls. */ #ifdef USE_XCB xcb_get_property_cookie_t prop_cookie; xcb_get_property_reply_t *prop; + xcb_atom_t *reply_data; #else Display *dpy = FRAME_X_DISPLAY (f); unsigned long bytes_remaining; int rc, actual_format; Atom actual_type; + unsigned char *tmp_data = NULL; + Atom *reply_data; #endif *sticky = false; @@ -10126,8 +10128,10 @@ get_current_wm_state (struct frame *f, prop = xcb_get_property_reply (dpyinfo->xcb_connection, prop_cookie, NULL); if (prop && prop->type == target_type) { - tmp_data = xcb_get_property_value (prop); - actual_size = xcb_get_property_value_length (prop); + int actual_bytes = xcb_get_property_value_length (prop); + eassume (0 <= actual_bytes); + actual_size = actual_bytes / sizeof *reply_data; + reply_data = xcb_get_property_value (prop); } else { @@ -10141,7 +10145,9 @@ get_current_wm_state (struct frame *f, &actual_type, &actual_format, &actual_size, &bytes_remaining, &tmp_data); - if (rc != Success || actual_type != target_type || x_had_errors_p (dpy)) + if (rc == Success && actual_type == target_type && ! x_had_errors_p (dpy)) + reply_data = (Atom *) tmp_data; + else { actual_size = 0; is_hidden = FRAME_ICONIFIED_P (f); @@ -10152,7 +10158,7 @@ get_current_wm_state (struct frame *f, for (i = 0; i < actual_size; ++i) { - Atom a = ((Atom*)tmp_data)[i]; + Atom a = reply_data[i]; if (a == dpyinfo->Xatom_net_wm_state_hidden) is_hidden = true; else if (a == dpyinfo->Xatom_net_wm_state_maximized_horz) commit 4f0ce9c8ef2c5ec1b9cf5bd1af9f54aa6fc335d0 Author: Paul Eggert Date: Fri Nov 13 08:44:14 2015 -0800 * src/undo.c (run_undoable_change): Now static. diff --git a/src/undo.c b/src/undo.c index 0a5da85..214beae 100644 --- a/src/undo.c +++ b/src/undo.c @@ -34,7 +34,7 @@ static ptrdiff_t last_boundary_position; an undo-boundary. */ static Lisp_Object pending_boundary; -void +static void run_undoable_change (void) { call0 (Qundo_auto__undoable_change); commit 695a6f932b208c6e840bda9ddb5f01e81e830c45 Author: Eli Zaretskii Date: Fri Nov 13 15:33:29 2015 +0200 Remove support for ':timeout' from w32 tray notifications * src/w32fns.c (Fw32_notification_notify): Delete the code that supports ':timeout'. (syms_of_w32fns): Don't DEFSYM ':timeout'. This avoids clashes with dbusbind.c when D-Bus is compiled in. * doc/lispref/os.texi (Desktop Notifications): Don't mention ':timeout'. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 53aa0e1..f3c4e29 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2603,12 +2603,6 @@ Notification severity level, one of @code{info}, @code{warning}, or left of the notification title, but only if the @code{:title} parameter (see below) is also specified and is a string. -@item :timeout @var{timeout} -@var{timeout} is the time in seconds after which the notification -disappears. The value can be integer or floating-point. This is -ignored on Vista and later systems, where the duration is fixed at 9 -sec and can only be customized via system-wide Accessibility settings. - @item :title @var{title} The title of the notification. If @var{title} is a string, it is displayed in a larger font immediately above the body text. The title diff --git a/src/w32fns.c b/src/w32fns.c index f2d286d..f3391cb 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -9111,13 +9111,6 @@ The following parameters are supported: parameter (see below) is also specified and is a string. -:timeout TIMEOUT -- TIMEOUT is the time in seconds after which the - notification disappears. The value can be integer - or floating-point. This is ignored on Vista and - later systems, where the duration is fixed at 9 sec - and can only be customized via system-wide - Accessibility settings. - :title TITLE -- The title of the notification. If TITLE is a string, it is displayed in a larger font immediately above the body text. The title text can be up to 63 @@ -9179,13 +9172,6 @@ usage: (w32-notification-notify &rest PARAMS) */) else severity = Ni_Info; - /* Timeout. */ - lres = Fplist_get (arg_plist, QCtimeout); - if (NUMBERP (lres)) - timeout = 1000 * (INTEGERP (lres) ? XINT (lres) : XFLOAT_DATA (lres)); - else - timeout = 0; - /* Title. */ lres = Fplist_get (arg_plist, QCtitle); if (STRINGP (lres)) @@ -9300,7 +9286,6 @@ syms_of_w32fns (void) DEFSYM (QClevel, ":level"); DEFSYM (Qinfo, "info"); DEFSYM (Qwarning, "warning"); - DEFSYM (QCtimeout, ":timeout"); DEFSYM (QCtitle, ":title"); DEFSYM (QCbody, ":body"); #endif commit a731c2f163071ed6efe7d93fa9585dd66ddf2fbb Author: Juanma Barranquero Date: Fri Nov 13 14:09:35 2015 +0100 * test/automated/simple-test.el: Add test for bug#20698 (bug#21885) (simple-test--transpositions): New macro. (simple-transpose-subr): New test. diff --git a/test/automated/simple-test.el b/test/automated/simple-test.el index 86c9fc2..07b5eaa 100644 --- a/test/automated/simple-test.el +++ b/test/automated/simple-test.el @@ -34,6 +34,17 @@ (buffer-substring (point) (point-max))))) +(defmacro simple-test--transpositions (&rest body) + (declare (indent 0) + (debug t)) + `(with-temp-buffer + (emacs-lisp-mode) + (insert "(s1) (s2) (s3) (s4) (s5)") + (backward-sexp 1) + ,@body + (cons (buffer-substring (point-min) (point)) + (buffer-substring (point) (point-max))))) + ;;; `newline' (ert-deftest newline () @@ -233,6 +244,12 @@ (car buffer-undo-list) (undo-auto--boundaries 'test)))) +;;; Transposition with negative args (bug#20698, bug#21885) +(ert-deftest simple-transpose-subr () + (should (equal (simple-test--transpositions (transpose-sexps -1)) + '("(s1) (s2) (s4)" . " (s3) (s5)"))) + (should (equal (simple-test--transpositions (transpose-sexps -2)) + '("(s1) (s4)" . " (s2) (s3) (s5)")))) (provide 'simple-test) commit 2b4c0c0cefa4a70b4b8a3a8f0fa1e13416f7415f Author: Juanma Barranquero Date: Fri Nov 13 11:04:10 2015 +0100 * lisp/progmodes/elisp-mode.el: Declare function `project-roots' diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a19542f..af2ea56 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -802,6 +802,7 @@ non-nil result supercedes the xrefs produced by xrefs)) (declare-function project-library-roots "project") +(declare-function project-roots "project") (declare-function project-current "project") (defun elisp--xref-find-references (symbol) commit 66b9f7bdcfc120e61d01b6f93c9c03e5ed9d17aa Author: Juanma Barranquero Date: Fri Nov 13 10:56:28 2015 +0100 * src/undo.c: Small fixes for previous change (run_undoable_change): Mark void argument list. (record_property_change): Remove unused variable `boundary'. diff --git a/src/undo.c b/src/undo.c index 009ebc0..0a5da85 100644 --- a/src/undo.c +++ b/src/undo.c @@ -35,7 +35,7 @@ static ptrdiff_t last_boundary_position; static Lisp_Object pending_boundary; void -run_undoable_change () +run_undoable_change (void) { call0 (Qundo_auto__undoable_change); } @@ -235,7 +235,6 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, { Lisp_Object lbeg, lend, entry; struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); - bool boundary = false; if (EQ (BVAR (buf, undo_list), Qt)) return; commit 2fac30eb8d8737ee3b553d4d8ec56e1f29551f0f Author: Eli Zaretskii Date: Fri Nov 13 11:56:08 2015 +0200 Add a few more variables to redisplay--variables * lisp/frame.el (redisplay--variables): Add bidi-paragraph-direction and bidi-display-reordering to the list. diff --git a/lisp/frame.el b/lisp/frame.el index 3f31a29..f024065 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2238,7 +2238,9 @@ See also `toggle-frame-maximized'." '(line-spacing overline-margin line-prefix - wrap-prefix)) + wrap-prefix + bidi-paragraph-direction + bidi-display-reordering)) (provide 'frame) commit 04f69f1764301264c9d699be4cec2286249049b9 Author: Eli Zaretskii Date: Fri Nov 13 11:52:53 2015 +0200 * lisp/loadup.el: Enlarge the size of the hash table to 80000. diff --git a/lisp/loadup.el b/lisp/loadup.el index fef111f..f0caa8b 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -73,7 +73,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal :size 70000))) + (setq purify-flag (make-hash-table :test 'equal :size 80000))) (message "Using load-path %s" load-path) commit e221d32daf4c3072a5a368bd813f758711dd6ff5 Author: Eli Barzilay Date: Fri Nov 13 11:46:20 2015 +0200 Fix point positioning after transposing with negative arg * lisp/simple.el (transpose-subr): When invoked with a negative argument, move point to after the transposed text, like we do when invoked with a positive argument. (Bug#21885) diff --git a/lisp/simple.el b/lisp/simple.el index 2781ad0..b115a2a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6634,7 +6634,8 @@ current object." (setq pos1 (funcall aux -1)) (goto-char (car pos1)) (setq pos2 (funcall aux arg)) - (transpose-subr-1 pos1 pos2))))) + (transpose-subr-1 pos1 pos2) + (goto-char (+ (car pos2) (- (cdr pos1) (car pos1)))))))) (defun transpose-subr-1 (pos1 pos2) (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))