diff options
65 files changed, 3682 insertions, 1115 deletions
diff --git a/CONTRIBUTE b/CONTRIBUTE index 2aae251ce42..2d01724a5e0 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -144,10 +144,10 @@ messages: "2014-01-16T05:43:35Z!esr@thyrsus.com". Often, "my previous commit" will suffice. -- There is no need to mention files such as NEWS, MAINTAINERS, and - FOR-RELEASE, or to indicate regeneration of files such as - 'configure', in the ChangeLog entry. "There is no need" means you - don't have to, but you can if you want to. +- There is no need to mention files such as NEWS and MAINTAINERS, or + to indicate regeneration of files such as 'configure', in the + ChangeLog entry. "There is no need" means you don't have to, but + you can if you want to. ** Generating ChangeLog entries @@ -177,13 +177,6 @@ before possibly being merged to the trunk. Development is discussed on the emacs-devel mailing list. -Sometime before the release of a new major version of Emacs a "feature -freeze" is imposed on the trunk, to prepare for creating a release -branch. No new features may be added to the trunk after this point, -until the release branch is created. Announcements about the freeze -(and other important events) are made on the emacs-devel mailing -list under the "emacs-announce" topic, and not anywhere else. - The trunk branch is named "master" in git; release branches are named "emacs-nn" where "nn" is the major version. diff --git a/ChangeLog.2 b/ChangeLog.2 index 3636e382eb2..3d0812c2230 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -1,3 +1,1034 @@ +2015-11-14 Xue Fuqiao <xfq.free@gmail.com> + + * CONTRIBUTE: Remove information about feature freeze. + + Merge branch 'release-process-lowercase' + +2015-11-14 Xue Fuqiao <xfq.free@gmail.com> + + Document the release process + + * admin/notes/versioning: Add information about RC releases. + * admin/release-process: Document the release process. + * admin/authors.el (authors-ignored-files): + * admin/README: Change FOR-RELEASE to release-process. + * CONTRIBUTE: + * admin/notes/bugtracker: Don't mention FOR-RELEASE. + +2015-11-14 Xue Fuqiao <xfq.free@gmail.com> + + * admin/release-process: Rename from admin/FOR-RELEASE. + +2015-11-14 David Engster <deng@randomsample.de> + + gitmerge: Fix git log command + + * admin/gitmerge.el (gitmerge-missing): Use '--left-only' since we + only want commits from the branch that is to be merged. + (gitmerge-setup-log-buffer): Use the same symmetric range as in + `gitmerge-missing'. + +2015-11-14 David Engster <deng@randomsample.de> + + gitmerge: Try to detect cherry-picks + + * admin/gitmerge.el (gitmerge-default-branch): Change to + origin/emacs-25. + (gitmerge-missing): Use symmetric difference ('...') between + branch and master so that cherry-picks can be detected. + +2015-11-14 Eli Zaretskii <eliz@gnu.org> + + 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. + +2015-11-14 Xue Fuqiao <xfq.free@gmail.com> + + Mention CONTRIBUTE in README, since it was moved from etc/ to root. + * etc/TODO: Remove the reference to `etc/CONTRIBUTE'. + * README: Mention CONTRIBUTE. + +2015-11-13 Wilson Snyder <wsnyder@wsnyder.org> + + 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. + +2015-11-13 Dmitry Gutov <dgutov@yandex.ru> + + 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. + +2015-11-13 Juri Linkov <juri@linkov.net> + + 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) + +2015-11-13 Dmitry Gutov <dgutov@yandex.ru> + + 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. + +2015-11-13 Dmitry Gutov <dgutov@yandex.ru> + + 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. + +2015-11-13 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib + + This incorporates: + 2015-11-13 xalloc-oversized: improve performance with GCC 5 + * lib/xalloc-oversized.h: Copy from gnulib. + +2015-11-13 Paul Eggert <eggert@cs.ucla.edu> + + 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. + +2015-11-13 Paul Eggert <eggert@cs.ucla.edu> + + 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. + +2015-11-13 Paul Eggert <eggert@cs.ucla.edu> + + * src/undo.c (run_undoable_change): Now static. + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + 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'. + +2015-11-13 Juanma Barranquero <lekktu@gmail.com> + + * test/automated/simple-test.el: Add test for bug#20698 (bug#21885) + (simple-test--transpositions): New macro. + (simple-transpose-subr): New test. + +2015-11-13 Juanma Barranquero <lekktu@gmail.com> + + * lisp/progmodes/elisp-mode.el: Declare function `project-roots' + +2015-11-13 Juanma Barranquero <lekktu@gmail.com> + + * src/undo.c: Small fixes for previous change + (run_undoable_change): Mark void argument list. + (record_property_change): Remove unused variable `boundary'. + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + Add a few more variables to redisplay--variables + + * lisp/frame.el (redisplay--variables): Add bidi-paragraph-direction + and bidi-display-reordering to the list. + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + * lisp/loadup.el: Enlarge the size of the hash table to 80000. + +2015-11-13 Eli Barzilay <eli@barzilay.org> + + 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) + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + Fix last change in shr.el + + * lisp/net/shr.el (shr--have-one-fringe-p): Rename from + have-fringes-p. All callers changed. Doc fix. (Bug#21895) + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + Fix last change + + * src/w32fns.c (syms_of_w32fns) [WINDOWSNT && !HAVE_DBUS]: + Don't DEFSYM tray notification symbols if D-Bus is being used. + +2015-11-13 Eli Zaretskii <eliz@gnu.org> + + Another fix for MinGW64 and Cygwin builds due to notifications + + * src/w32fns.c: Ifdef away tray notification code if D-Bus is + being compiled into Emacs. + (syms_of_w32fns) [WINDOWSNT && !HAVE_DBUS]: Don't defsubr + Sw32_notification_notify and Sw32_notification_close if the code + is not compiled. Reported by Andy Moreton <andrewjmoreton@gmail.com>. + +2015-11-12 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + Remove intern calls and XXX comments from Fx_export_frames + + * src/xfns.c (Fx_export_frames): Use Qpdf, Qpng, Qpostscript, and + Qsvg instead of intern calls. Use "postscript" instead of "ps" + for consistency with image types. Remove XXX comments. + (syms_of_xfns) <Qpdf>: DEFSYM it. + +2015-11-12 Eric Hanchrow <eric.hanchrow@gmail.com> + + shr: don't invoke unbound function (Bug#21895) + + * lisp/net/shr.el (have-fringes-p): New function. + (shr-insert-document, shr-fill-text): Use it. + +2015-11-12 Juanma Barranquero <lekktu@gmail.com> + + * test/automated/keymaps-test.el: Fix test to make it repeatable + + (keymap-store_in_keymap-FASTINT-on-nonchars): Reset Buffer-menu-mode-map + entry to its initial value to make the test repeatable in interactive + sessions (assuming it doesn't fail and crashes Emacs, of course). + +2015-11-12 Artur Malabarba <bruce.connor.am@gmail.com> + + * test/automated/cl-lib-tests.el (cl-lib-struct-constructors): + Small fix. + +2015-11-12 Phillip Lord <phillip.lord@newcastle.ac.uk> + + The heuristic that Emacs uses to add an `undo-boundary' has been + reworked, as it interacts poorly with functions on `post-command-hook' + or `after-change-functions'. + + * lisp/simple.el: New section added. + * src/cmds.c (remove_excessive_undo_boundaries): Now in lisp. + (self_insert_command): Calls simple.el to amalgamate. + (delete_char): Calls simple.el to amalgamate. + * src/keyboard.c (last_undo_boundary): Removed. + * src/undo.c (run_undoable_change): New function. + +2015-11-12 Juri Linkov <juri@linkov.net> + + Bind [?\S-\ ] to previous line command in Dired-like modes + + * lisp/arc-mode.el (archive-mode-map): + * lisp/dired.el (dired-mode-map): + * lisp/proced.el (proced-mode-map): + * lisp/vc/vc-dir.el (vc-dir-mode-map): + Bind [?\S-\ ] to previous line command. + (Bug#20790) + +2015-11-12 Eli Zaretskii <eliz@gnu.org> + + Fix the MinGW64 and Cygwin-w32 builds + + * src/w32fns.c (MYNOTIFYICONDATAW_V1_SIZE) + (MYNOTIFYICONDATAW_V2_SIZE, MYNOTIFYICONDATAW_V3_SIZE): Define and + use instead of the corresponding NOTIFYICONDATAW_Vn_SIZE macros, + which cause trouble with MinGW42 headers. Ifdef away tray + notifications code for Cygwin. Reported by Andy Moreton + <andrewjmoreton@gmail.com>. + +2015-11-12 Simen Heggestøyl <simenheg@gmail.com> + + Enable sorting of JSON object keys when encoding + + * lisp/json.el (json-encoding-object-sort-predicate): New variable + for specifying a sorting predicate for JSON objects during encoding. + (json--plist-to-alist): New utility function. + (json-encode-hash-table): Re-use `json-encode-alist' when object keys + are to be sorted. + (json-encode-alist): Sort output by + `json-encoding-object-sort-predicate, when set. + (json-encode-plist): Re-use `json-encode-alist' when object keys are + to be sorted. + (json-pretty-print-buffer-ordered): New command to pretty print the + buffer with object keys sorted alphabetically. + (json-pretty-print-ordered): New command to pretty print the region + with object keys sorted alphabetically. + + * test/automated/json-tests.el (test-json-plist-to-alist) + (test-json-encode-plist, test-json-encode-hash-table) + (test-json-encode-alist-with-sort-predicate) + (test-json-encode-plist-with-sort-predicate): New tests. + + * etc/NEWS: Add an entry for the new commands. + +2015-11-12 Juanma Barranquero <lekktu@gmail.com> + + * test/automated/keymap-tests.el: New test file. + +2015-11-12 Ken Raeburn <raeburn@raeburn.org> + + Speed up x_real_pos_and_offsets using XCB + + * src/xfns.c (x_real_pos_and_offsets) [USE_XCB]: Add XCB flavors of + all X calls, and pipeline requests when possible, collecting results + later. Eliminate use of x_catch_errors (and thus XSync) in XCB case. + +2015-11-12 Ken Raeburn <raeburn@raeburn.org> + + Enable use of XCB for checking window manager state + + * src/xterm.c (get_current_wm_state) [USE_XCB]: Use XCB calls instead + of XGetWindowProperty plus error-catching, since we can explicitly + check for errors in the XCB version. This eliminates 3 XSync calls on + top of the round-trip actually fetching the information. + +2015-11-12 Ken Raeburn <raeburn@raeburn.org> + + Detect XCB and save a connection handle + + * configure.ac: If using X11, check for XCB libraries and header. + * src/Makefile.in (XCB_LIBS): Define. + (LIBX_EXTRA): Include it. + + * src/xterm.h [USE_XCB]: Include X11/Xlib-xcb.h. + (struct x_display_info) [USE_XCB]: Add an XCB connection handle field. + * src/xterm.c (x_term_init) [USE_XCB]: Initialize the new field. + +2015-11-12 Ken Raeburn <raeburn@raeburn.org> + + Reduce some data dependencies between X calls + + Gains nothing in the traditional-Xlib code, but more closely aligns + with how the XCB version will work. + + * src/xfns.c (x_real_pos_and_offsets): When translating coordinates, + send coordinates (0,0) to the X server and add in the real coordinates + after getting the response. Move XGetGeometry for outer window inside + error-trapping block. Use DPY variable more, since it's available. + +2015-11-12 Ken Raeburn <raeburn@raeburn.org> + + Use color cache for creating bitmap + + * src/image.c (x_create_bitmap_from_xpm_data) [ALLOC_XPM_COLORS]: + Set attributes to use the caching color allocator. Initialize and + free the cache. + +2015-11-12 Eli Barzilay <eli@barzilay.org> + + Add "^" to the interactive specs of `dired-next/previous-line' + + * lisp/dired.el (dired-next-line, dired-previous-line): It makes sense + to bind these commands to the arrow keys, and that means that they work + better with a "^" in the `interactive' declaration so selection works + as expected. + +2015-11-11 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + Sync with soap-client repository, version 3.0.2 + + * soap-client.el: Bump version to 3.0.2. + + * soap-client.el (soap-warning): Use format, not format-message. + + * soap-client.el: Add cl-lib to Package-Requires. Require cl-lib. + (soap-validate-xs-simple-type): Use cl-labels instead of cl-flet. + + * soap-client.el: Support Emacs versions that do not have + define-error. + + * soap-inspect.el: Remove version header. + + * soap-client.el, soap-inspect.el, jira2.el: Fix first line header + format. + +2015-11-11 Alan Mackenzie <acm@muc.de> + + CC Mode: Respect users' settings of open-paren-in-column-0-is-defun-start + + * lisp/progmodes/cc-engine.el (c-backward-single-comment) + (c-backward-comments, c-invalidate-state-cache-1, c-parse-state-1) + (c-guess-basic-syntax): + Remove bindings of open-paren-in-column-0-is-defun-start to nil. + (c-get-fallback-scan-pos): "New" function (existed several years ago). + (c-parse-state-get-strategy): Reintroduce the 'BOD strategy, using + c-get-fallback-scan-pos. + (c-parse-state-1): Handle 'BOD strategy. + + * lisp/progmodes/cc-mode.el (c-before-change, c-after-change) + (c-font-lock-fontify-region): Remove bindings of + open-paren-in-column-0-is-defun-start to nil. + + * doc/misc/cc-mode.texi (Performance Issues) + (Limitations and Known Bugs): Fix mix up between @chapter and @appendix. + +2015-11-11 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/obarray.el: Fix shadowed variables. + (obarray-map, obarray-remove, obarray-put, obarray-get): + Change OBARRAY arg to OB to avoid shadowing ‘obarray’. + +2015-11-11 Eli Zaretskii <eliz@gnu.org> + + Avoid error in submitting a form with EWW + + * lisp/gnus/mm-url.el (mm-url-form-encode-xwfu): Allow argument + CHUNK to be nil. (Bug#21881) + +2015-11-11 Nicolas Petton <nicolas@petton.fr> + + Rename seq-p and map-p to seqp and mapp + + * lisp/emacs-lisp/seq.el (seqp): New name. + * lisp/emacs-lisp/map.el (mapp): New name. + * doc/lispref/sequences.texi: Update the documentation for seqp. + * test/automated/map-tests.el: Update the tests for mapp. + +2015-11-11 Nicolas Petton <nicolas@petton.fr> + + Rename obarray-p to obarrayp + + * lisp/obarray.el (obarrayp): New name. + * test/automated/obarray-tests.el: Update the tests. + +2015-11-11 Nicolas Petton <nicolas@petton.fr> + + Rename obarray-foreach to obarray-map + + * lisp/obarray.el (obarray-map): New name. + * test/automated/obarray-tests.el: Update the corresponding tests. + +2015-11-11 Przemysław Wojnowski <esperanto@cumego.com> + + New file with obarray functions + + * lisp/obarray.el: Basic obarray functions extracted from abbrev.el. + * test/automated/obarray-tests.el: New file. + +2015-11-11 Eli Zaretskii <eliz@gnu.org> + + Implement tray notifications for MS-Windows + + * src/w32fns.c (MY_NOTIFYICONDATAW): New typedef. + (NOTIFYICONDATAW_V1_SIZE, NOTIFYICONDATAW_V2_SIZE) + (NOTIFYICONDATAW_V3_SIZE, NIF_INFO, NIIF_NONE, NIIF_INFO) + (NIIF_WARNING, NIIF_ERROR, EMACS_TRAY_NOTIFICATION_ID) + (EMACS_NOTIFICATION_MSG): New macros. + (NI_Severity): New enumeration. + (get_dll_version, utf8_mbslen_lim, add_tray_notification) + (delete_tray_notification, Fw32_notification_notify) + (Fw32_notification_close): New functions. + (syms_of_w32fns): Defsubr functions exposed to Lisp. DEFSYM + keywords used by w32-notification-notify. + + * doc/lispref/os.texi (Desktop Notifications): Describe the native + w32 tray notifications. + +2015-11-11 Michael Albinus <michael.albinus@gmx.de> + + Optimize `file-equal-p' and `file-in-directory-p' in Tramp + + * lisp/net/tramp.el (tramp-handle-file-equal-p) + (tramp-handle-file-in-directory-p): New defuns. Suggested by + Harvey Chapman <hchapman@3gfp.com>. + + * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): + * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use them. + +2015-11-10 Karl Fogel <kfogel@red-bean.com> + + * CONTRIBUTE: Encourage adding tests. + + Based on this post from John Wiegley: + + From: "John Wiegley" <johnw@newartisans.com> + Subject: Re: [Emacs-diffs] master 1f02cbe: Fix bug#21766 and add test + To: Juanma Barranquero <lekktu@gmail.com> + Cc: emacs-diffs@gnu.org, bruce.connor.am@gmail.com, + emacs-devel <emacs-devel@gnu.org> + Date: Wed, 28 Oct 2015 18:45:29 -0700 + Message-ID: <m2y4emqwg6.fsf@newartisans.com> + + https://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02372.html + +2015-11-10 David Reitter <david.reitter@gmail.com> + + Avoid creating notification objects when possible + + * src/nsterm.m (windowWillEnterFullScreen, windowWillExitFullScreen:) + (windowDidEnterFullScreen, windowDidExitFullScreen): Provide convenience + functions that do not require a notification object. When needed, + define NSWindowDidEnterFullScreenNotification to allow for compilation + on OS X 10.6.8. + +2015-11-10 Paul Eggert <eggert@cs.ucla.edu> + + Move INTEGER_TO_CONS body out of .h file + + * src/data.c (INTBIG_TO_LISP): New macro, with most + of the contents of the old INTEGER_TO_CONS. + (intbig_to_lisp, uintbig_to_lisp): New functions. + * src/lisp.h (INTEGER_TO_CONS): + Simplify by using EXPR_SIGNED and the new functions. + This shrinks code size a bit, and makes it easier to + put a breakpoint on handling of large integers. + +2015-11-10 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib + + This incorporates: + 2015-11-10 intprops: new public macro EXPR_SIGNED + 2015-11-10 intprops: fix typo in clang port + * lib/intprops.h: Copy from gnulib. + +2015-11-10 Paul Eggert <eggert@cs.ucla.edu> + + Spelling fixes + + * lisp/net/soap-inspect.el (soap-inspect-xs-simple-type): + Fix misspelling in output. + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * doc/lispref/variables.texi (Directory Local Variables): + Document dir-locals wildcards. + + * lisp/files.el (dir-locals-file): Point to Info node. + + * doc/emacs/custom.texi (Directory Variables): + Document dir-locals wildcards. + + * etc/NEWS: Document new functionality. + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/files.el: Don't allow customization of dir-locals sorting. + In retrospect, this is not a good idea for the same reason that + `dir-locals-file' is a defconst, because it is important that this + behaviour be "uniform across different environments and users". + Sure, the user can still change the sorting with a hack, but we + shouldn't encourage them to change it. + (dir-locals--all-files): Return list in the order returned by + `file-expand-wildcards'. + (file-expand-wildcards): Document the sorting predicate used. + (dir-locals-sort-predicate): Delete variable. + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/files.el (dir-locals-read-from-file): Better handle errors. + + * lisp/isearch.el (search-default-regexp-mode): Change default value. + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/files.el (dir-locals-find-file): Don't stop at unreadable files. + `locate-dominating-file' will now keep looking if the files it finds in + a given directory are unreadable (or not files). + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/files.el (dir-locals-file): Allow wildcards. + (dir-locals-find-file, dir-locals-collect-variables) + (dir-locals-read-from-file): Update accordingly. + (hack-dir-local-variables): Rename a local variable. + + * lisp/files-x.el (modify-dir-local-variable): Update accordingly. + + * lisp/help-fns.el (describe-variable): Update accordingly. + + * .gitignore: Add .dir-locals?.el. + +2015-11-10 Artur Malabarba <bruce.connor.am@gmail.com> + + * lisp/emacs-lisp/map.el (map-merge-with): New function. + + * test/automated/map-tests.el (test-map-merge-with): New test. + +2015-11-09 Karl Fogel <kfogel@red-bean.com> + + Fix some recently-perturbed bookmark autoloads + + * lisp/bookmark.el (bookmark-set-internal): Remove unnecessary autoload. + (bookmark-set): Restore autoload. + (bookmark-set-no-overwrite): Add autoload. + + Thanks to Juanma Barranquero for noticing the autoload problems + introduced by my recent commit adding/changing the above functions + (Sun Nov 8 14:16:43 2015 -0500, git commit 3812e17978). + +2015-11-09 Noah Friedman <friedman@splode.com> + + * etc/emacs-buffer.gdb (ydump-buffer): Handle case where gap is at + the start of buffer. I don't recall if older versions of gdb were + less strict but you cannot dump a 0-length range in gdb 7.9.1. + +2015-11-09 Dmitry Gutov <dgutov@yandex.ru> + + * lisp/progmodes/project.el: Update Commentary. + + Merge branch 'project-next' + +2015-11-09 Dmitry Gutov <dgutov@yandex.ru> + + Fold `project-ask-user' into `project-current' + + * lisp/progmodes/project.el (project-find-functions): + Remove `project-ask-user'. + (project-ask-user): Remove function and the corresponding + `project-roots' implementation. + (project-current): Add a new argument, MAYBE-PROMPT. Prompt the + user in case there's no project in the current directory. Update + all callers. + +2015-11-09 Karl Fogel <kfogel@red-bean.com> + + When VC detects a conflict, specify which file + + * lisp/vc/vc.el (vc-message-unresolved-conflicts): New function. + * lisp/vc/vc-svn.el (vc-svn-find-file-hook): + * lisp/vc/vc-hg.el (vc-hg-find-file-hook): + * lisp/vc/vc-bzr.el (vc-bzr-find-file-hook): + * lisp/vc/vc-git.el (vc-git-find-file-hook): Use above new function + to display a standard message that specifies the conflicted file. + + Before this change, the message VC used for indicating a conflicted + file was just "There are unresolved conflicts in this file" without + naming the file (and this language was duplicated in several places). + After this change, it's "There are unresolved conflicts in file FOO" + (and this language is now centralized in one function in vc.el). + + Justification: It's important for the message to name the conflicted + file because the moment when VC realizes a file is conflicted does not + always come interactively. For example, some people automatically + find a set of Org Mode files on startup, and may keep those .org files + under version control. If any of the files are conflicted, the user + just sees some messages fly by, and might later check the "*Messages*" + buffer to find out what files were conflicted. I'm not saying this + happened to me or anything; it's a purely hypothetical example. + +2015-11-09 Eli Zaretskii <eliz@gnu.org> + + Fix assertion violation in define-key + + * src/keymap.c (store_in_keymap): Don't use XFASTINT on non-character + objects. Reported by Drew Adams <drew.adams@oracle.com> + and Juanma Barranquero <lekktu@gmail.com>. + +2015-11-09 Dima Kogan <dima@secretsauce.net> + + Fix a memory leak in GC of font cache + + * src/alloc.c (compact_font_cache_entry): Don't GC unmarked font + entities if some of the fonts it references are marked. This + plugs a memory leak. (Bug#21556) + +2015-11-09 Paul Eggert <eggert@cs.ucla.edu> + + Use INT_ADD_WRAPV etc. to check integer overflow + + * src/alloc.c (xnmalloc, xnrealloc, xpalloc, Fmake_string): + * src/buffer.c (record_overlay_string, overlay_strings): + * src/casefiddle.c (casify_object): + * src/ccl.c (Fccl_execute_on_string): + * src/character.c (char_width, c_string_width, lisp_string_width) + (count_size_as_multibyte, string_escape_byte8): + * src/coding.c (coding_alloc_by_realloc, produce_chars): + * src/data.c (arith_driver): + * src/dispnew.c (realloc_glyph_pool, init_display): + * src/editfns.c (styled_format): + * src/fns.c (Ffillarray): + * src/ftfont.c (ftfont_shape_by_flt): + * src/gnutls.c (gnutls_hex_string): + * src/gtkutil.c (get_utf8_string): + * src/image.c (x_to_xcolors, x_detect_edges, png_load_body): + * src/keymap.c (Fkey_description): + * src/lisp.h (SAFE_ALLOCA_LISP): + * src/term.c (encode_terminal_code): + * src/tparam.c (tparam1): + * src/xselect.c (x_property_data_to_lisp): + * src/xsmfns.c (smc_save_yourself_CB): + * src/xterm.c (x_term_init): + When checking for integer overflow, prefer INT_MULTIPLY_WRAPV to + more-complicated code involving division and/or + INT_MULTIPLY_OVERFLOW, and similarly for INT_ADD_WRAPV and + subtraction and/or INT_ADD_OVERFLOW. + * src/casefiddle.c (casify_object): Simplify multibyte size check. + * src/character.c: Remove some obsolete ‘#ifdef emacs’s. + * src/data.c (arith_driver): Also check for division overflow, + as that’s now possible given that the accumulator can now contain + any Emacs integer. + * src/lisp.h (lisp_word_count): Remove; no longer used. + +2015-11-08 Dmitry Gutov <dgutov@yandex.ru> + + Make sure that the ignore file exists + + * lisp/vc/vc.el (vc-default-ignore-completion-table): + Make sure that the ignore file exists. + +2015-11-08 Michael Sperber <mike@xemacs.org> + + * gnus-sum.el (gnus-summary-backend-map): Bind B-backspace to + `gnus-summary-delete-article` in a way that also works on XEmacs. + +2015-11-08 Simen Heggestøyl <simenheg@gmail.com> + + Add support for retrieving paths to JSON elements + + Add support for retrieving the path to a JSON element. This can for + instance be useful to retrieve paths in deeply nested JSON + structures. + + * lisp/json.el (json-pre-element-read-function) + (json-post-element-read-function): New variables to hold pre- and post + read callback functions for `json-read-array' and `json-read-object'. + (json--path): New variable used internally by `json-path-to-position'. + (json--record-path, json--check-position): New functions used + internally by `json-path-to-position'. + (json-path-to-position): New function for retrieving the path to a + JSON element at a given position. + (json-read-object, json-read-array): Call + `json-pre-element-read-function' and `json-post-element-read-function' + when set. + + * test/automated/json-tests.el (test-json-path-to-position-with-objects) + (test-json-path-to-position-with-arrays) + (test-json-path-to-position-no-match): New tests for + `json-path-to-position'. + +2015-11-08 Karl Fogel <kfogel@red-bean.com> + + * etc/NEWS: Mention new `bookmark-set-no-overwrite'. + + This really should been part of my previous commit + (Sun Nov 8 14:16:43 2015 -0500, git commit 3812e17978). + +2015-11-08 Karl Fogel <kfogel@red-bean.com> + + Offer non-overwrite bookmark setter (Bug#15746) + + * lisp/bookmark.el (bookmark-set-internal): New helper function to do + what `bookmark-set' used to do, but with more choices for overwrite + vs push, and with minor changes to the interactive prompt format. + (bookmark-set): Rewrite as wrapper around above. + If overwriting, inform the user of that in the prompt. + (bookmark-set-no-overwrite): New function, also done as wrapper. + Bind to "M" in `ctl-x-r-map' autoloads. + (bookmark-map): Similarly bind "M" here. + +2015-11-08 Paul Eggert <eggert@cs.ucla.edu> + + * src/unexelf.c (NEW_PROGRAM_H): Remove unused macro (Bug#20614). + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Don't insert a new section + + Reuse the .bss section instead, making it SHT_PROGBITS. This way we + don't need to mess with symbol st_shndx, or section sh_link and + sh_info. + + This does lead to eu-elflint complaints about symbols defined in .bss + with a needed version, because normally it is undefined symbols that + have needed versions; Defined symbols have version definitions. + The exception is symbols defined by the linker in .dynbss for + variables copied from a shared library in order to avoid text + relocations, with copy relocs to copy their initial values from the + shared library. These symbols are both defined and have needed + versions, and eu-elflink only expects to see them in SHT_NOBITS + sections. Of course there is no real problem with having such symbols + in SHT_PROGBITS sections. glibc ld.so handles them fine. + + * src/unexelf.c: Delete outdated comments. + (PATCH_INDEX): Delete. + (find_section): Delete. + (unexec): Don't add a new section. Instead reuse the last bss + section, extending it to cover dumped data. Make bss sections + SHT_PROGBITS. Remove all patching of sh_link, sh_info and + st_shndx. Rename bss sections. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Drive from PT_LOAD header rather than sections + + This rewrites bss handling in the ELF unexec code. Finding bss + sections by name results in complicated code that + - does not account for all names of possible bss sections, + - assumes specific ordering of bss sections, + - can wrongly choose a SHT_NOBITS section not in the bss segment, + - incorrectly calculates bss size (no accounting for alignment gaps), + - assumes .data and .bss are in the same segment. + + All of these problems and more are solved by finding the bss segment + in PT_LOAD headers, ie. the address range included in p_memsz but not + p_filesz of the last PT_LOAD header, then matching SHT_NOBITS sections + in that address range. + + * src/unexelf.c: Delete old ppc comment. + (OLD_PROGRAM_H): Define. + (round_up): Delete. + (unexec): Don't search for bss style sections by name. Instead, + use the last PT_LOAD header address range covered by p_memsz + but not p_filesz and match any SHT_NOBITS section in that + address range. Simplify initialisation of section header vars. + Don't assume that section headers are above bss segment. Move + copying of bss area out of section loop. Align .data2 section + to 1, since it now covers the entire bss area. For SHT_NOBITS + sections in the bss segment, leave sh_addr and sh_addralign + unchanged, but correct sh_offset. Clear memory corresponding + to SHT_NOBITS .plt section. Delete comment and hacks for + sections partly overlapping bss range now that the full range + is properly calculated. Delete now dead .sbss code. + (Bug#20614) + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: R_*_NONE relocs + + These should be ignored on all targets. + + * src/unexelf.c (unexec): Ignore R_*_NONE relocs for any target, + not just Alpha. Comment on reloc size assumption. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: _OBJC_ symbols in bss sections + + This code assumed that there was only one bss section. Rather than + checking for a particular index, check the section type. Also, handle + the possibility that the section was SHT_NOBITS originally and is + unchanged, in which case no clearing is needed (and sh_offset isn't + necessarily valid, which can lead to a wild memset). + + * src/unexelf.c (unexec): Properly handle _OBJC_ symbols in + bss sections. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Symbol table patching + + No st_shndx value larger than SHN_LORESERVE should be changed. + * src/unexelf.c (unexec): Don't adjust any st_shndx larger than + SHN_LORESERVE. Error on SHN_XINDEX. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Merge Alpha and MIPS COFF debug handling + + * src/unexelf.c (unexec): Merge Alpha and MIPS COFF debug handling. + Don't find .mdebug section index, find the section in the loop. + Allow for unlikely possibility that .mdebug is located at sh_offset + before bss segment, by calculating move from difference in + sh_offset rather than just assuming new_data2_size. Simplify + cbLineOffset handling. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Tidy code + + Separate out some of the more mechanical changes so following patches + are smaller. + + * src/unexelf.c (unexec): Rearrange initialisation of program + header vars. Use pointer vars in loops rather than indexing + section header array via macros. Simplify _OBJC_ sym code + and reloc handling code. + +2015-11-08 Alan Modra <amodra@gmail.com> + + ELF unexec: Correct section header index + + First a small fix. The code incorrectly uses "NEW_SECTION_H (n)" when + it should have been using "NEW_SECTION_H (nn)" to find the name of the + section currently being processed. Of course, before the bss + sections, n and nn have the same value, so this doesn't matter except + in the case of .sbss. For .sbss this probably meant .bss (most likely + the next section) was copied from memory. A later patch removes the + bogus .sbss handling anyway. + + * src/unexelf.c (unexec): Use correct index to look up names. + +2015-11-08 Michael Albinus <michael.albinus@gmx.de> + + Fix Bug#21841 + + * lisp/filenotify.el (file-notify--rm-descriptor): + Use `descriptor' instead of computing its value. + (file-notify--descriptor): Additional argument FILE. Adapt all callees. + (file-notify-rm-watch): Use `descriptor' when calling file name handler. + (Bug#21841) + +2015-11-08 Dmitry Gutov <dgutov@yandex.ru> + + Remove dirs in vc project roots from the the vc project library roots + + * lisp/progmodes/project.el (project-library-roots): + Remove directories inside the project roots from the result. + (http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00536.html) + +2015-11-07 Dmitry Gutov <dgutov@yandex.ru> + + Move and rename xref-find-regexp to the project package + + * lisp/progmodes/project.el (project-find-regexp) + (project--read-regexp) + (project--find-regexp-in): New functions. + + * lisp/progmodes/xref.el (xref--find-xrefs): Extract from + xref--show-xrefs. Use in existing callers in place of that + function. + (xref--show-xrefs): Only do the "show" part. + (xref-find-regexp): Rename, more or less, to + project-or-libraries-find-regexp. + +2015-11-06 Dmitry Gutov <dgutov@yandex.ru> + + Abolish temporary buffer management for xref + + * lisp/progmodes/xref.el (xref--temporary-buffers) + (xref--current) + (xref--inhibit-mark-current) + (xref--mark-selected): Remove. Remove all references. + (xref--show-xrefs): Do not construct the + list of the temporary buffers, nor pass it along. + +2015-11-06 Dmitry Gutov <dgutov@yandex.ru> + + Rename "search path" to "library roots" + + * lisp/emacs-lisp/cl-seq.el (cl-set-difference): Retain the order + of the elements from CL-LIST1. + + * test/automated/cl-lib-tests.el (cl-lib-test-set-functions): + Update WRT to the above change. + + * lisp/progmodes/project.el (project-search-path-function): Rename + to project-library-roots-function, update the documentation and + references. + (project-search-path): Likewise, to project-library-roots. + (project-roots): Clarify documentation. + (project-vc-search-path): Likewise, to project-vc-library-roots. + (project-library-roots): In addition to the renames, thread the + results through file-name-as-directory. + (project-prune-directories): Accept a variable number of + arguments. Rename to project-combine-directories. + (project-subtract-directories): New function. + + * lisp/progmodes/elisp-mode.el (elisp--xref-find-references): + Append project-roots and project-library-roots together. + + * lisp/progmodes/etags.el (etags--xref-find-references): Ditto. + 2015-11-08 Paul Eggert <eggert@cs.ucla.edu> Prefer xpalloc to doubling buffers by hand @@ -1764,7 +2795,7 @@ 2015-10-23 Anders Lindgren <andlind@gmail.com> - NextSten maximization and NSTRACE rewrite + NextStep maximization and NSTRACE rewrite Full-height, full-width, and maximized windows now cover the entire screen (except the menu bar), including the part where the @@ -17967,7 +18998,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to -commit 8a8613bcf4227dfe46a694b761e9575bdf6ca2ce (inclusive). +commit ae0653b5ab9ee223751ec389b87011963e1cbbef (inclusive). See ChangeLog.1 for earlier changes. ;; Local Variables: @@ -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 @@ -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/admin/README b/admin/README index 2286e354ac6..b7621ffb62a 100644 --- a/admin/README +++ b/admin/README @@ -12,9 +12,9 @@ what you do when using them. * Instructions and scripts used to prepare an Emacs release. -** FOR-RELEASE +** release-process -Living list of activities that must be completed before the next release. +The release process used by GNU Emacs. ** make-tarball.txt diff --git a/admin/authors.el b/admin/authors.el index 3d7850af57d..9903218e2ba 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -267,7 +267,7 @@ Changes to files matching one of the regexps in this list are not listed.") '("external-lisp" "lock" "share-lib" "local-lisp" "noleim-Makefile.in" - "NEWS" "ORDERS" "PROBLEMS" "FAQ" "AUTHORS" "FOR-RELEASE" "TODO" "todo" + "NEWS" "ORDERS" "PROBLEMS" "FAQ" "AUTHORS" "release-process" "TODO" "todo" "MACHINES" "SERVICE" "README.unicode" "README.multi-tty" "TUTORIAL.translators" "NEWS.unicode" "COPYING.DJ" "Makefile.old" "Makefile.am" diff --git a/admin/gitmerge.el b/admin/gitmerge.el index c8cf2dcc565..1e92c8c119f 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -65,7 +65,7 @@ Auto-commit" '((t (:strike-through t))) "Face for skipped commits.") -(defconst gitmerge-default-branch "origin/emacs-24" +(defconst gitmerge-default-branch "origin/emacs-25" "Default for branch that should be merged.") (defconst gitmerge-buffer "*gitmerge*" @@ -183,8 +183,8 @@ if and why this commit should be skipped." ;; Go through the log and remember all commits that match ;; `gitmerge-skip-regexp' or are marked by --cherry-mark. (with-temp-buffer - (call-process "git" nil t nil "log" "--cherry-mark" from - (concat "^" (car (vc-git-branches)))) + (call-process "git" nil t nil "log" "--cherry-mark" "--left-only" + (concat from "..." (car (vc-git-branches)))) (goto-char (point-max)) (while (re-search-backward "^commit \\(.+\\) \\([0-9a-f]+\\).*" nil t) (let ((cherrymark (match-string 1)) @@ -206,9 +206,9 @@ if and why this commit should be skipped." "Create the buffer for choosing commits." (with-current-buffer (get-buffer-create gitmerge-buffer) (erase-buffer) - (call-process "git" nil t nil "log" + (call-process "git" nil t nil "log" "--left-only" "--pretty=format:%h %<(20,trunc) %an: %<(100,trunc) %s" - from (concat "^" (car (vc-git-branches)))) + (concat from "..." (car (vc-git-branches)))) (goto-char (point-min)) (while (looking-at "^\\([a-f0-9]+\\)") (let ((skipreason (gitmerge-skip-commit-p (match-string 1) commits))) diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index fb65bbe4330..3d6df03d5e7 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -140,8 +140,7 @@ you can add an element to gnus-posting-styles to do this automatically, eg: ** To record a bug in the tracker without sending mail to the bug list. This can be useful to make a note of something discussed on -emacs-devel that needs fixing. In other words, this can be the -equivalent of adding something to FOR-RELEASE. +emacs-devel that needs fixing. To: quiet@debbugs.gnu.org [headers end] diff --git a/admin/notes/versioning b/admin/notes/versioning index e422b22e432..ef11335de54 100644 --- a/admin/notes/versioning +++ b/admin/notes/versioning @@ -9,16 +9,20 @@ Emacs version numbers have the form "build" increments each time Emacs is built in the same location (without cleaning) and isn't really part of the version. -bugfix releases increase "minor" by 1. -non-bugfix releases increase "major" by 1, and reset "minor" to 1. +Bugfix releases increase "minor" by 1. +Non-bugfix releases increase "major" by 1, and reset "minor" to 1. (The division between bugfix and non-bugfix has not always been clear historically.) Unreleased (development) versions have an extra "devel" component. This is a fairly meaningless number that may be unchanged for a long time. It is normally 50. -When the release process starts, it changes to 90, 91, ... -When the actual release is made, this component is removed. + +After we cut the release branch, we’ll make pretest and release +candidate (RC) releases. For pretest releases, the "devel" component +changes to 90, 91, ... When the first RC release is made, this +component is removed. Normally, there is one RC release, unless an +unexpected last-minute problem occurs. The development version for a new major release has "minor" = 0. The development version for a new minor release has "minor" = that of diff --git a/admin/FOR-RELEASE b/admin/release-process index 6ecec8941a2..4a0890f3e4b 100644 --- a/admin/FOR-RELEASE +++ b/admin/release-process @@ -1,7 +1,51 @@ -Tasks needed before the next release. +This document describes the release process used by GNU Emacs. + +* RELEASE CYCLE + +Each release cycle will be split into two periods. + +** Phase one: development + +The first phase of the release schedule is the "heads-down" working +period for new features, on the `master' branch and several feature +branches. + +** Phase two: bugfixes + +Shortly before this phase, Emacs developers will be devoted to +figuring out what features to include in the next release and what +features to defer to a later release. + +At the beginning of this phase, a release branch called "emacs-NN" +("NN" represents the major version number of the new Emacs release) +will be cut from `master'. + +This phase is spent fixing bugs and eliminating undocumented new +features on the "emacs-NN" branch. + +In parallel to this phase, `master' can receive new features, to be +released in the next release cycle. From time to time, the master +branches merges bugfix commits from the "emacs-NN" branch. + +* RELEASE-CRITICAL BUGS + +Emacs uses the "blocking bug(s)" feature of Debbugs for bugs need to +be addressed in the next release. + +Currently, bug#19759 is the tracking bug for release of 25.1. Say +bug#123 needs to be fixed for Emacs 25.1. Send a message to +control@debbugs.gnu.org that says: + + block 19759 by 123 + +Change "block" to "unblock" to unblock the bug. * TO BE DONE SHORTLY BEFORE RELEASE +** Make sure the Copyright date reflects the current year in the source +files. See `admin/notes/years' for information about maintaining +copyright years for GNU Emacs. + ** Make sure the necessary sources and scripts for any generated files are included in the source tarfile. (They don't need to be installed, so eg admin/ is fine.) @@ -88,13 +132,13 @@ csplain -output-format=pdf cs-refcard Emacs 22 translators: LANG Translator Status -cs Pavel Janík -de Sven Joachim -fr Eric Jacoboni -pl Włodek Bzyl -pt-br Rodrigo Real -ru Alex Ott -sk Miroslav Vaško +cs Pavel Janík +de Sven Joachim +fr Eric Jacoboni +pl Włodek Bzyl +pt-br Rodrigo Real +ru Alex Ott +sk Miroslav Vaško ** For a major release, add a "New in Emacs XX" section to faq.texi. @@ -148,132 +192,139 @@ SECTION READERS TUTORIAL cyd TUTORIAL.bg ogi TUTORIAL.cn xfq -TUTORIAL.cs +TUTORIAL.cs TUTORIAL.de wl TUTORIAL.eo -TUTORIAL.es -TUTORIAL.fr +TUTORIAL.es +TUTORIAL.fr TUTORIAL.he eliz -TUTORIAL.it -TUTORIAL.ja +TUTORIAL.it +TUTORIAL.ja TUTORIAL.ko TUTORIAL.nl Pieter Schoenmakers -TUTORIAL.pl -TUTORIAL.pt_BR +TUTORIAL.pl +TUTORIAL.pt_BR TUTORIAL.ro TUTORIAL.ru Alex Ott -TUTORIAL.sk +TUTORIAL.sk TUTORIAL.sl Primoz PETERLIN TUTORIAL.sv Mats Lidell -TUTORIAL.th +TUTORIAL.th TUTORIAL.zh ** Check the manual. -abbrevs.texi -ack.texi -anti.texi -arevert-xtra.texi -basic.texi -buffers.texi -building.texi -calendar.texi -cal-xtra.texi -cmdargs.texi -commands.texi -custom.texi -dired.texi -dired-xtra.texi -display.texi -emacs.texi -emacs-xtra.texi -emerge-xtra.texi -entering.texi -files.texi -fixit.texi -fortran-xtra.texi -frames.texi -glossary.texi -help.texi -indent.texi -killing.texi -kmacro.texi -macos.texi -maintaining.texi -mark.texi -mini.texi -misc.texi -modes.texi -msdos.texi -msdos-xtra.texi -mule.texi -m-x.texi -package.texi -picture-xtra.texi -programs.texi -regs.texi -rmail.texi -screen.texi -search.texi -sending.texi -text.texi -trouble.texi -vc-xtra.texi -vc1-xtra.texi -windows.texi -xresources.texi +abbrevs.texi +ack.texi +anti.texi +arevert-xtra.texi +basic.texi +buffers.texi +building.texi +calendar.texi +cal-xtra.texi +cmdargs.texi +commands.texi +custom.texi +dired.texi +dired-xtra.texi +display.texi +emacs.texi +emacs-xtra.texi +emerge-xtra.texi +entering.texi +files.texi +fixit.texi +fortran-xtra.texi +frames.texi +glossary.texi +help.texi +indent.texi +killing.texi +kmacro.texi +macos.texi +maintaining.texi +mark.texi +mini.texi +misc.texi +modes.texi +msdos.texi +msdos-xtra.texi +mule.texi +m-x.texi +package.texi +picture-xtra.texi +programs.texi +regs.texi +rmail.texi +screen.texi +search.texi +sending.texi +text.texi +trouble.texi +vc-xtra.texi +vc1-xtra.texi +windows.texi +xresources.texi ** Check the Lisp manual. -abbrevs.texi -anti.texi -back.texi -backups.texi -buffers.texi -commands.texi -compile.texi -control.texi -customize.texi -debugging.texi -display.texi -edebug.texi +abbrevs.texi +anti.texi +back.texi +backups.texi +buffers.texi +commands.texi +compile.texi +control.texi +customize.texi +debugging.texi +display.texi +edebug.texi elisp.texi -errors.texi -eval.texi -files.texi -frames.texi -functions.texi -hash.texi -help.texi -hooks.texi +errors.texi +eval.texi +files.texi +frames.texi +functions.texi +hash.texi +help.texi +hooks.texi index.texi -internals.texi -intro.texi -keymaps.texi -lists.texi -loading.texi -macros.texi -maps.texi -markers.texi -minibuf.texi -modes.texi -nonascii.texi +internals.texi +intro.texi +keymaps.texi +lists.texi +loading.texi +macros.texi +maps.texi +markers.texi +minibuf.texi +modes.texi +nonascii.texi numbers.texi Paul Eggert (24.4) -objects.texi -os.texi -package.texi -positions.texi -processes.texi -searching.texi -sequences.texi -streams.texi -strings.texi -symbols.texi -syntax.texi -text.texi -tips.texi -variables.texi -windows.texi +objects.texi +os.texi +package.texi +positions.texi +processes.texi +searching.texi +sequences.texi +streams.texi +strings.texi +symbols.texi +syntax.texi +text.texi +tips.texi +variables.texi +windows.texi + +* OTHER INFORMATION + +For Emacs's versioning scheme, see `admin/notes/versioning'. + +For instructions to create pretest or release tarballs, announcements, +etc., see `admin/make-tarball.txt'. Local variables: diff --git a/configure.ac b/configure.ac index f9274d7ad1f..bae4fec72ec 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. 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. @@ -3135,6 +3135,21 @@ if test "${HAVE_X11}" = "yes"; then fi fi +if test "${HAVE_X11}" = "yes"; then + AC_CHECK_HEADER(X11/Xlib-xcb.h, + AC_CHECK_LIB(xcb, xcb_translate_coordinates, HAVE_XCB=yes)) + if test "${HAVE_XCB}" = "yes"; then + AC_CHECK_LIB(X11-xcb, XGetXCBConnection, HAVE_X11_XCB=yes) + if test "${HAVE_X11_XCB}" = "yes"; then + AC_DEFINE(USE_XCB, 1, +[Define to 1 if you have the XCB library and X11-XCB library for mixed + X11/XCB programming.]) + XCB_LIBS="-lX11-xcb -lxcb" + AC_SUBST(XCB_LIBS) + fi + fi +fi + ### Use -lXpm if available, unless '--with-xpm=no'. ### mingw32 doesn't use -lXpm, since it loads the library dynamically. ### In the Cygwin-w32 build, we need to use /usr/include/noX/X11/xpm.h diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 666a05dac9b..17a0b47ad06 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2323,10 +2323,11 @@ Emacs is restarted by the session manager. @cindex notifications, on desktop Emacs is able to send @dfn{notifications} on systems that support the -freedesktop.org Desktop Notifications Specification. In order to use -this functionality, Emacs must have been compiled with D-Bus support, -and the @code{notifications} library must be loaded. @xref{Top, , -D-Bus,dbus,D-Bus integration in Emacs}. +freedesktop.org Desktop Notifications Specification and on MS-Windows. +In order to use this functionality on Posix hosts, Emacs must have +been compiled with D-Bus support, and the @code{notifications} library +must be loaded. @xref{Top, , D-Bus,dbus,D-Bus integration in Emacs}. +The following function is supported when D-Bus support is available: @defun notifications-notify &rest params This function sends a notification to the desktop via D-Bus, @@ -2559,6 +2560,79 @@ If @var{spec_version} is @code{nil}, the server supports a specification prior to @samp{"1.0"}. @end defun +@cindex tray notifications, MS-Windows +When Emacs runs on MS-Windows as a GUI session, it supports a small +subset of the D-Bus notifications functionality via a native +primitive: + +@defun w32-notification-notify &rest params +This function displays an MS-Windows tray notification as specified by +@var{params}. MS-Windows tray notifications are displayed in a +balloon from an icon in the notification area of the taskbar. + +Value is the integer unique ID of the notification that can be used to +remove the notification using @code{w32-notification-close}, described +below. If the function fails, the return value is @code{nil}. + +The arguments @var{params} are specified as keyword/value pairs. All the +parameters are optional, but if no parameters are specified, the +function will do nothing and return @code{nil}. + +The following parameters are supported: + +@table @code +@item :icon @var{icon} +Display @var{icon} in the system tray. If @var{icon} is a string, it +should specify a file name from which to load the icon; the specified +file should be a @file{.ico} Windows icon file. If @var{icon} is not +a string, or if this parameter is not specified, the standard Emacs +icon will be used. + +@item :tip @var{tip} +Use @var{tip} as the tooltip for the notification. If @var{tip} is a +string, this is the text of a tooltip that will be shown when the +mouse pointer hovers over the tray icon added by the notification. If +@var{tip} is not a string, or if this parameter is not specified, the +default tooltip text is @samp{Emacs notification}. The tooltip text can +be up to 127 characters long (63 on Windows versions before W2K). +Longer strings will be truncated. + +@item :level @var{level} +Notification severity level, one of @code{info}, @code{warning}, or +@code{error}. If given, the value determines the icon displayed to the +left of the notification title, but only if the @code{:title} parameter +(see below) is also specified and is a string. + +@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 +text can be up to 63 characters long; longer text will be truncated. + +@item :body @var{body} +The body of the notification. If @var{body} is a string, it specifies +the text of the notification message. Use embedded newlines to +control how the text is broken into lines. The body text can be up to +255 characters long, and will be truncated if it's longer. Unlike +with D-Bus, the body text should be plain text, with no markup. +@end table + +Note that versions of Windows before W2K support only @code{:icon} and +@code{:tip}. The other parameters can be passed, but they will be +ignored on those old systems. + +There can be at most one active notification at any given time. An +active notification must be removed by calling +@code{w32-notification-close} before a new one can be shown. +@end defun + +To remove the notification and its icon from the taskbar, use the +following function: + +@defun w32-notification-close id +This function removes the tray notification given by its unique +@var{id}. +@end defun + @node File Notifications @section Notifications on File Changes @cindex file notifications @@ -2816,7 +2890,7 @@ of setting this variable for supporting images on MS-Windows: (svg "librsvg-2-2.dll") (gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") (glib "libglib-2.0-0.dll") - (gobject "libgobject-2.0-0.dll"))) + (gobject "libgobject-2.0-0.dll"))) @end example Note that image types @code{pbm} and @code{xbm} do not need entries in diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 84a7c325424..66d88e49411 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -467,18 +467,18 @@ built-in sequence types, @code{seq-length} behaves like @code{length}. @xref{Definition of length}. @end defun -@defun seq-p sequence +@defun seqp sequence This function returns non-@code{nil} if @var{sequence} is a sequence (a list or array), or any additional type of sequence defined via @file{seq.el} generic functions. @example @group -(seq-p [1 2]) +(seqp [1 2]) @result{} t @end group @group -(seq-p 2) +(seqp 2) @result{} nil @end group @end example diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index b93bc8f679f..9b488cb3125 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -6860,7 +6860,7 @@ to change some of the actual values. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Performance Issues, Limitations and Known Bugs, Sample Init File, Top @comment node-name, next, previous, up -@chapter Performance Issues +@appendix Performance Issues @cindex performance @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -6969,7 +6969,7 @@ more info. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Limitations and Known Bugs, FAQ, Performance Issues, Top @comment node-name, next, previous, up -@chapter Limitations and Known Bugs +@appendix Limitations and Known Bugs @cindex limitations @cindex bugs @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -332,6 +332,10 @@ unlike `bookmark-set' which silently updates an existing bookmark. --- *** `json-pretty-print' and `json-pretty-print-buffer' now maintain the ordering of object keys by default. +--- +*** New commands `json-pretty-print-ordered' and +`json-pretty-print-buffer-ordered' pretty prints JSON objects with +object keys sorted alphabetically. ** You can recompute the VC state of a file buffer with `M-x vc-refresh-state' ** Prog mode has some support for multi-mode indentation. @@ -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 <http://debbugs.gnu.org>. Bugs tagged "easy" ought to be suitable for diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index f0e9778f738..0e579deb2bb 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -16,9 +16,13 @@ along with this program. If not, see <http://www.gnu.org/licenses/>. */ #ifndef XALLOC_OVERSIZED_H_ -# define XALLOC_OVERSIZED_H_ +#define XALLOC_OVERSIZED_H_ -# include <stddef.h> +#include <stddef.h> + +#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_ */ diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index cf071e2a1f5..83aadc97c70 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -395,6 +395,7 @@ file. Archive and member name will be added." (define-key map "o" 'archive-extract-other-window) (define-key map "p" 'archive-previous-line) (define-key map "\C-p" 'archive-previous-line) + (define-key map [?\S-\ ] 'archive-previous-line) (define-key map [up] 'archive-previous-line) (define-key map "r" 'archive-rename-entry) (define-key map "u" 'archive-unflag) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index aa26ac38fc5..22f12bac99f 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/lisp/dired.el b/lisp/dired.el index 5f0a83afd04..9ec39af21ae 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1542,7 +1542,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "<" 'dired-prev-dirline) (define-key map ">" 'dired-next-dirline) (define-key map "^" 'dired-up-directory) - (define-key map " " 'dired-next-line) + (define-key map " " 'dired-next-line) + (define-key map [?\S-\ ] 'dired-previous-line) (define-key map [remap next-line] 'dired-next-line) (define-key map [remap previous-line] 'dired-previous-line) ;; hiding @@ -2031,7 +2032,7 @@ Otherwise, toggle `read-only-mode'." (defun dired-next-line (arg) "Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (let ((line-move-visual) (goal-column)) (line-move arg t)) @@ -2044,7 +2045,7 @@ Optional prefix ARG says how many lines to move; default is one line." (defun dired-previous-line (arg) "Move up lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (dired-next-line (- (or arg 1)))) (defun dired-next-dirline (arg &optional opoint) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 7ff9031b08d..98a3565f2c7 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -58,7 +58,7 @@ unquoted form. ARGS can also be a list of symbols, which stands for ('SYMBOL SYMBOL)." - `(and (pred map-p) + `(and (pred mapp) ,@(map--make-pcase-bindings args))) (defmacro map-let (keys map &rest body) @@ -155,7 +155,7 @@ MAP can be a list, hash-table or array." Map can be a nested map composed of alists, hash-tables and arrays." (or (seq-reduce (lambda (acc key) - (when (map-p acc) + (when (mapp acc) (map-elt acc key))) keys map) @@ -239,7 +239,7 @@ MAP can be a list, hash-table or array." (map-filter (lambda (key val) (not (funcall pred key val))) map)) -(defun map-p (map) +(defun mapp (map) "Return non-nil if MAP is a map (list, hash-table or array)." (or (listp map) (hash-table-p map) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2962da5a917..d811db9579f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1124,7 +1124,8 @@ FILE is the name of a file relative to that base location. This macro retrieves FILE from LOCATION into a temporary buffer, and evaluates BODY while that buffer is current. This work buffer is killed afterwards. Return the last value in BODY." - (declare (indent 2) (debug t)) + (declare (indent 2) (debug t) + (obsolete package--with-response-buffer "25.1")) `(with-temp-buffer (if (string-match-p "\\`https?:" ,location) (url-insert-file-contents (concat ,location ,file)) @@ -1134,47 +1135,52 @@ buffer is killed afterwards. Return the last value in BODY." (insert-file-contents (expand-file-name ,file ,location))) ,@body)) -(defmacro package--with-work-buffer-async (location file async &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -If ASYNC is non-nil, and if it is possible, run BODY -asynchronously. If an error is encountered and ASYNC is a -function, call it with no arguments (instead of executing BODY). -If it returns non-nil, or if it wasn't a function, propagate the -error. - -For a description of the other arguments see -`package--with-work-buffer'." - (declare (indent 3) (debug t)) - (macroexp-let2* macroexp-copyable-p - ((async-1 async) - (file-1 file) - (location-1 location)) - `(if (or (not ,async-1) - (not (string-match-p "\\`https?:" ,location-1))) - (package--with-work-buffer ,location-1 ,file-1 ,@body) - ;; This `condition-case' is to catch connection errors. - (condition-case error-signal - (url-retrieve (concat ,location-1 ,file-1) - ;; This is to catch execution errors. - (lambda (status) - (condition-case error-signal - (progn - (when-let ((er (plist-get status :error))) - (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er)) - (goto-char (point-min)) - (unless (search-forward "\n\n" nil 'noerror) - (error "Invalid url response in buffer %s" - (current-buffer))) - (delete-region (point-min) (point)) - ,@body - (kill-buffer (current-buffer))) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (signal (car error-signal) (cdr error-signal)))))) - nil - 'silent) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (message "Error contacting: %s" (concat ,location-1 ,file-1)) - (signal (car error-signal) (cdr error-signal)))))))) +(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) + "Access URL and run BODY in a buffer containing the response. +Point is after the headers when BODY runs. +FILE, if provided, is added to URL. +URL can be a local file name, which must be absolute. +ASYNC, if non-nil, runs the request asynchronously. +ERROR-FORM is run only if an error occurs. If NOERROR is +non-nil, don't propagate errors caused by the connection or by +BODY (does not apply to errors signaled by ERROR-FORM). + +\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" + (declare (indent defun) (debug t)) + (while (keywordp (car body)) + (setq body (cdr (cdr body)))) + (macroexp-let2* nil ((url-1 url)) + `(cl-macrolet ((wrap-errors (&rest bodyforms) + (let ((err (make-symbol "err"))) + `(condition-case ,err + ,(macroexp-progn bodyforms) + ,(list 'error ',error-form + (list 'unless ',noerror + `(signal (car ,err) (cdr ,err)))))))) + (if (string-match-p "\\`https?:" ,url-1) + (let* ((url (concat ,url-1 ,file)) + (callback (lambda (status) + (let ((b (current-buffer))) + (unwind-protect (wrap-errors + (when-let ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (error "Error retrieving: %s %S" url "incomprehensible buffer")) + (with-temp-buffer + (url-insert-buffer-contents b url) + (kill-buffer b) + (goto-char (point-min)) + ,@body))))))) + (if ,async + (wrap-errors (url-retrieve url callback nil 'silent)) + (with-current-buffer (wrap-errors (url-retrieve-synchronously url 'silent)) + (funcall callback nil)))) + (wrap-errors (with-temp-buffer + (let ((url (expand-file-name ,file ,url-1))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents url)) + ,@body)))))) (defun package--check-signature-content (content string &optional sig-file) "Check signature CONTENT against STRING. @@ -1220,15 +1226,12 @@ list can be empty). If the signatures file is not found, CALLBACK is called with no arguments." (let ((sig-file (concat file ".sig")) (string (or string (buffer-string)))) - (condition-case nil - (package--with-work-buffer-async - location sig-file (when async (or callback t)) - (let ((sig (package--check-signature-content - (buffer-string) string sig-file))) - (when callback (funcall callback sig)) - sig)) - (file-error (funcall callback))))) - + (package--with-response-buffer location :file sig-file + :async async :noerror t + :error-form (when callback (funcall callback nil)) + (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) string sig-file))) + (when callback (funcall callback sig)) + sig)))) ;;; Packages on Archives ;; The following variables store information about packages available @@ -1470,7 +1473,9 @@ Once it's empty, run `package--post-download-archives-hook'." ARCHIVE should be a cons cell of the form (NAME . LOCATION), similar to an entry in `package-alist'. Save the cached copy to \"archives/NAME/FILE\" in `package-user-dir'." - (package--with-work-buffer-async (cdr archive) file async + (package--with-response-buffer (cdr archive) :file file + :async async + :error-form (package--update-downloads-in-progress archive) (let* ((location (cdr archive)) (name (car archive)) (content (buffer-string)) @@ -1494,17 +1499,14 @@ similar to an entry in `package-alist'. Save the cached copy to ;; remove it from the in-progress list. (package--update-downloads-in-progress archive) (error "Unsigned archive `%s'" name)) + ;; Either everything worked or we don't mind not signing. ;; Write out the archives file. (write-region content nil local-file nil 'silent) ;; Write out good signatures into archive-contents.signed file. (when good-sigs (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") nil (concat local-file ".signed") nil 'silent)) - (package--update-downloads-in-progress archive) - ;; If we got this far, either everything worked or we don't mind - ;; not signing, so tell `package--with-work-buffer-async' to not - ;; propagate errors. - nil))))))) + (package--update-downloads-in-progress archive)))))))) (defun package--download-and-read-archives (&optional async) "Download descriptions of all `package-archives' and read them. @@ -1517,12 +1519,7 @@ perform the downloads asynchronously." :test #'equal)) (dolist (archive package-archives) (condition-case-unless-debug nil - (package--download-one-archive - archive "archive-contents" - ;; Called if the async download fails - (when async - ;; The t at the end means to propagate connection errors. - (lambda () (package--update-downloads-in-progress archive) t))) + (package--download-one-archive archive "archive-contents" async) (error (message "Failed to download `%s' archive." (car archive)))))) @@ -1777,7 +1774,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) (package-desc-suffix pkg-desc)))) - (package--with-work-buffer location file + (package--with-response-buffer location :file file (if (or (not package-check-signature) (member (package-desc-archive pkg-desc) package-unsigned-archives)) @@ -2368,26 +2365,23 @@ Otherwise no newline is inserted." (replace-match "")) (while (re-search-forward "^\\(;+ ?\\)" nil t) (replace-match "")))) - (let ((readme (expand-file-name (format "%s-readme.txt" name) - package-user-dir)) - readme-string) + (let* ((basename (format "%s-readme.txt" name)) + (readme (expand-file-name basename package-user-dir)) + readme-string) ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. - (cond ((condition-case nil - (save-excursion - (package--with-work-buffer - (package-archive-base desc) - (format "%s-readme.txt" name) - (save-excursion - (goto-char (point-max)) - (unless (bolp) - (insert ?\n))) - (write-region nil nil - (expand-file-name readme package-user-dir) - nil 'silent) - (setq readme-string (buffer-string)) - t)) - (error nil)) + (cond ((and (package-desc-archive desc) + (package--with-response-buffer (package-archive-base desc) + :file basename :noerror t + (save-excursion + (goto-char (point-max)) + (unless (bolp) + (insert ?\n))) + (write-region nil nil + (expand-file-name readme package-user-dir) + nil 'silent) + (setq readme-string (buffer-string)) + t)) (insert readme-string)) ((file-readable-p readme) (insert-file-contents readme) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 68265094c17..456efd077db 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: sequences -;; Version: 2.2 +;; Version: 2.3 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -46,7 +46,7 @@ ;; - `seq-elt' ;; - `seq-length' ;; - `seq-do' -;; - `seq-p' +;; - `seqp' ;; - `seq-subseq' ;; - `seq-into-sequence' ;; - `seq-copy' @@ -79,7 +79,7 @@ corresponding element of SEQUENCE. Extra elements of the sequence are ignored if fewer PATTERNS are given, and the match does not fail." - `(and (pred seq-p) + `(and (pred seqp) ,@(seq--make-pcase-bindings patterns))) (defmacro seq-let (args sequence &rest body) @@ -117,7 +117,7 @@ Return SEQUENCE." (defalias 'seq-each #'seq-do) -(cl-defgeneric seq-p (sequence) +(cl-defgeneric seqp (sequence) "Return non-nil if SEQUENCE is a sequence, nil otherwise." (sequencep sequence)) @@ -433,7 +433,7 @@ SEQUENCE must be a sequence of numbers or markers." "Return a list of `(seq ...)' pcase patterns from the argument list ARGS." (cons 'seq (seq-map (lambda (elt) - (if (seq-p elt) + (if (seqp elt) (seq--make-pcase-patterns elt) elt)) args))) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index ea8b52476f7..d389f6ec0a2 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/frame.el b/lisp/frame.el index 3f31a2973c6..f02406541a1 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) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 6d5f2a34c79..ecc5ac47624 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -392,17 +392,18 @@ spaces. Die Die Die." (if (consp chunk) (setq chunk (cdr chunk))) - (mapconcat - (lambda (char) - (cond - ((= char ? ) "+") - ((memq char mm-url-unreserved-chars) (char-to-string char)) - (t (upcase (format "%%%02x" char))))) - (mm-encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) - "")) + (if chunk + (mapconcat + (lambda (char) + (cond + ((= char ? ) "+") + ((memq char mm-url-unreserved-chars) (char-to-string char)) + (t (upcase (format "%%%02x" char))))) + (mm-encode-coding-string chunk + (if (fboundp 'find-coding-systems-string) + (car (find-coding-systems-string chunk)) + buffer-file-coding-system)) + ""))) (defun mm-url-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." diff --git a/lisp/image-mode.el b/lisp/image-mode.el index e6d6a3edb71..8ef9c277c36 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -658,7 +658,12 @@ was inserted." (not (and (boundp 'archive-superior-buffer) archive-superior-buffer)) (not (and (boundp 'tar-superior-buffer) - tar-superior-buffer))))) + tar-superior-buffer)) + ;; This means the buffer holds the + ;; decrypted content (bug#21870). + (not (and (boundp 'epa-file-encrypt-to) + (local-variable-p + 'epa-file-encrypt-to)))))) (file-or-data (if data-p (string-make-unibyte (buffer-substring-no-properties (point-min) (point-max))) diff --git a/lisp/json.el b/lisp/json.el index 97cf9934c34..0214a3e3a4d 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -52,6 +52,8 @@ ;;; Code: +(require 'map) + ;; Parameters (defvar json-object-type 'alist @@ -111,6 +113,13 @@ Used only when `json-encoding-pretty-print' is non-nil.") "If non-nil, ] and } closings will be formatted lisp-style, without indentation.") +(defvar json-encoding-object-sort-predicate nil + "Sorting predicate for JSON object keys during encoding. +If nil, no sorting is performed. Else, JSON object keys are +ordered by the specified sort predicate during encoding. For +instance, setting this to `string<' will have JSON object keys +ordered alphabetically.") + (defvar json-pre-element-read-function nil "Function called (if non-nil) by `json-read-array' and `json-read-object' right before reading a JSON array or object, @@ -159,6 +168,15 @@ Unlike `reverse', this keeps the property-value pairs intact." (push prop res))) res)) +(defun json--plist-to-alist (plist) + "Return an alist of the property-value pairs in PLIST." + (let (res) + (while plist + (let ((prop (pop plist)) + (val (pop plist))) + (push (cons prop val) res))) + (nreverse res))) + (defmacro json--with-indentation (body) `(let ((json--encoding-current-indentation (if json-encoding-pretty-print @@ -492,32 +510,39 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-encode-hash-table (hash-table) "Return a JSON representation of HASH-TABLE." - (format "{%s%s}" - (json-join - (let (r) - (json--with-indentation - (maphash - (lambda (k v) - (push (format - (if json-encoding-pretty-print - "%s%s: %s" - "%s%s:%s") - json--encoding-current-indentation - (json-encode-key k) - (json-encode v)) - r)) - hash-table)) - r) - json-encoding-separator) - (if (or (not json-encoding-pretty-print) - json-encoding-lisp-style-closings) - "" - json--encoding-current-indentation))) + (if json-encoding-object-sort-predicate + (json-encode-alist (map-into hash-table 'list)) + (format "{%s%s}" + (json-join + (let (r) + (json--with-indentation + (maphash + (lambda (k v) + (push (format + (if json-encoding-pretty-print + "%s%s: %s" + "%s%s:%s") + json--encoding-current-indentation + (json-encode-key k) + (json-encode v)) + r)) + hash-table)) + r) + json-encoding-separator) + (if (or (not json-encoding-pretty-print) + json-encoding-lisp-style-closings) + "" + json--encoding-current-indentation)))) ;; List encoding (including alists and plists) (defun json-encode-alist (alist) "Return a JSON representation of ALIST." + (when json-encoding-object-sort-predicate + (setq alist + (sort alist (lambda (a b) + (funcall json-encoding-object-sort-predicate + (car a) (car b)))))) (format "{%s%s}" (json-join (json--with-indentation @@ -537,25 +562,27 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-encode-plist (plist) "Return a JSON representation of PLIST." - (let (result) - (json--with-indentation - (while plist - (push (concat - json--encoding-current-indentation - (json-encode-key (car plist)) - (if json-encoding-pretty-print - ": " - ":") - (json-encode (cadr plist))) - result) - (setq plist (cddr plist)))) - (concat "{" - (json-join (nreverse result) json-encoding-separator) - (if (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings)) + (if json-encoding-object-sort-predicate + (json-encode-alist (json--plist-to-alist plist)) + (let (result) + (json--with-indentation + (while plist + (push (concat json--encoding-current-indentation - "") - "}"))) + (json-encode-key (car plist)) + (if json-encoding-pretty-print + ": " + ":") + (json-encode (cadr plist))) + result) + (setq plist (cddr plist)))) + (concat "{" + (json-join (nreverse result) json-encoding-separator) + (if (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings)) + json--encoding-current-indentation + "") + "}")))) (defun json-encode-list (list) "Return a JSON representation of LIST. @@ -698,6 +725,18 @@ Advances point just past JSON object." (txt (delete-and-extract-region begin end))) (insert (json-encode (json-read-from-string txt)))))) +(defun json-pretty-print-buffer-ordered () + "Pretty-print current buffer with object keys ordered." + (interactive) + (let ((json-encoding-object-sort-predicate 'string<)) + (json-pretty-print-buffer))) + +(defun json-pretty-print-ordered (begin end) + "Pretty-print the region with object keys ordered." + (interactive "r") + (let ((json-encoding-object-sort-predicate 'string<)) + (json-pretty-print begin end))) + (provide 'json) ;;; json.el ends here diff --git a/lisp/linum.el b/lisp/linum.el index 7b6a3ea4e42..4e0bc56877a 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -120,7 +120,15 @@ Linum mode is a buffer-local minor mode." (mapc #'delete-overlay linum-overlays) (setq linum-overlays nil) (dolist (w (get-buffer-window-list (current-buffer) nil t)) - (set-window-margins w 0 (cdr (window-margins w))))) + ;; restore margins if needed FIXME: This still fails if the + ;; "other" mode has incidently set margins to exactly what linum + ;; had: see bug#20674 for a similar workaround in nlinum.el + (let ((set-margins (window-parameter w 'linum--set-margins)) + (current-margins (window-margins w))) + (when (and set-margins + (equal set-margins current-margins)) + (set-window-margins w 0 (cdr current-margins)) + (set-window-parameter w 'linum--set-margins nil))))) (defun linum-update-current () "Update line numbers for the current buffer." @@ -143,10 +151,10 @@ Linum mode is a buffer-local minor mode." (defun linum--face-width (face) (let ((info (font-info (face-font face))) - width) + width) (setq width (aref info 11)) (if (<= width 0) - (setq width (aref info 10))) + (setq width (aref info 10))) width)) (defun linum-update-window (win) @@ -170,7 +178,7 @@ Linum mode is a buffer-local minor mode." (visited (catch 'visited (dolist (o (overlays-in (point) (point))) (when (equal-including-properties - (overlay-get o 'linum-str) str) + (overlay-get o 'linum-str) str) (unless (memq o linum-overlays) (push o linum-overlays)) (setq linum-available (delq o linum-available)) @@ -193,7 +201,12 @@ Linum mode is a buffer-local minor mode." (setq width (ceiling (/ (* width 1.0 (linum--face-width 'linum)) (frame-char-width))))) - (set-window-margins win width (cdr (window-margins win))))) + ;; open up space in the left margin, if needed, and record that + ;; fact as the window-parameter `linum--set-margins' + (let ((existing-margins (window-margins win))) + (when (> width (or (car existing-margins) 0)) + (set-window-margins win width (cdr existing-margins)) + (set-window-parameter win 'linum--set-margins (window-margins win)))))) (defun linum-after-change (beg end _len) ;; update overlays on deletions, and after newlines are inserted diff --git a/lisp/loadup.el b/lisp/loadup.el index fef111f6611..f0caa8be349 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) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 58deaea6f53..a48d098fe26 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -203,6 +203,12 @@ cid: URL as the argument.") (goto-char begin) (shr-insert-document dom)))) +(defun shr--have-one-fringe-p () + "Return non-nil if we know at least one of the fringes has non-zero width." + (and (fboundp 'fringe-columns) + (or (not (zerop (fringe-columns 'right))) + (not (zerop (fringe-columns 'left)))))) + ;;;###autoload (defun shr-insert-document (dom) "Render the parsed document DOM into the current buffer. @@ -230,19 +236,13 @@ DOM should be a parse tree as generated by (if (not shr-use-fonts) (- (window-body-width) 1 (if (and (null shr-width) - (or (zerop - (fringe-columns 'right)) - (zerop - (fringe-columns 'left)))) + (not (shr--have-one-fringe-p))) 0 1)) (- (window-body-width nil t) (* 2 (frame-char-width)) (if (and (null shr-width) - (or (zerop - (fringe-columns 'right)) - (zerop - (fringe-columns 'left)))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))))) (shr-descend dom) @@ -466,8 +466,7 @@ size, and full-buffer size." ;; to usurp one column for the ;; continuation glyph. (if (and (null shr-width) - (or (zerop (fringe-columns 'right)) - (zerop (fringe-columns 'left)))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))) (shr-insert text) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 83173250137..71d42459974 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1,14 +1,15 @@ -;;;; soap-client.el -- Access SOAP web services -*- lexical-binding: t -*- +;;; soap-client.el --- Access SOAP web services -*- lexical-binding: t -*- ;; Copyright (C) 2009-2015 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Created: December, 2009 -;; Version: 3.0.1 +;; Version: 3.0.2 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client +;; Package-Requires: ((cl-lib "0.5")) ;; This file is part of GNU Emacs. @@ -43,6 +44,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'xml) (require 'xsd-regexp) @@ -57,8 +59,8 @@ (defsubst soap-warning (message &rest args) "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." - (display-warning 'soap-client (apply #'format-message message args) - :warning)) + ;; Do not use #'format-message, to support older Emacs versions. + (display-warning 'soap-client (apply #'format message args) :warning)) (defgroup soap-client nil "Access SOAP web services from Emacs." @@ -1246,9 +1248,9 @@ See also `soap-wsdl-resolve-references'." (error (push (cadr error-object) messages)))) (when messages (error (mapconcat 'identity (nreverse messages) "; and: ")))) - (cl-flet ((fail-with-message (format value) - (push (format format value) messages) - (throw 'invalid nil))) + (cl-labels ((fail-with-message (format value) + (push (format format value) messages) + (throw 'invalid nil))) (catch 'invalid (let ((enumeration (soap-xs-simple-type-enumeration type))) (when (and (> (length enumeration) 1) @@ -2753,7 +2755,14 @@ decode function to perform the actual decoding." ;;;; Soap Envelope parsing -(define-error 'soap-error "SOAP error") +(if (fboundp 'define-error) + (define-error 'soap-error "SOAP error") + ;; Support older Emacs versions that do not have define-error, so + ;; that soap-client can remain unchanged in GNU ELPA. + (put 'soap-error + 'error-conditions + '(error soap-error)) + (put 'soap-error 'error-message "SOAP error")) (defun soap-parse-envelope (node operation wsdl) "Parse the SOAP envelope in NODE and return the response. diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index b01e2bf76f1..a4430417ad0 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -1,10 +1,9 @@ -;;;; soap-inspect.el -- Interactive WSDL inspector -*- lexical-binding: t -*- +;;; soap-inspect.el --- Interactive WSDL inspector -*- lexical-binding: t -*- ;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Created: October 2010 -;; Version: 3.0.1 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client diff --git a/lisp/obarray.el b/lisp/obarray.el new file mode 100644 index 00000000000..a93c9a94c33 --- /dev/null +++ b/lisp/obarray.el @@ -0,0 +1,66 @@ +;;; obarray.el --- obarray functions -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: obarray functions +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file provides function for working with obarrays. + +;;; Code: + +(defconst obarray-default-size 59 + "The value 59 is an arbitrary prime number that gives a good hash.") + +(defun obarray-make (&optional size) + "Return a new obarray of size SIZE or `obarray-default-size'." + (let ((size (or size obarray-default-size))) + (if (< 0 size) + (make-vector size 0) + (signal 'wrong-type-argument '(size 0))))) + +(defun obarrayp (object) + "Return t if OBJECT is an obarray." + (and (vectorp object) + (< 0 (length object)))) + +;; Don’t use obarray as a variable name to avoid shadowing. +(defun obarray-get (ob name) + "Return symbol named NAME if it is contained in obarray OB. +Return nil otherwise." + (intern-soft name ob)) + +(defun obarray-put (ob name) + "Return symbol named NAME from obarray OB. +Creates and adds the symbol if doesn't exist." + (intern name ob)) + +(defun obarray-remove (ob name) + "Remove symbol named NAME if it is contained in obarray OB. +Return t on success, nil otherwise." + (unintern name ob)) + +(defun obarray-map (fn ob) + "Call function FN on every symbol in obarray OB and return nil." + (mapatoms fn ob)) + +(provide 'obarray) +;;; obarray.el ends here diff --git a/lisp/proced.el b/lisp/proced.el index bf7ce24f202..502a90e2dc9 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -463,6 +463,7 @@ Important: the match ends just after the marker.") (define-key km "\C-n" 'next-line) (define-key km "\C-p" 'previous-line) (define-key km "\C-?" 'previous-line) + (define-key km [?\S-\ ] 'previous-line) (define-key km [down] 'next-line) (define-key km [up] 'previous-line) ;; marking diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 6382b145211..6572cee2cc7 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1449,13 +1449,12 @@ This function does not do any hidden buffer changes." ;; same line. (re-search-forward "\\=\\s *[\n\r]" start t) - (if (if (let (open-paren-in-column-0-is-defun-start) (forward-comment -1)) + (if (if (forward-comment -1) (if (eolp) ;; If forward-comment above succeeded and we're at eol ;; then the newline we moved over above didn't end a ;; line comment, so we give it another go. - (let (open-paren-in-column-0-is-defun-start) - (forward-comment -1)) + (forward-comment -1) t)) ;; Emacs <= 20 and XEmacs move back over the closer of a @@ -1482,7 +1481,7 @@ comment at the start of cc-engine.el for more info." ;; return t when moving backwards at bob. (not (bobp)) - (if (let (open-paren-in-column-0-is-defun-start moved-comment) + (if (let (moved-comment) (while (and (not (setq moved-comment (forward-comment -1))) ;; Cope specifically with ^M^J here - @@ -2524,6 +2523,20 @@ comment at the start of cc-engine.el for more info." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Defuns which analyze the buffer, yet don't change `c-state-cache'. +(defun c-get-fallback-scan-pos (here) + ;; Return a start position for building `c-state-cache' from + ;; scratch. This will be at the top level, 2 defuns back. + (save-excursion + ;; Go back 2 bods, but ignore any bogus positions returned by + ;; beginning-of-defun (i.e. open paren in column zero). + (goto-char here) + (let ((cnt 2)) + (while (not (or (bobp) (zerop cnt))) + (c-beginning-of-defun-1) ; Pure elisp BOD. + (if (eq (char-after) ?\{) + (setq cnt (1- cnt))))) + (point))) + (defun c-state-balance-parens-backwards (here- here+ top) ;; Return the position of the opening paren/brace/bracket before HERE- which ;; matches the outermost close p/b/b between HERE+ and TOP. Except when @@ -2584,22 +2597,46 @@ comment at the start of cc-engine.el for more info." ;; o - ('backward nil) - scan backwards (from HERE). ;; o - ('back-and-forward START-POINT) - like 'forward, but when HERE is earlier ;; than GOOD-POS. + ;; o - ('BOD START-POINT) - scan forwards from START-POINT, which is at the + ;; top level. ;; o - ('IN-LIT nil) - point is inside the literal containing point-min. (let ((cache-pos (c-get-cache-scan-pos here)) ; highest position below HERE in cache (or 1) - strategy ; 'forward, 'backward, or 'IN-LIT. - start-point) + BOD-pos ; position of 2nd BOD before HERE. + strategy ; 'forward, 'backward, 'BOD, or 'IN-LIT. + start-point + how-far) ; putative scanning distance. (setq good-pos (or good-pos (c-state-get-min-scan-pos))) (cond ((< here (c-state-get-min-scan-pos)) - (setq strategy 'IN-LIT)) + (setq strategy 'IN-LIT + start-point nil + cache-pos nil + how-far 0)) ((<= good-pos here) (setq strategy 'forward - start-point (max good-pos cache-pos))) + start-point (max good-pos cache-pos) + how-far (- here start-point))) ((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting. - (setq strategy 'backward)) + (setq strategy 'backward + how-far (- good-pos here))) (t (setq strategy 'back-and-forward - start-point cache-pos))) + start-point cache-pos + how-far (- here start-point)))) + + ;; Might we be better off starting from the top level, two defuns back, + ;; instead? This heuristic no longer works well in C++, where + ;; declarations inside namespace brace blocks are frequently placed at + ;; column zero. (2015-11-10): Remove the condition on C++ Mode. + (when (and (or (not (memq 'col-0-paren c-emacs-features)) + open-paren-in-column-0-is-defun-start) + ;; (not (c-major-mode-is 'c++-mode)) + (> how-far c-state-cache-too-far)) + (setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!! + (if (< (- here BOD-pos) how-far) + (setq strategy 'BOD + start-point BOD-pos))) + (list strategy start-point))) @@ -3227,8 +3264,7 @@ comment at the start of cc-engine.el for more info." ;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value ;; below `here'. To maintain its consistency, we may need to insert a new ;; brace pair. - (let (open-paren-in-column-0-is-defun-start - (here-bol (c-point 'bol here)) + (let ((here-bol (c-point 'bol here)) too-high-pa ; recorded {/(/[ next above here, or nil. dropped-cons ; was the last removed element a brace pair? pa) @@ -3299,7 +3335,6 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let* ((here (point)) (here-bopl (c-point 'bopl)) - open-paren-in-column-0-is-defun-start strategy ; 'forward, 'backward etc.. ;; Candidate positions to start scanning from: cache-pos ; highest position below HERE already existing in @@ -3320,9 +3355,13 @@ comment at the start of cc-engine.el for more info." strategy (car res) start-point (cadr res)) + (when (eq strategy 'BOD) + (setq c-state-cache nil + c-state-cache-good-pos start-point)) + ;; SCAN! (cond - ((memq strategy '(forward back-and-forward)) + ((memq strategy '(forward back-and-forward BOD)) (setq res (c-remove-stale-state-cache start-point here here-bopl)) (setq cache-pos (car res) scan-backward-pos (cadr res) @@ -9571,7 +9610,6 @@ comment at the start of cc-engine.el for more info." (c-save-buffer-state ((indent-point (point)) (case-fold-search nil) - open-paren-in-column-0-is-defun-start ;; A whole ugly bunch of various temporary variables. Have ;; to declare them here since it's not possible to declare ;; a variable with only the scope of a cond test and the diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 1b6a233067c..a46ee15ed5e 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1098,10 +1098,9 @@ Note that the style variables are always made local to the buffer." (buffer-substring-no-properties beg end))))))) (if c-get-state-before-change-functions - (let (open-paren-in-column-0-is-defun-start) - (mapc (lambda (fn) - (funcall fn beg end)) - c-get-state-before-change-functions))) + (mapc (lambda (fn) + (funcall fn beg end)) + c-get-state-before-change-functions)) ))) ;; The following must be done here rather than in `c-after-change' because ;; newly inserted parens would foul up the invalidation algorithm. @@ -1132,7 +1131,7 @@ Note that the style variables are always made local to the buffer." (unless (c-called-from-text-property-change-p) (setq c-just-done-before-change nil) - (c-save-buffer-state (case-fold-search open-paren-in-column-0-is-defun-start) + (c-save-buffer-state (case-fold-search) ;; When `combine-after-change-calls' is used we might get calls ;; with regions outside the current narrowing. This has been ;; observed in Emacs 20.7. @@ -1268,8 +1267,7 @@ Note that the style variables are always made local to the buffer." ;; ;; Type a space in the first blank line, and the fontification of the next ;; line was fouled up by context fontification. - (let (new-beg new-end new-region case-fold-search - open-paren-in-column-0-is-defun-start) + (let (new-beg new-end new-region case-fold-search) (if (and c-in-after-change-fontification (< beg c-new-END) (> end c-new-BEG)) ;; Region and the latest after-change fontification region overlap. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index a19542fb204..2c22483e86f 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) @@ -802,9 +795,10 @@ 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) +(cl-defmethod xref-backend-references ((_backend (eql elisp)) symbol) "Find all references to SYMBOL (a string) in the current project." (cl-mapcan (lambda (dir) @@ -814,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)) @@ -831,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 38c5cc2bdb6..ae1aa11fbc2 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/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 489094b2e4f..3081060f46a 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) @@ -3225,56 +3234,68 @@ A change is considered significant if it affects the buffer text in any way that isn't completely restored again. Any user-visible changes to the buffer must not be within a `verilog-save-buffer-state'." - ;; From c-save-buffer-state - `(let* ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (verilog-no-change-functions t) - before-change-functions - after-change-functions - deactivate-mark - buffer-file-name ; Prevent primitives checking - buffer-file-truename) ; for file modification - (unwind-protect - (progn ,@body) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) + `(let ((inhibit-point-motion-hooks t) + (verilog-no-change-functions t)) + ,(if (fboundp 'with-silent-modifications) + `(with-silent-modifications ,@body) + ;; From c-save-buffer-state + `(let* ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-modification-hooks t) + ;; XEmacs ignores inhibit-modification-hooks. + before-change-functions after-change-functions + deactivate-mark + buffer-file-name ; Prevent primitives checking + buffer-file-truename) ; for file modification + (unwind-protect + (progn ,@body) + (and (not modified) + (buffer-modified-p) + (if (fboundp 'restore-buffer-modified-p) + (restore-buffer-modified-p nil) + (set-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))) + ;; FIXME: Doesn't the before/after-change-functions dance make this + ;; font-lock-mode dance unnecessary? + (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) + ,@(when (featurep 'xemacs) + ;; XEmacs ignores inhibit-modification-hooks. + '(before-change-functions + after-change-functions))) + (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 +8095,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 +8398,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 +8594,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 +8610,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 +8620,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 +8634,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 +8653,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 +8666,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 +8679,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 +8692,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 +8706,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 +8726,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 +8745,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 +8776,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 +9922,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 +9987,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 +10031,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 +10221,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 +10252,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 +10538,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 +10583,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 +10713,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 +10738,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 +10767,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 +10835,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 +11098,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 +11123,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 +11212,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 +13371,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 +13576,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: ;; diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 89a06046ca2..6a3b42ff646 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 @@ -38,15 +45,19 @@ ;; 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 -;; `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: @@ -79,8 +90,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: @@ -109,7 +120,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)) @@ -176,55 +187,60 @@ 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 -(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. @@ -232,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) @@ -345,22 +359,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 +493,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' @@ -695,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)) @@ -705,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)))) @@ -714,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))) @@ -799,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") @@ -826,10 +834,11 @@ 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) + ;; TODO: Implement "lightweight" buffer visiting, so that we + ;; don't have to kill them. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -860,9 +869,9 @@ 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)) + ;; TODO: Same as above. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -918,7 +927,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)))) @@ -926,18 +935,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)) - (current-column) - loc))))))) + (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) diff --git a/lisp/rect.el b/lisp/rect.el index acd3a48f2da..46ebbf259cf 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 d6590c5516a..b6802aeaf57 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: (\\<query-replace-map>\\[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 1f2f4fe0444..deb5c888c92 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, @@ -2768,6 +2787,143 @@ with < or <= based on USE-<." '(0 . 0))) '(0 . 0))) +;;; Default undo-boundary addition +;; +;; This section adds a new undo-boundary at either after a command is +;; called or in some cases on a timer called after a change is made in +;; any buffer. +(defvar-local undo-auto--last-boundary-cause nil + "Describe the cause of the last undo-boundary. + +If `explicit', the last boundary was caused by an explicit call to +`undo-boundary', that is one not called by the code in this +section. + +If it is equal to `timer', then the last boundary was inserted +by `undo-auto--boundary-timer'. + +If it is equal to `command', then the last boundary was inserted +automatically after a command, that is by the code defined in +this section. + +If it is equal to a list, then the last boundary was inserted by +an amalgamating command. The car of the list is the number of +times an amalgamating command has been called, and the cdr are the +buffers that were changed during the last command.") + +(defvar undo-auto--current-boundary-timer nil + "Current timer which will run `undo-auto--boundary-timer' or nil. + +If set to non-nil, this will effectively disable the timer.") + +(defvar undo-auto--this-command-amalgamating nil + "Non-nil if `this-command' should be amalgamated. +This variable is set to nil by `undo-auto--boundaries' and is set +by `undo-auto--amalgamate'." ) + +(defun undo-auto--needs-boundary-p () + "Return non-nil if `buffer-undo-list' needs a boundary at the start." + (car-safe buffer-undo-list)) + +(defun undo-auto--last-boundary-amalgamating-number () + "Return the number of amalgamating last commands or nil. +Amalgamating commands are, by default, either +`self-insert-command' and `delete-char', but can be any command +that calls `undo-auto--amalgamate'." + (car-safe undo-auto--last-boundary-cause)) + +(defun undo-auto--ensure-boundary (cause) + "Add an `undo-boundary' to the current buffer if needed. +REASON describes the reason that the boundary is being added; see +`undo-auto--last-boundary' for more information." + (when (and + (undo-auto--needs-boundary-p)) + (let ((last-amalgamating + (undo-auto--last-boundary-amalgamating-number))) + (undo-boundary) + (setq undo-auto--last-boundary-cause + (if (eq 'amalgamate cause) + (cons + (if last-amalgamating (1+ last-amalgamating) 0) + undo-auto--undoably-changed-buffers) + cause))))) + +(defun undo-auto--boundaries (cause) + "Check recently changed buffers and add a boundary if necessary. +REASON describes the reason that the boundary is being added; see +`undo-last-boundary' for more information." + (dolist (b undo-auto--undoably-changed-buffers) + (when (buffer-live-p b) + (with-current-buffer b + (undo-auto--ensure-boundary cause)))) + (setq undo-auto--undoably-changed-buffers nil)) + +(defun undo-auto--boundary-timer () + "Timer which will run `undo--auto-boundary-timer'." + (setq undo-auto--current-boundary-timer nil) + (undo-auto--boundaries 'timer)) + +(defun undo-auto--boundary-ensure-timer () + "Ensure that the `undo-auto-boundary-timer' is set." + (unless undo-auto--current-boundary-timer + (setq undo-auto--current-boundary-timer + (run-at-time 10 nil #'undo-auto--boundary-timer)))) + +(defvar undo-auto--undoably-changed-buffers nil + "List of buffers that have changed recently. + +This list is maintained by `undo-auto--undoable-change' and +`undo-auto--boundaries' and can be affected by changes to their +default values. + +See also `undo-auto--buffer-undoably-changed'.") + +(defun undo-auto--add-boundary () + "Add an `undo-boundary' in appropriate buffers." + (undo-auto--boundaries + (if undo-auto--this-command-amalgamating + 'amalgamate + 'command)) + (setq undo-auto--this-command-amalgamating nil)) + +(defun undo-auto--amalgamate () + "Amalgamate undo if necessary. +This function can be called after an amalgamating command. It +removes the previous `undo-boundary' if a series of such calls +have been made. By default `self-insert-command' and +`delete-char' are the only amalgamating commands, although this +function could be called by any command wishing to have this +behaviour." + (let ((last-amalgamating-count + (undo-auto--last-boundary-amalgamating-number))) + (setq undo-auto--this-command-amalgamating t) + (when + last-amalgamating-count + (if + (and + (< last-amalgamating-count 20) + (eq this-command last-command)) + ;; Amalgamate all buffers that have changed. + (dolist (b (cdr undo-auto--last-boundary-cause)) + (when (buffer-live-p b) + (with-current-buffer + b + (when + ;; The head of `buffer-undo-list' is nil. + ;; `car-safe' doesn't work because + ;; `buffer-undo-list' need not be a list! + (and (listp buffer-undo-list) + (not (car buffer-undo-list))) + (setq buffer-undo-list + (cdr buffer-undo-list)))))) + (setq undo-auto--last-boundary-cause 0))))) + +(defun undo-auto--undoable-change () + "Called after every undoable buffer change." + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)) + (undo-auto--boundary-ensure-timer)) +;; End auto-boundary section + (defcustom undo-ask-before-discard nil "If non-nil ask about discarding undo info for the current command. Normally, Emacs discards the undo info for the current command if @@ -3282,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 @@ -3345,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 @@ -3354,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))) @@ -5038,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)))) @@ -6497,7 +6673,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)))) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index a5d9f37b5ee..bafe3e52725 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -309,6 +309,29 @@ They count bytes from the beginning of the body." (defvar url-http-codes) +(defun url-insert-buffer-contents (buffer url &optional visit beg end replace) + "Insert the contents of BUFFER into current buffer. +This is like `url-insert', but also decodes the current buffer as +if it had been inserted from a file named URL." + (if visit (setq buffer-file-name url)) + (save-excursion + (let* ((start (point)) + (size-and-charset (url-insert buffer beg end))) + (kill-buffer buffer) + (when replace + (delete-region (point-min) start) + (delete-region (point) (point-max))) + (unless (cadr size-and-charset) + ;; If the headers don't specify any particular charset, use the + ;; usual heuristic/rules that we apply to files. + (decode-coding-inserted-region (point-min) (point) url + visit beg end replace)) + (let ((inserted (car size-and-charset))) + (when (fboundp 'after-insert-file-set-coding) + (let ((insval (after-insert-file-set-coding inserted visit))) + (if insval (setq inserted insval)))) + (list url inserted))))) + ;;;###autoload (defun url-insert-file-contents (url &optional visit beg end replace) (let ((buffer (url-retrieve-synchronously url))) @@ -323,24 +346,7 @@ They count bytes from the beginning of the body." (kill-buffer buffer) ;; Signal file-error per http://debbugs.gnu.org/16733. (signal 'file-error (list url desc)))))) - (if visit (setq buffer-file-name url)) - (save-excursion - (let* ((start (point)) - (size-and-charset (url-insert buffer beg end))) - (kill-buffer buffer) - (when replace - (delete-region (point-min) start) - (delete-region (point) (point-max))) - (unless (cadr size-and-charset) - ;; If the headers don't specify any particular charset, use the - ;; usual heuristic/rules that we apply to files. - (decode-coding-inserted-region start (point) url - visit beg end replace)) - (let ((inserted (car size-and-charset))) - (when (fboundp 'after-insert-file-set-coding) - (let ((insval (after-insert-file-set-coding inserted visit))) - (if insval (setq inserted insval)))) - (list url inserted)))))) + (url-insert-buffer-contents buffer url visit beg end replace))) (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 464e3754eb9..f4d7fe7d9aa 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) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9b15e64fad7..3b3fb68f171 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -271,6 +271,7 @@ See `run-hooks'." (define-key map " " 'vc-dir-next-line) (define-key map "\t" 'vc-dir-next-directory) (define-key map "p" 'vc-dir-previous-line) + (define-key map [?\S-\ ] 'vc-dir-previous-line) (define-key map [backtab] 'vc-dir-previous-directory) ;;; Rebind paragraph-movement commands. (define-key map "\M-}" 'vc-dir-next-directory) diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index e1609f2f470..c82b27a1ea2 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/ diff --git a/src/Makefile.in b/src/Makefile.in index 6a8571803f5..d7ad3954579 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -128,8 +128,9 @@ LIB_PTHREAD=@LIB_PTHREAD@ LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ +XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ -LIBX_EXTRA=-lX11 $(XFT_LIBS) +LIBX_EXTRA=-lX11 $(XCB_LIBS) $(XFT_LIBS) FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ diff --git a/src/casefiddle.c b/src/casefiddle.c index b94ea8e212e..6a2983ef018 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; } diff --git a/src/cmds.c b/src/cmds.c index 0afc023e681..167ebb74302 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -218,36 +218,6 @@ to t. */) return Qnil; } -static int nonundocount; - -static void -remove_excessive_undo_boundaries (void) -{ - bool remove_boundary = true; - - if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command))) - nonundocount = 0; - - if (NILP (Vexecuting_kbd_macro)) - { - if (nonundocount <= 0 || nonundocount >= 20) - { - remove_boundary = false; - nonundocount = 0; - } - nonundocount++; - } - - if (remove_boundary - && CONSP (BVAR (current_buffer, undo_list)) - && NILP (XCAR (BVAR (current_buffer, undo_list))) - /* Only remove auto-added boundaries, not boundaries - added by explicit calls to undo-boundary. */ - && EQ (BVAR (current_buffer, undo_list), last_undo_boundary)) - /* Remove the undo_boundary that was just pushed. */ - bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list))); -} - DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP", doc: /* Delete the following N characters (previous if N is negative). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). @@ -263,7 +233,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) CHECK_NUMBER (n); if (eabs (XINT (n)) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); pos = PT + XINT (n); if (NILP (killflag)) @@ -309,20 +279,19 @@ At the end, it runs `post-self-insert-hook'. */) error ("Negative repetition argument %"pI"d", XINT (n)); if (XFASTINT (n) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) bitch_at_user (); - else - { - int character = translate_char (Vtranslation_table_for_input, - XINT (last_command_event)); - int val = internal_self_insert (character, XFASTINT (n)); - if (val == 2) - nonundocount = 0; - frame_make_pointer_invisible (SELECTED_FRAME ()); - } + else { + int character = translate_char (Vtranslation_table_for_input, + XINT (last_command_event)); + int val = internal_self_insert (character, XFASTINT (n)); + if (val == 2) + Fset (Qundo_auto__this_command_amalgamating, Qnil); + frame_make_pointer_invisible (SELECTED_FRAME ()); + } return Qnil; } @@ -525,6 +494,10 @@ internal_self_insert (int c, EMACS_INT n) void syms_of_cmds (void) { + DEFSYM (Qundo_auto__amalgamate, "undo-auto--amalgamate"); + DEFSYM (Qundo_auto__this_command_amalgamating, + "undo-auto--this-command-amalgamating"); + DEFSYM (Qkill_forward_chars, "kill-forward-chars"); /* A possible value for a buffer's overwrite-mode variable. */ @@ -554,7 +527,6 @@ keys_of_cmds (void) { int n; - nonundocount = 0; initial_define_key (global_map, Ctl ('I'), "self-insert-command"); for (n = 040; n < 0177; n++) initial_define_key (global_map, n, "self-insert-command"); diff --git a/src/ftfont.c b/src/ftfont.c index 57ded171de4..17e41a9339e 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++) diff --git a/src/image.c b/src/image.c index 41687eb885c..544435eac0b 100644 --- a/src/image.c +++ b/src/image.c @@ -3508,6 +3508,14 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) attrs.valuemask |= XpmVisual; attrs.valuemask |= XpmColormap; +#ifdef ALLOC_XPM_COLORS + attrs.color_closure = f; + attrs.alloc_color = xpm_alloc_color; + attrs.free_colors = xpm_free_colors; + attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure; + xpm_init_color_cache (f, &attrs); +#endif + rc = XpmCreatePixmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), (char **) bits, &bitmap, &mask, &attrs); if (rc != XpmSuccess) @@ -3526,6 +3534,9 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) dpyinfo->bitmaps[id - 1].depth = attrs.depth; dpyinfo->bitmaps[id - 1].refcount = 1; +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif XpmFreeAttributes (&attrs); return id; } diff --git a/src/keyboard.c b/src/keyboard.c index a6ada2106fb..ab7cb34a030 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1230,9 +1230,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, bool, bool, bool, bool); static void adjust_point_for_property (ptrdiff_t, bool); -/* The last boundary auto-added to buffer-undo-list. */ -Lisp_Object last_undo_boundary; - Lisp_Object command_loop_1 (void) { @@ -1448,13 +1445,10 @@ command_loop_1 (void) } #endif - { - Lisp_Object undo = BVAR (current_buffer, undo_list); - Fundo_boundary (); - last_undo_boundary - = (EQ (undo, BVAR (current_buffer, undo_list)) - ? Qnil : BVAR (current_buffer, undo_list)); - } + /* Ensure that we have added appropriate undo-boundaries as a + result of changes from the last command. */ + call0 (Qundo_auto__add_boundary); + call1 (Qcommand_execute, Vthis_command); #ifdef HAVE_WINDOW_SYSTEM @@ -10909,6 +10903,8 @@ syms_of_keyboard (void) DEFSYM (Qpre_command_hook, "pre-command-hook"); DEFSYM (Qpost_command_hook, "post-command-hook"); + DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary"); + DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); diff --git a/src/lisp.h b/src/lisp.h index b34a852439c..426b6c949e9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4008,7 +4008,6 @@ extern void syms_of_casetab (void); extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); -extern Lisp_Object last_undo_boundary; extern bool input_pending; #ifdef HAVE_STACK_OVERFLOW_HANDLING extern sigjmp_buf return_to_command_loop; diff --git a/src/undo.c b/src/undo.c index e0924b2b989..214beaeb9ea 100644 --- a/src/undo.c +++ b/src/undo.c @@ -23,10 +23,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "lisp.h" #include "buffer.h" -/* Last buffer for which undo information was recorded. */ -/* BEWARE: This is not traced by the GC, so never dereference it! */ -static struct buffer *last_undo_buffer; - /* Position of point last time we inserted a boundary. */ static struct buffer *last_boundary_buffer; static ptrdiff_t last_boundary_position; @@ -38,6 +34,12 @@ static ptrdiff_t last_boundary_position; an undo-boundary. */ static Lisp_Object pending_boundary; +static void +run_undoable_change (void) +{ + call0 (Qundo_auto__undoable_change); +} + /* Record point as it was at beginning of this command (if necessary) and prepare the undo info for recording a change. PT is the position of point that will naturally occur as a result of the @@ -56,15 +58,7 @@ record_point (ptrdiff_t pt) if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if ((current_buffer != last_undo_buffer) - /* Don't call Fundo_boundary for the first change. Otherwise we - risk overwriting last_boundary_position in Fundo_boundary with - PT of the current buffer and as a consequence not insert an - undo boundary because last_boundary_position will equal pt in - the test at the end of the present function (Bug#731). */ - && (MODIFF > SAVE_MODIFF)) - Fundo_boundary (); - last_undo_buffer = current_buffer; + run_undoable_change (); at_boundary = ! CONSP (BVAR (current_buffer, undo_list)) || NILP (XCAR (BVAR (current_buffer, undo_list))); @@ -136,9 +130,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (current_buffer != last_undo_buffer) - Fundo_boundary (); - last_undo_buffer = current_buffer; + run_undoable_change (); for (m = BUF_MARKERS (current_buffer); m; m = m->next) { @@ -225,10 +217,6 @@ record_first_change (void) if (EQ (BVAR (current_buffer, undo_list), Qt)) return; - if (current_buffer != last_undo_buffer) - Fundo_boundary (); - last_undo_buffer = current_buffer; - if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; @@ -247,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; @@ -256,15 +243,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (buf != last_undo_buffer) - boundary = true; - last_undo_buffer = buf; - /* Switch temporarily to the buffer that was changed. */ - current_buffer = buf; + set_buffer_internal (buf); - if (boundary) - Fundo_boundary (); + run_undoable_change (); if (MODIFF <= SAVE_MODIFF) record_first_change (); @@ -275,7 +257,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, bset_undo_list (current_buffer, Fcons (entry, BVAR (current_buffer, undo_list))); - current_buffer = obuf; + /* Reset the buffer */ + set_buffer_internal (obuf); } DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, @@ -305,6 +288,8 @@ but another undo command will undo to the previous boundary. */) } last_boundary_position = PT; last_boundary_buffer = current_buffer; + + Fset (Qundo_auto__last_boundary_cause, Qexplicit); return Qnil; } @@ -380,7 +365,6 @@ truncate_undo_list (struct buffer *b) && !NILP (Vundo_outer_limit_function)) { Lisp_Object tem; - struct buffer *temp = last_undo_buffer; /* Normally the function this calls is undo-outer-limit-truncate. */ tem = call1 (Vundo_outer_limit_function, make_number (size_so_far)); @@ -391,10 +375,6 @@ truncate_undo_list (struct buffer *b) unbind_to (count, Qnil); return; } - /* That function probably used the minibuffer, and if so, that - changed last_undo_buffer. Change it back so that we don't - force next change to make an undo boundary here. */ - last_undo_buffer = temp; } if (CONSP (next)) @@ -452,6 +432,9 @@ void syms_of_undo (void) { DEFSYM (Qinhibit_read_only, "inhibit-read-only"); + DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change"); + DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause"); + DEFSYM (Qexplicit, "explicit"); /* Marker for function call undo list elements. */ DEFSYM (Qapply, "apply"); @@ -459,7 +442,6 @@ syms_of_undo (void) pending_boundary = Qnil; staticpro (&pending_boundary); - last_undo_buffer = NULL; last_boundary_buffer = NULL; defsubr (&Sundo_boundary); diff --git a/src/w32fns.c b/src/w32fns.c index d92352a9802..f3391cb98f0 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -55,6 +55,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <commctrl.h> #include <commdlg.h> #include <shellapi.h> +#include <shlwapi.h> #include <ctype.h> #include <winspool.h> #include <objbase.h> @@ -8755,6 +8756,457 @@ Internal use only. */) return menubar_in_use ? Qt : Qnil; } +#if defined WINDOWSNT && !defined HAVE_DBUS + +/*********************************************************************** + Tray notifications + ***********************************************************************/ +/* A private struct declaration to avoid compile-time limits. */ +typedef struct MY_NOTIFYICONDATAW { + DWORD cbSize; + HWND hWnd; + UINT uID; + UINT uFlags; + UINT uCallbackMessage; + HICON hIcon; + WCHAR szTip[128]; + DWORD dwState; + DWORD dwStateMask; + WCHAR szInfo[256]; + _ANONYMOUS_UNION union { + UINT uTimeout; + UINT uVersion; + } DUMMYUNIONNAME; + WCHAR szInfoTitle[64]; + DWORD dwInfoFlags; + GUID guidItem; + HICON hBalloonIcon; +} MY_NOTIFYICONDATAW; + +#define MYNOTIFYICONDATAW_V1_SIZE offsetof (MY_NOTIFYICONDATAW, szTip[64]) +#define MYNOTIFYICONDATAW_V2_SIZE offsetof (MY_NOTIFYICONDATAW, guidItem) +#define MYNOTIFYICONDATAW_V3_SIZE offsetof (MY_NOTIFYICONDATAW, hBalloonIcon) +#ifndef NIF_INFO +# define NIF_INFO 0x00000010 +#endif +#ifndef NIIF_NONE +# define NIIF_NONE 0x00000000 +#endif +#ifndef NIIF_INFO +# define NIIF_INFO 0x00000001 +#endif +#ifndef NIIF_WARNING +# define NIIF_WARNING 0x00000002 +#endif +#ifndef NIIF_ERROR +# define NIIF_ERROR 0x00000003 +#endif + + +#define EMACS_TRAY_NOTIFICATION_ID 42 /* arbitrary */ +#define EMACS_NOTIFICATION_MSG (WM_APP + 1) + +enum NI_Severity { + Ni_None, + Ni_Info, + Ni_Warn, + Ni_Err +}; + +/* Report the version of a DLL given by its name. The return value is + constructed using MAKEDLLVERULL. */ +static ULONGLONG +get_dll_version (const char *dll_name) +{ + ULONGLONG version = 0; + HINSTANCE hdll = LoadLibrary (dll_name); + + if (hdll) + { + DLLGETVERSIONPROC pDllGetVersion + = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion"); + + if (pDllGetVersion) + { + DLLVERSIONINFO dvi; + HRESULT result; + + memset (&dvi, 0, sizeof(dvi)); + dvi.cbSize = sizeof(dvi); + result = pDllGetVersion (&dvi); + if (SUCCEEDED (result)) + version = MAKEDLLVERULL (dvi.dwMajorVersion, dvi.dwMinorVersion, + 0, 0); + } + FreeLibrary (hdll); + } + + return version; +} + +/* Return the number of bytes in UTF-8 encoded string STR that + corresponds to at most LIM characters. If STR ends before LIM + characters, return the number of bytes in STR including the + terminating null byte. */ +static int +utf8_mbslen_lim (const char *str, int lim) +{ + const char *p = str; + int mblen = 0, nchars = 0; + + while (*p && nchars < lim) + { + int nbytes = CHAR_BYTES (*p); + + mblen += nbytes; + nchars++; + p += nbytes; + } + + if (!*p && nchars < lim) + mblen++; + + return mblen; +} + +/* Low-level subroutine to show tray notifications. All strings are + supposed to be unibyte UTF-8 encoded by the caller. */ +static EMACS_INT +add_tray_notification (struct frame *f, const char *icon, const char *tip, + enum NI_Severity severity, unsigned timeout, + const char *title, const char *msg) +{ + EMACS_INT retval = EMACS_TRAY_NOTIFICATION_ID; + + if (FRAME_W32_P (f)) + { + MY_NOTIFYICONDATAW nidw; + ULONGLONG shell_dll_version = get_dll_version ("Shell32.dll"); + wchar_t tipw[128], msgw[256], titlew[64]; + int tiplen; + + memset (&nidw, 0, sizeof(nidw)); + + /* MSDN says the full struct is supported since Vista, whose + Shell32.dll version is said to be 6.0.6. But DllGetVersion + cannot report the 3rd field value, it reports "build number" + instead, which is something else. So we use the Windows 7's + version 6.1 as cutoff, and Vista loses. (Actually, the loss + is not a real one, since we don't expose the hBalloonIcon + member of the struct to Lisp.) */ + if (shell_dll_version >= MAKEDLLVERULL (6, 1, 0, 0)) /* >= Windows 7 */ + nidw.cbSize = sizeof (nidw); + else if (shell_dll_version >= MAKEDLLVERULL (6, 0, 0, 0)) /* XP */ + nidw.cbSize = MYNOTIFYICONDATAW_V3_SIZE; + else if (shell_dll_version >= MAKEDLLVERULL (5, 0, 0, 0)) /* W2K */ + nidw.cbSize = MYNOTIFYICONDATAW_V2_SIZE; + else + nidw.cbSize = MYNOTIFYICONDATAW_V1_SIZE; /* < W2K */ + nidw.hWnd = FRAME_W32_WINDOW (f); + nidw.uID = EMACS_TRAY_NOTIFICATION_ID; + nidw.uFlags = NIF_MESSAGE | NIF_ICON | NIF_TIP | NIF_INFO; + nidw.uCallbackMessage = EMACS_NOTIFICATION_MSG; + if (!*icon) + nidw.hIcon = LoadIcon (hinst, EMACS_CLASS); + else + { + if (w32_unicode_filenames) + { + wchar_t icon_w[MAX_PATH]; + + if (filename_to_utf16 (icon, icon_w) != 0) + { + errno = ENOENT; + return -1; + } + nidw.hIcon = LoadImageW (NULL, icon_w, IMAGE_ICON, 0, 0, + LR_DEFAULTSIZE | LR_LOADFROMFILE); + } + else + { + char icon_a[MAX_PATH]; + + if (filename_to_ansi (icon, icon_a) != 0) + { + errno = ENOENT; + return -1; + } + nidw.hIcon = LoadImageA (NULL, icon_a, IMAGE_ICON, 0, 0, + LR_DEFAULTSIZE | LR_LOADFROMFILE); + } + } + if (!nidw.hIcon) + { + switch (GetLastError ()) + { + case ERROR_FILE_NOT_FOUND: + errno = ENOENT; + break; + default: + errno = ENOMEM; + break; + } + return -1; + } + + /* Windows 9X and NT4 support only 64 characters in the Tip, + later versions support up to 128. */ + if (nidw.cbSize == MYNOTIFYICONDATAW_V1_SIZE) + { + tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + tip, utf8_mbslen_lim (tip, 63), + tipw, 64); + if (tiplen >= 63) + tipw[63] = 0; + } + else + { + tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + tip, utf8_mbslen_lim (tip, 127), + tipw, 128); + if (tiplen >= 127) + tipw[127] = 0; + } + if (tiplen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szTip, tipw); + + /* The rest of the structure is only supported since Windows 2000. */ + if (nidw.cbSize > MYNOTIFYICONDATAW_V1_SIZE) + { + int slen; + + slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + msg, utf8_mbslen_lim (msg, 255), + msgw, 256); + if (slen >= 255) + msgw[255] = 0; + else if (slen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szInfo, msgw); + nidw.uTimeout = timeout; + slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + title, utf8_mbslen_lim (title, 63), + titlew, 64); + if (slen >= 63) + titlew[63] = 0; + else if (slen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szInfoTitle, titlew); + + switch (severity) + { + case Ni_None: + nidw.dwInfoFlags = NIIF_NONE; + break; + case Ni_Info: + default: + nidw.dwInfoFlags = NIIF_INFO; + break; + case Ni_Warn: + nidw.dwInfoFlags = NIIF_WARNING; + break; + case Ni_Err: + nidw.dwInfoFlags = NIIF_ERROR; + break; + } + } + + if (!Shell_NotifyIconW (NIM_ADD, (PNOTIFYICONDATAW)&nidw)) + { + /* GetLastError returns meaningless results when + Shell_NotifyIcon fails. */ + DebPrint (("Shell_NotifyIcon ADD failed (err=%d)\n", + GetLastError ())); + errno = EINVAL; + retval = -1; + } + done: + if (*icon && !DestroyIcon (nidw.hIcon)) + DebPrint (("DestroyIcon failed (err=%d)\n", GetLastError ())); + } + return retval; +} + +/* Low-level subroutine to remove a tray notification. Note: we only + pass the minimum data about the notification: its ID and the handle + of the window to which it sends messages. MSDN doesn't say this is + enough, but it works in practice. This allows us to avoid keeping + the notification data around after we show the notification. */ +static void +delete_tray_notification (struct frame *f, int id) +{ + if (FRAME_W32_P (f)) + { + MY_NOTIFYICONDATAW nidw; + + memset (&nidw, 0, sizeof(nidw)); + nidw.hWnd = FRAME_W32_WINDOW (f); + nidw.uID = id; + + if (!Shell_NotifyIconW (NIM_DELETE, (PNOTIFYICONDATAW)&nidw)) + { + /* GetLastError returns meaningless results when + Shell_NotifyIcon fails. */ + DebPrint (("Shell_NotifyIcon DELETE failed\n")); + errno = EINVAL; + return; + } + } + return; +} + +DEFUN ("w32-notification-notify", + Fw32_notification_notify, Sw32_notification_notify, + 0, MANY, 0, + doc: /* Display an MS-Windows tray notification as specified by PARAMS. + +Value is the integer unique ID of the notification that can be used +to remove the notification using `w32-notification-close', which see. +If the function fails, the return value is nil. + +Tray notifications, a.k.a. \"taskbar messages\", are messages that +inform the user about events unrelated to the current user activity, +such as a significant system event, by briefly displaying informative +text in a balloon from an icon in the notification area of the taskbar. + +Parameters in PARAMS are specified as keyword/value pairs. All the +parameters are optional, but if no parameters are specified, the +function will do nothing and return nil. + +The following parameters are supported: + +:icon ICON -- Display ICON in the system tray. If ICON is a string, + it should specify a file name from which to load the + icon; the specified file should be a .ico Windows icon + file. If ICON is not a string, or if this parameter + is not specified, the standard Emacs icon will be used. + +:tip TIP -- Use TIP as the tooltip for the notification. If TIP + is a string, this is the text of a tooltip that will + be shown when the mouse pointer hovers over the tray + icon added by the notification. If TIP is not a + string, or if this parameter is not specified, the + default tooltip text is \"Emacs notification\". The + tooltip text can be up to 127 characters long (63 + on Windows versions before W2K). Longer strings + will be truncated. + +:level LEVEL -- Notification severity level, one of `info', + `warning', or `error'. If given, the value + determines the icon displayed to the left of the + notification title, but only if the `:title' + parameter (see below) is also specified and is a + string. + +: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 + characters long; longer text will be truncated. + +:body BODY -- The body of the notification. If BODY is a string, + it specifies the text of the notification message. + Use embedded newlines to control how the text is + broken into lines. The body text can be up to 255 + characters long, and will be truncated if it's longer. + +Note that versions of Windows before W2K support only `:icon' and `:tip'. +You can pass the other parameters, but they will be ignored on those +old systems. + +There can be at most one active notification at any given time. An +active notification must be removed by calling `w32-notification-close' +before a new one can be shown. + +usage: (w32-notification-notify &rest PARAMS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + struct frame *f = SELECTED_FRAME (); + Lisp_Object arg_plist, lres; + EMACS_INT retval; + char *icon, *tip, *title, *msg; + enum NI_Severity severity; + unsigned timeout; + + if (nargs == 0) + return Qnil; + + arg_plist = Flist (nargs, args); + + /* Icon. */ + lres = Fplist_get (arg_plist, QCicon); + if (STRINGP (lres)) + icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil))); + else + icon = ""; + + /* Tip. */ + lres = Fplist_get (arg_plist, QCtip); + if (STRINGP (lres)) + tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + tip = "Emacs notification"; + + /* Severity. */ + lres = Fplist_get (arg_plist, QClevel); + if (NILP (lres)) + severity = Ni_None; + else if (EQ (lres, Qinfo)) + severity = Ni_Info; + else if (EQ (lres, Qwarning)) + severity = Ni_Warn; + else if (EQ (lres, Qerror)) + severity = Ni_Err; + else + severity = Ni_Info; + + /* Title. */ + lres = Fplist_get (arg_plist, QCtitle); + if (STRINGP (lres)) + title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + title = ""; + + /* Notification body text. */ + lres = Fplist_get (arg_plist, QCbody); + if (STRINGP (lres)) + msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + msg = ""; + + /* Do it! */ + retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg); + return (retval < 0 ? Qnil : make_number (retval)); +} + +DEFUN ("w32-notification-close", + Fw32_notification_close, Sw32_notification_close, + 1, 1, 0, + doc: /* Remove the MS-Windows tray notification specified by its ID. */) + (Lisp_Object id) +{ + struct frame *f = SELECTED_FRAME (); + + if (INTEGERP (id)) + delete_tray_notification (f, XINT (id)); + + return Qnil; +} + +#endif /* WINDOWSNT && !HAVE_DBUS */ + /*********************************************************************** Initialization @@ -8828,6 +9280,15 @@ syms_of_w32fns (void) DEFSYM (Qframes, "frames"); DEFSYM (Qtip_frame, "tip-frame"); DEFSYM (Qunicode_sip, "unicode-sip"); +#if defined WINDOWSNT && !defined HAVE_DBUS + DEFSYM (QCicon, ":icon"); + DEFSYM (QCtip, ":tip"); + DEFSYM (QClevel, ":level"); + DEFSYM (Qinfo, "info"); + DEFSYM (Qwarning, "warning"); + DEFSYM (QCtitle, ":title"); + DEFSYM (QCbody, ":body"); +#endif /* Symbols used elsewhere, but only in MS-Windows-specific code. */ DEFSYM (Qgnutls_dll, "gnutls"); @@ -9161,6 +9622,10 @@ This variable has effect only on Windows Vista and later. */); defsubr (&Sw32_window_exists_p); defsubr (&Sw32_battery_status); defsubr (&Sw32__menu_bar_in_use); +#if defined WINDOWSNT && !defined HAVE_DBUS + defsubr (&Sw32_notification_notify); + defsubr (&Sw32_notification_close); +#endif #ifdef WINDOWSNT defsubr (&Sfile_system_info); diff --git a/src/xfns.c b/src/xfns.c index db87fcc94fc..313ac52f12a 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -181,23 +181,38 @@ x_real_pos_and_offsets (struct frame *f, int *yptr, int *outer_border) { - int win_x, win_y, outer_x IF_LINT (= 0), outer_y IF_LINT (= 0); + int win_x = 0, win_y = 0, outer_x = 0, outer_y = 0; int real_x = 0, real_y = 0; bool had_errors = false; Window win = f->output_data.x->parent_desc; + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + long max_len = 400; + Atom target_type = XA_CARDINAL; + unsigned int ow = 0, oh = 0; + unsigned int fw = 0, fh = 0; + unsigned int bw = 0; + /* We resort to XCB if possible because there are several X calls + here which require responses from the server but do not have data + dependencies between them. Using XCB lets us pipeline requests, + whereas with Xlib we must wait for each answer before sending the + next request. + + For a non-local display, the round-trip time could be a few tens + of milliseconds, depending on the network distance. It doesn't + take a lot of those to add up to a noticeable hesitation in + responding to user actions. */ +#ifdef USE_XCB + xcb_connection_t *xcb_conn = dpyinfo->xcb_connection; + xcb_get_property_cookie_t prop_cookie; + xcb_get_geometry_cookie_t outer_geom_cookie; + bool sent_requests = false; +#else Atom actual_type; unsigned long actual_size, bytes_remaining; int rc, actual_format; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - long max_len = 400; Display *dpy = FRAME_X_DISPLAY (f); unsigned char *tmp_data = NULL; - Atom target_type = XA_CARDINAL; - unsigned int ow IF_LINT (= 0), oh IF_LINT (= 0); - - block_input (); - - x_catch_errors (dpy); +#endif if (x_pixels_diff) *x_pixels_diff = 0; if (y_pixels_diff) *y_pixels_diff = 0; @@ -212,6 +227,13 @@ x_real_pos_and_offsets (struct frame *f, if (win == dpyinfo->root_window) win = FRAME_OUTER_WINDOW (f); + block_input (); + +#ifndef USE_XCB + /* If we're using XCB, all errors are checked for on each call. */ + x_catch_errors (dpy); +#endif + /* This loop traverses up the containment tree until we hit the root window. Window managers may intersect many windows between our window and the root window. The window we find just before the root window @@ -219,20 +241,37 @@ x_real_pos_and_offsets (struct frame *f, for (;;) { Window wm_window, rootw; + +#ifdef USE_XCB + xcb_query_tree_cookie_t query_tree_cookie; + xcb_query_tree_reply_t *query_tree; + + query_tree_cookie = xcb_query_tree (xcb_conn, win); + query_tree = xcb_query_tree_reply (xcb_conn, query_tree_cookie, NULL); + if (query_tree == NULL) + had_errors = true; + else + { + wm_window = query_tree->parent; + rootw = query_tree->root; + free (query_tree); + } +#else Window *tmp_children; unsigned int tmp_nchildren; int success; - success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw, + success = XQueryTree (dpy, win, &rootw, &wm_window, &tmp_children, &tmp_nchildren); - had_errors = x_had_errors_p (FRAME_X_DISPLAY (f)); + had_errors = x_had_errors_p (dpy); /* Don't free tmp_children if XQueryTree failed. */ if (! success) break; XFree (tmp_children); +#endif if (wm_window == rootw || had_errors) break; @@ -242,15 +281,74 @@ x_real_pos_and_offsets (struct frame *f, if (! had_errors) { - unsigned int bw, ign; +#ifdef USE_XCB + xcb_get_geometry_cookie_t geom_cookie; + xcb_translate_coordinates_cookie_t trans_cookie; + xcb_translate_coordinates_cookie_t outer_trans_cookie; + + xcb_translate_coordinates_reply_t *trans; + xcb_get_geometry_reply_t *geom; +#else Window child, rootw; + unsigned int ign; +#endif - /* Get the real coordinates for the WM window upper left corner */ - XGetGeometry (FRAME_X_DISPLAY (f), win, - &rootw, &real_x, &real_y, &ow, &oh, &bw, &ign); +#ifdef USE_XCB + /* Fire off the requests that don't have data dependencies. + + Once we've done this, we must collect the results for each + one before returning, even if other errors are detected, + making the other responses moot. */ + geom_cookie = xcb_get_geometry (xcb_conn, win); + + trans_cookie = + xcb_translate_coordinates (xcb_conn, + /* From-window, to-window. */ + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_X_WINDOW (f), + + /* From-position. */ + 0, 0); + if (FRAME_X_WINDOW (f) != FRAME_OUTER_WINDOW (f)) + outer_trans_cookie = + xcb_translate_coordinates (xcb_conn, + /* From-window, to-window. */ + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_OUTER_WINDOW (f), + + /* From-position. */ + 0, 0); + if (right_offset_x || bottom_offset_y) + outer_geom_cookie = xcb_get_geometry (xcb_conn, + FRAME_OUTER_WINDOW (f)); + + if (dpyinfo->root_window == f->output_data.x->parent_desc) + /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ + prop_cookie = xcb_get_property (xcb_conn, 0, win, + dpyinfo->Xatom_net_frame_extents, + target_type, 0, max_len); + + sent_requests = true; +#endif - if (outer_border) - *outer_border = bw; + /* Get the real coordinates for the WM window upper left corner */ +#ifdef USE_XCB + geom = xcb_get_geometry_reply (xcb_conn, geom_cookie, NULL); + if (geom) + { + real_x = geom->x; + real_y = geom->y; + ow = geom->width; + oh = geom->height; + bw = geom->border_width; + free (geom); + } + else + had_errors = true; +#else + XGetGeometry (dpy, win, + &rootw, &real_x, &real_y, &ow, &oh, &bw, &ign); +#endif /* Translate real coordinates to coordinates relative to our window. For our window, the upper left corner is 0, 0. @@ -261,18 +359,38 @@ x_real_pos_and_offsets (struct frame *f, | title | | ----------------- v y | | our window - */ - XTranslateCoordinates (FRAME_X_DISPLAY (f), + + Since we don't care about the child window corresponding to + the actual coordinates, we can send zero to get the offsets + and compute the resulting coordinates below. This reduces + the data dependencies between calls and lets us pipeline the + requests better in the XCB case. */ +#ifdef USE_XCB + trans = xcb_translate_coordinates_reply (xcb_conn, trans_cookie, NULL); + if (trans) + { + win_x = trans->dst_x; + win_y = trans->dst_y; + free (trans); + } + else + had_errors = true; +#else + XTranslateCoordinates (dpy, /* From-window, to-window. */ FRAME_DISPLAY_INFO (f)->root_window, FRAME_X_WINDOW (f), /* From-position, to-position. */ - real_x, real_y, &win_x, &win_y, + 0, 0, &win_x, &win_y, /* Child of win. */ &child); +#endif + + win_x += real_x; + win_y += real_y; if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f)) { @@ -281,25 +399,73 @@ x_real_pos_and_offsets (struct frame *f, } else { - XTranslateCoordinates (FRAME_X_DISPLAY (f), +#ifdef USE_XCB + xcb_translate_coordinates_reply_t *outer_trans; + + outer_trans = xcb_translate_coordinates_reply (xcb_conn, + outer_trans_cookie, + NULL); + if (outer_trans) + { + outer_x = outer_trans->dst_x; + outer_y = outer_trans->dst_y; + free (outer_trans); + } + else + had_errors = true; +#else + XTranslateCoordinates (dpy, /* From-window, to-window. */ FRAME_DISPLAY_INFO (f)->root_window, FRAME_OUTER_WINDOW (f), /* From-position, to-position. */ - real_x, real_y, &outer_x, &outer_y, + 0, 0, &outer_x, &outer_y, /* Child of win. */ &child); +#endif + + outer_x += real_x; + outer_y += real_y; } - had_errors = x_had_errors_p (FRAME_X_DISPLAY (f)); +#ifndef USE_XCB + had_errors = x_had_errors_p (dpy); +#endif } - if (!had_errors && dpyinfo->root_window == f->output_data.x->parent_desc) + if (dpyinfo->root_window == f->output_data.x->parent_desc) { /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ +#ifdef USE_XCB + /* Make sure we didn't get an X error early and skip sending the + request. */ + if (sent_requests) + { + xcb_get_property_reply_t *prop; + + prop = xcb_get_property_reply (xcb_conn, prop_cookie, NULL); + if (prop) + { + if (prop->type == target_type + && prop->format == 32 + && (xcb_get_property_value_length (prop) + == 4 * sizeof (int32_t))) + { + int32_t *fe = xcb_get_property_value (prop); + + outer_x = -fe[0]; + outer_y = -fe[2]; + real_x -= fe[0]; + real_y -= fe[2]; + } + free (prop); + } + /* Xlib version doesn't set had_errors here. Intentional or bug? */ + } +#else rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_frame_extents, 0, max_len, False, target_type, &actual_type, &actual_format, &actual_size, @@ -317,9 +483,42 @@ x_real_pos_and_offsets (struct frame *f, } if (tmp_data) XFree (tmp_data); +#endif + } + + if (right_offset_x || bottom_offset_y) + { +#ifdef USE_XCB + /* Make sure we didn't get an X error early and skip sending the + request. */ + if (sent_requests) + { + xcb_get_geometry_reply_t *outer_geom; + + outer_geom = xcb_get_geometry_reply (xcb_conn, outer_geom_cookie, + NULL); + if (outer_geom) + { + fw = outer_geom->width; + fh = outer_geom->height; + free (outer_geom); + } + else + had_errors = true; + } +#else + int xy_ign; + unsigned int ign; + Window rootw; + + XGetGeometry (dpy, FRAME_OUTER_WINDOW (f), + &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign); +#endif } +#ifndef USE_XCB x_uncatch_errors (); +#endif unblock_input (); @@ -334,17 +533,10 @@ x_real_pos_and_offsets (struct frame *f, if (xptr) *xptr = real_x; if (yptr) *yptr = real_y; - if (right_offset_x || bottom_offset_y) - { - int xy_ign; - unsigned int ign, fw, fh; - Window rootw; + if (outer_border) *outer_border = bw; - XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign); - if (right_offset_x) *right_offset_x = ow - fw + outer_x; - if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y; - } + if (right_offset_x) *right_offset_x = ow - fw + outer_x; + if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y; } /* Store the screen positions of frame F into XPTR and YPTR. @@ -6368,11 +6560,12 @@ present and mapped to the usual X keysyms. */) #ifdef USE_CAIRO DEFUN ("x-export-frames", Fx_export_frames, Sx_export_frames, 0, 2, 0, - doc: /* XXX Experimental. Return image data of FRAMES in TYPE format. + doc: /* Return image data of FRAMES in TYPE format. FRAMES should be nil (the selected frame), a frame, or a list of frames (each of which corresponds to one page). Optional arg TYPE -should be either `pdf' (default), `png', `ps', or `svg'. Supported -types are determined by the compile-time configuration of cairo. */) +should be either `pdf' (default), `png', `postscript', or `svg'. +Supported types are determined by the compile-time configuration of +cairo. */) (Lisp_Object frames, Lisp_Object type) { Lisp_Object result, rest, tmp; @@ -6399,12 +6592,12 @@ types are determined by the compile-time configuration of cairo. */) frames = Fnreverse (tmp); #ifdef CAIRO_HAS_PDF_SURFACE - if (NILP (type) || EQ (type, intern ("pdf"))) /* XXX: Qpdf */ + if (NILP (type) || EQ (type, Qpdf)) surface_type = CAIRO_SURFACE_TYPE_PDF; else #endif #ifdef CAIRO_HAS_PNG_FUNCTIONS - if (EQ (type, intern ("png"))) + if (EQ (type, Qpng)) { if (!NILP (XCDR (frames))) error ("PNG export cannot handle multiple frames."); @@ -6413,12 +6606,12 @@ types are determined by the compile-time configuration of cairo. */) else #endif #ifdef CAIRO_HAS_PS_SURFACE - if (EQ (type, intern ("ps"))) + if (EQ (type, Qpostscript)) surface_type = CAIRO_SURFACE_TYPE_PS; else #endif #ifdef CAIRO_HAS_SVG_SURFACE - if (EQ (type, intern ("svg"))) + if (EQ (type, Qsvg)) { /* For now, we stick to SVG 1.1. */ if (!NILP (XCDR (frames))) @@ -6572,6 +6765,8 @@ syms_of_xfns (void) DEFSYM (Qmono, "mono"); #ifdef USE_CAIRO + DEFSYM (Qpdf, "pdf"); + DEFSYM (Qorientation, "orientation"); DEFSYM (Qtop_margin, "top-margin"); DEFSYM (Qbottom_margin, "bottom-margin"); diff --git a/src/xterm.c b/src/xterm.c index 5756378bd3a..acb6566d51d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10096,39 +10096,69 @@ get_current_wm_state (struct frame *f, int *size_state, bool *sticky) { - Atom actual_type; - unsigned long actual_size, bytes_remaining; - int i, rc, actual_format; + unsigned long actual_size; + int i; bool is_hidden = false; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); long max_len = 65536; + 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 target_type = XA_ATOM; + Atom *reply_data; +#endif *sticky = false; *size_state = FULLSCREEN_NONE; block_input (); + +#ifdef USE_XCB + prop_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, window, + dpyinfo->Xatom_net_wm_state, + target_type, 0, max_len); + prop = xcb_get_property_reply (dpyinfo->xcb_connection, prop_cookie, NULL); + if (prop && prop->type == target_type) + { + 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 + { + actual_size = 0; + is_hidden = FRAME_ICONIFIED_P (f); + } +#else x_catch_errors (dpy); rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state, 0, max_len, False, target_type, &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 { - if (tmp_data) XFree (tmp_data); - x_uncatch_errors (); - unblock_input (); - return !FRAME_ICONIFIED_P (f); + actual_size = 0; + is_hidden = FRAME_ICONIFIED_P (f); } x_uncatch_errors (); +#endif 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) @@ -10151,7 +10181,12 @@ get_current_wm_state (struct frame *f, *sticky = true; } +#ifdef USE_XCB + free (prop); +#else if (tmp_data) XFree (tmp_data); +#endif + unblock_input (); return ! is_hidden; } @@ -11773,6 +11808,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) struct terminal *terminal; struct x_display_info *dpyinfo; XrmDatabase xrdb; +#ifdef USE_XCB + xcb_connection_t *xcb_conn; +#endif block_input (); @@ -11911,6 +11949,25 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) return 0; } +#ifdef USE_XCB + xcb_conn = XGetXCBConnection (dpy); + if (xcb_conn == 0) + { +#ifdef USE_GTK + xg_display_close (dpy); +#else +#ifdef USE_X_TOOLKIT + XtCloseDisplay (dpy); +#else + XCloseDisplay (dpy); +#endif +#endif /* ! USE_GTK */ + + unblock_input (); + return 0; + } +#endif + /* We have definitely succeeded. Record the new connection. */ dpyinfo = xzalloc (sizeof *dpyinfo); @@ -11961,6 +12018,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->name_list_element = Fcons (display_name, Qnil); dpyinfo->display = dpy; dpyinfo->connection = ConnectionNumber (dpyinfo->display); +#ifdef USE_XCB + dpyinfo->xcb_connection = xcb_conn; +#endif /* http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html */ dpyinfo->smallest_font_height = 1; diff --git a/src/xterm.h b/src/xterm.h index f7d2803ff29..192839b059e 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -87,6 +87,10 @@ typedef GtkWidget *xt_or_gtk_widget; #include <X11/Xlocale.h> #endif +#ifdef USE_XCB +#include <X11/Xlib-xcb.h> +#endif + #include "dispextern.h" #include "termhooks.h" @@ -458,6 +462,10 @@ struct x_display_info #ifdef USE_CAIRO XExtCodes *ext_codes; #endif + +#ifdef USE_XCB + xcb_connection_t *xcb_connection; +#endif }; #ifdef HAVE_X_I18N diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el index 9b230db99e4..e2429b7de37 100644 --- a/test/automated/cl-lib-tests.el +++ b/test/automated/cl-lib-tests.el @@ -222,8 +222,8 @@ (def . ,(or `nil `(nil)))) t))))) (ert-deftest cl-lib-struct-constructors () - (should (equal (documentation 'cl-lib--con-2 t) - "Constructor docstring.")) + (should (string-match "\\`Constructor docstring." + (documentation 'cl-lib--con-2 t))) (should (mystruct-p (cl-lib--con-1))) (should (mystruct-p (cl-lib--con-2)))) diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el index fa1f5484eec..8f0cd6f0857 100644 --- a/test/automated/json-tests.el +++ b/test/automated/json-tests.el @@ -28,11 +28,40 @@ (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3)) '(:c 3 :b 2 :a 1)))) +(ert-deftest test-json-plist-to-alist () + (should (equal (json--plist-to-alist '()) '())) + (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1)))) + (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) + '((:a . 1) (:b . 2) (:c . 3))))) + +(ert-deftest test-json-encode-plist () + (let ((plist '(:a 1 :b 2))) + (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) + (ert-deftest json-encode-simple-alist () (should (equal (json-encode '((a . 1) (b . 2))) "{\"a\":1,\"b\":2}"))) +(ert-deftest test-json-encode-hash-table () + (let ((hash-table (make-hash-table)) + (json-encoding-object-sort-predicate 'string<)) + (puthash :a 1 hash-table) + (puthash :b 2 hash-table) + (puthash :c 3 hash-table) + (should (equal (json-encode hash-table) + "{\"a\":1,\"b\":2,\"c\":3}")))) + +(ert-deftest test-json-encode-alist-with-sort-predicate () + (let ((alist '((:c . 3) (:a . 1) (:b . 2))) + (json-encoding-object-sort-predicate 'string<)) + (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) + +(ert-deftest test-json-encode-plist-with-sort-predicate () + (let ((plist '(:c 3 :a 1 :b 2)) + (json-encoding-object-sort-predicate 'string<)) + (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) + (ert-deftest json-read-simple-alist () (let ((json-object-type 'alist)) (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}") diff --git a/test/automated/keymap-tests.el b/test/automated/keymap-tests.el new file mode 100644 index 00000000000..973b2407391 --- /dev/null +++ b/test/automated/keymap-tests.el @@ -0,0 +1,43 @@ +;;; keymap-tests.el --- Test suite for src/keymap.c + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Juanma Barranquero <lekktu@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +(ert-deftest keymap-store_in_keymap-FASTINT-on-nonchars () + "Check for bug fixed in \"Fix assertion violation in define-key\", +commit 86c19714b097aa477d339ed99ffb5136c755a046." + (let ((def (lookup-key Buffer-menu-mode-map [32]))) + (unwind-protect + (progn + (should-not (eq def 'undefined)) + ;; This will cause an assertion violation if the bug is present. + ;; We could run an inferior Emacs process and check for the return + ;; status, but in some environments an assertion failure triggers + ;; an abort dialog that requires user intervention anyway. + (define-key Buffer-menu-mode-map [(32 . 32)] 'undefined) + (should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined))) + (define-key Buffer-menu-mode-map [32] def)))) + +(provide 'keymap-tests) + +;;; keymap-tests.el ends here diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 1a759b523a5..2a7fcc39d41 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -126,16 +126,16 @@ Evaluate BODY for each created map. (should (null (map-nested-elt vec '(2 1 1)))) (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) -(ert-deftest test-map-p () - (should (map-p nil)) - (should (map-p '((a . b) (c . d)))) - (should (map-p '(a b c d))) - (should (map-p [])) - (should (map-p [1 2 3])) - (should (map-p (make-hash-table))) - (should (map-p "hello")) - (should (not (map-p 1))) - (should (not (map-p 'hello)))) +(ert-deftest test-mapp () + (should (mapp nil)) + (should (mapp '((a . b) (c . d)))) + (should (mapp '(a b c d))) + (should (mapp [])) + (should (mapp [1 2 3])) + (should (mapp (make-hash-table))) + (should (mapp "hello")) + (should (not (mapp 1))) + (should (not (mapp 'hello)))) (ert-deftest test-map-keys () (with-maps-do map diff --git a/test/automated/obarray-tests.el b/test/automated/obarray-tests.el new file mode 100644 index 00000000000..4cc61b6903f --- /dev/null +++ b/test/automated/obarray-tests.el @@ -0,0 +1,90 @@ +;;; obarray-tests.el --- Tests for obarray -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Przemysław Wojnowski <esperanto@cumego.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'obarray) +(require 'ert) + +(ert-deftest obarrayp-test () + "Should assert that given object is an obarray." + (should-not (obarrayp 42)) + (should-not (obarrayp "aoeu")) + (should-not (obarrayp '())) + (should-not (obarrayp [])) + (should (obarrayp (make-vector 7 0)))) + +(ert-deftest obarrayp-unchecked-content-test () + "Should fail to check content of passed obarray." + :expected-result :failed + (should-not (obarrayp ["a" "b" "c"])) + (should-not (obarrayp [1 2 3]))) + +(ert-deftest obarray-make-default-test () + (let ((table (obarray-make))) + (should (obarrayp table)) + (should (equal (make-vector 59 0) table)))) + +(ert-deftest obarray-make-with-size-test () + (should-error (obarray-make -1) :type 'wrong-type-argument) + (should-error (obarray-make 0) :type 'wrong-type-argument) + (let ((table (obarray-make 1))) + (should (obarrayp table)) + (should (equal (make-vector 1 0) table)))) + +(ert-deftest obarray-get-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (intern "aoeu" table) + (should (string= "aoeu" (obarray-get table "aoeu"))))) + +(ert-deftest obarray-put-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (should (string= "aoeu" (obarray-put table "aoeu"))) + (should (string= "aoeu" (obarray-get table "aoeu"))))) + +(ert-deftest obarray-remove-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (should-not (obarray-remove table "aoeu")) + (should (string= "aoeu" (obarray-put table "aoeu"))) + (should (string= "aoeu" (obarray-get table "aoeu"))) + (should (obarray-remove table "aoeu")) + (should-not (obarray-get table "aoeu")))) + +(ert-deftest obarray-map-test () + "Should execute function on all elements of obarray." + (let* ((table (obarray-make 3)) + (syms '()) + (collect-names (lambda (sym) (push (symbol-name sym) syms)))) + (obarray-map collect-names table) + (should (null syms)) + (obarray-put table "a") + (obarray-put table "b") + (obarray-put table "c") + (obarray-map collect-names table) + (should (equal (sort syms #'string<) '("a" "b" "c"))))) + +(provide 'obarray-tests) +;;; obarray-tests.el ends here diff --git a/test/automated/simple-test.el b/test/automated/simple-test.el index 5bfb74615a4..07b5eaa93e4 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 () @@ -202,5 +213,44 @@ (unless (or noninteractive python) (unload-feature 'python))))) + +;;; auto-boundary tests +(ert-deftest undo-auto--boundary-timer () + (should + undo-auto--current-boundary-timer)) + +(ert-deftest undo-auto--boundaries-added () + ;; The change in the buffer should have caused addition + ;; to undo-auto--undoably-changed-buffers. + (should + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (member (current-buffer) undo-auto--undoably-changed-buffers))) + ;; The head of buffer-undo-list should be the insertion event, and + ;; therefore not nil + (should + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (car buffer-undo-list))) + ;; Now the head of the buffer-undo-list should be a boundary and so + ;; nil. We have to call auto-boundary explicitly because we are out + ;; of the command loop + (should-not + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (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) ;;; simple-test.el ends here |