ChangeLog
[0-9]*.patch
[0-9]*.txt
+.dir-locals?.el
/vc-dwim-log-*
# Built by 'make install'.
** Test your changes.
Please test your changes before committing them or sending them to the
-list.
+list. If possible, add a new test along with any bug fix or new
+functionality you commit (of course, some changes cannot be easily
+tested).
Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info
"(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/
+2015-11-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer xpalloc to doubling buffers by hand
+
+ * src/lread.c (grow_read_buffer): New function, which uses xpalloc.
+ (read1): Use it for simplicity.
+ * src/macros.c (store_kbd_macro_char):
+ * src/minibuf.c (read_minibuf_noninteractive):
+ * src/term.c (encode_terminal_code):
+ * src/xrdb.c (magic_db):
+ Prefer xpalloc to growing buffers by hand.
+ This doesn’t fix any bugs, but simplifies the code a bit.
+
+2015-11-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2015-11-05 timespec-sub: fix overflow bug; add tests
+ 2015-11-04 intprops: revise _WRAPV macros, revert _OVERFLOW
+ 2015-11-03 intprops: add parentheses
+ * lib/intprops.h, lib/timespec-add.c, lib/timespec-sub.c:
+ Copy from gnulib.
+
+2015-11-07 David Reitter <david.reitter@gmail.com>
+
+ Provide NS notification objects where required to eliminate warnings
+
+ * nsterm.m (windowDidResize:, toggleFullScreen:):
+ Call notification functions with notification objects
+ as per delegate APIs.
+
+2015-11-07 Noam Postavsky <npostavs@users.sourceforge.net>
+
+ Add test for bug #21824
+
+ * test/automated/buffer-tests.el: New file.
+ (overlay-modification-hooks-message-other-buf): New test.
+
+2015-11-07 Kelvin White <kwhite@gnu.org>
+
+ * lisp/erc/erc-pcomplete.el (pcomplete-erc-nicks): Fix bug#18771.
+
+2015-11-07 David Reitter <david.reitter@gmail.com>
+
+ Ignore fullscreen exit notifications on NS when frame is dead
+
+ * nsterm.m (windowDidResize:, windowWillExitFullScreen:)
+ (windowDidExitFullScreen:): Return if frame is dead.
+ These functions may be called when a fullscreen frame
+ is closed; they are called before, not after.
+
+ May address Bug#21428.
+
+2015-11-07 Eli Zaretskii <eliz@gnu.org>
+
+ Speed up lookup in redisplay--variables
+
+ * lisp/frame.el (redisplay--variables): Make it a hash-table.
+
+ * src/xdisp.c (maybe_set_redisplay): Access redisplay--variables
+ as a hash-table. This speeds up this function by an order of
+ magnitude: where previously a setq was slowed down by 100% by
+ introducing the maybe_set_redisplay test, it is now only 5%
+ slower.
+ (syms_of_xdisp) <redisplay--variables>: Doc fix.
+
+2015-11-07 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Fix a bug.
+
+ The defsubst was being created as:
+ (cl-defsubst name (args) ("DOC") ...)
+
+ * test/automated/cl-lib-tests.el (cl-lib-struct-constructors):
+ Add test.
+
+2015-11-07 Mihai Olteanu <mihai_olteanu@fastmail.fm> (tiny change)
+
+ Update doc string of hexl-mode
+
+ * lisp/hexl.el (hexl-mode): Doc fix. (Bug#21800)
+
+2015-11-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix error in copy-abbrev-table
+
+ * lisp/abbrev.el (define-abbrev): Don't erase the :abbrev-table-modiff
+ property of the abbrev-table. (Bug#21828)
+
+ * test/automated/abbrev-tests.el: New file.
+
+2015-11-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Add test to auto-revert-tests.el for Bug#21841
+
+ * test/automated/auto-revert-tests.el
+ (auto-revert-test01-auto-revert-several-files): New test.
+ (auto-revert-test02-auto-revert-tail-mode)
+ (auto-revert-test03-auto-revert-mode-dired): Rename them.
+
+2015-11-07 Martin Rudalics <rudalics@gmx.at>
+
+ * doc/lispref/windows.texi (Coordinates and Windows): Fix typo.
+
+2015-11-07 Martin Rudalics <rudalics@gmx.at>
+
+ In x_consider_frame_title don't set title of tooltip frames
+
+ * src/xdisp.c (x_consider_frame_title): Return immediately for
+ tooltip frames to avoid displaying empty tooltips.
+
+2015-11-06 Anders Lindgren <andlind@gmail.com>
+
+ Fixed NextStep fullscreen problem (bug#21770).
+
+ * src/nsterm.m (ns_constrain_all_frames): Don't constrain
+ fullscreen frames.
+
+2015-11-06 Eli Zaretskii <eliz@gnu.org>
+
+ Ensure redisplay after evaluation
+
+ * lisp/progmodes/elisp-mode.el (elisp--eval-last-sexp):
+ Revert last change.
+ * lisp/frame.el (redisplay--variables): Populate the
+ redisplay--variables list.
+ * src/xdisp.c (maybe_set_redisplay): New function.
+ (syms_of_xdisp) <redisplay--variables>: New variable.
+ * src/window.h (maybe_set_redisplay): Declare prototype.
+ * src/data.c (set_internal): Call maybe_set_redisplay. (Bug#21835)
+
+2015-11-06 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * test/automated/subr-tests.el (subr-test-when): Fix again.
+
+2015-11-06 Eli Zaretskii <eliz@gnu.org>
+
+ Don't invoke overlay modification hooks in wrong buffer
+
+ * src/buffer.c (report_overlay_modification): When called with
+ AFTER non-zero, don't invoke overlay modification hooks if the
+ buffer recorded in last_overlay_modification_hooks is different
+ from the current buffer. (Bug#21824)
+
+2015-11-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * admin/notes/repo: Fix a few obsolete references to Bazaar.
+
+2015-11-06 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * test/automated/subr-tests.el (subr-test-when): Fix test.
+
+2015-11-06 Martin Rudalics <rudalics@gmx.at>
+
+ Avoid division by zero crash observed by Yuan MEI
+
+ See http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html.
+
+ * src/dispnew.c (required_matrix_height, required_matrix_width):
+ Avoid division by zero.
+ * src/xterm.c (x_term_init): Init dpyinfo->smallest_font_height and
+ dpyinfo->smallest_char_width to 1.
+
+2015-11-06 Eli Zaretskii <eliz@gnu.org>
+
+ Ensure redisplay after "C-x C-e"
+
+ * lisp/progmodes/elisp-mode.el (elisp--eval-last-sexp): Make sure
+ redisplay happens to account for any side effects of the evaluated
+ sexp. (Bug#21835)
+
+2015-11-06 Michael Albinus <michael.albinus@gmx.de>
+
+ Skip some file notification tests for cygwin
+
+ * test/automated/file-notify-tests.el (file-notify--test-with-events):
+ Remove argument TIMEOUT. Adapt all callees.
+ (file-notify-test02-events, file-notify-test04-file-validity):
+ Skip for cygwin. (Bug#21804)
+
+2015-11-05 Stephen Leake <stephen_leake@stephe-leake.org>
+
+ * lisp/progmodes/xref.el: Require semantic/symref during compilation.
+
+2015-11-05 Daiki Ueno <ueno@gnu.org>
+
+ Suppress redundant Pinentry startup messages
+
+ * lisp/net/pinentry.el (pinentry-start): Add optional QUIET argument.
+ * lisp/epg.el: Declare `pinentry-start'.
+ (epg--start): Call `pinentry-start' with QUIET argument set.
+
+2015-11-05 Xue Fuqiao <xfq.free@gmail.com>
+
+ * doc/emacs/ack.texi (Acknowledgments): Updates.
+
+2015-11-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * test/automated/elisp-mode-test.el: Silence some run-time warnings.
+ (xref-elisp-deftest): Bind `find-file-suppress-same-file-warnings' to t.
+
+2015-11-05 Tassilo Horn <tsdh@gnu.org>
+
+ * lisp/textmodes/tex-mode.el (tex--prettify-symbols-alist):
+ Add prettification support for \times.
+
+2015-11-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * test/automated/process-tests.el: Skip tests when bash is unavailable.
+ (process-test-sentinel-accept-process-output)
+ (process-test-sentinel-sit-for): skip-unless bash executable found.
+
+2015-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ Add test for bug #21831
+
+ * test/automated/process-tests.el
+ (start-process-should-not-modify-arguments): New test. (Bug#21831)
+ Suggested by Nicolas Richard <youngfrog@members.fsf.org>
+
+2015-11-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/eieio-compat.el: Typo caught by tests.
+
+ (eieio--generic-static-object-generalizer): Fix typo.
+ * test/automated/eieio-tests.el: Byte-compile it again. It looks
+ like the underlying cause of bug#17852 was fixed in the mean time.
+
+2015-11-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ Revert "* lisp/subr.el (when): Use `macroexp-progn'"
+
+ This reverts commit 8e843831eaf271801836b7a3e4dd3b4fb0bb72b8.
+ It breaks bootstrapping (duh).
+
+2015-11-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/files.el (report-errors): Obsolete.
+
+ (normal-mode, hack-local-variables, dir-locals-find-file):
+ Use `with-demoted-errors' instead.
+
+2015-11-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/subr.el (when): Use `macroexp-progn'.
+
+ * test/automated/subr-tests.el (subr-test-when): New test.
+
+2015-11-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * lisp/progmodes/xref.el: Doc fixes.
+ (xref-make-file-location, xref-make-buffer-location, xref-make)
+ (xref-make-bogus-location, xref-make-match): Add cross-references.
+ (xref--insert-xrefs): Fix typo in docstring.
+
+2015-11-04 Anders Lindgren <andlind@gmail.com>
+
+ Render fringe bitmaps correctly on NextStep (bug#21301)
+
+ The fringe bitmaps were inverted, the background was not transparent,
+ the image data was horizontally mirrored, and periodic fringe bitmaps
+ were not supported.
+
+ * src/nsimage.m ([EmacsImage initFromXBM:width:height:fg:bg:]):
+ When both background and foreground colors are 0, set the background
+ alpha channel to 0 (making the background transparent). When
+ copying the image data, do this from the most significant bit
+ (leftmost) to the least (rightmost), to avoid mirroring.
+ * src/nsterm.m (ns_draw_fringe_bitmap): Don't invert the image bits.
+ Add support for periodic images (e.g. the empty line indicator).
+
+2015-11-03 Michael Heerdegen <michael_heerdegen@web.de>
+
+ * lisp/emacs-lisp/pcase.el (pcase): Tweak docstring.
+
+2015-11-03 Nicolas Petton <nicolas@petton.fr>
+
+ * admin/MAINTAINERS: Add seq-tests.el, map-tests.el, and thunk-tests.el.
+
+ * admin/MAINTAINERS: Add thunk.el.
+
+2015-11-03 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * lisp/calc/calc (calc-bug-address): Change maintainer address.
+
+2015-11-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix a stupid error in gfilenotify.c
+
+ * src/gfilenotify.c (dir_monitor_callback): Cancel monitor only,
+ if we've got a `deleted' signal AND the file name is the watched one.
+
+2015-11-03 Stephen Leake <stephen_leake@stephe-leake.org>
+
+ Fix Bug#21816; case insensitive file system in elisp-mode-tests.el
+
+ * test/automated/elisp-mode-tests.el (xref-elisp-test-run):
+ Use case-insensitive string compare for file names.
+ (emacs-test-dir): Add 'downcase' to cause case differences (at
+ least on my system).
+
+2015-11-02 Juanma Barranquero <lekktu@gmail.com>
+
+ flymake-tests.el (warning-predicate-rx-gcc): Fix check
+
+ * test/automated/flymake-tests.el (warning-predicate-rx-gcc):
+ Also check that "make" is available, not just "gcc".
+
+2015-11-02 Ken Brown <kbrown@cornell.edu>
+
+ Document behavior of collation on Cygwin
+
+ * test/automated/fns-tests.el (fns-tests-collate-sort): Mark as
+ expected failure on Cygwin.
+ * doc/lispref/strings.texi (Text Comparison): Document that
+ punctuation and whitespace are not ignored for sorting on Cygwin.
+
+2015-11-02 Dani Moncayo <dmoncayo@gmail.com>
+
+ * build-aux/msys-to-w32: Prevent double slashes in w32 path list.
+
+2015-11-01 Glenn Morris <rgm@gnu.org>
+
+ * lisp/progmodes/f90.el (f90-no-block-limit): Add associate.
+ (Bug#21794)
+ * test/automated/f90.el (f90-test-bug21794): New test.
+
+2015-11-01 Juanma Barranquero <lekktu@gmail.com>
+
+ Fix incompatibility with TCC in test for bug#18745
+
+ * test/automated/process-tests.el (process-test-quoted-batfile):
+ Remove spaces unrelated to the bug being tested.
+
+2015-11-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve completion in tramp-gvfs.el
+
+ * lisp/net/tramp-gvfs.el (tramp-zeroconf-parse-device-names):
+ Rename from `tramp-zeroconf-parse-service-device-names'.
+ (tramp-zeroconf-parse-webdav-device-names): Remove. Code merged
+ with `tramp-zeroconf-parse-device-names'.
+ (tramp-gvfs-parse-device-names): New defun.
+ (top): Use it when `tramp-zeroconf-parse-device-names' is not
+ applicable.
+
+ * lisp/net/tramp.el (tramp-set-completion-function): The argument
+ could also be a zeroconf service type.
+
2015-10-31 Thomas Fitzsimmons <fitzsim@fitzsim.org>
- ntlm.el: Change version to 2.0.0
+ * lisp/net/ntlm.el: Change version to 2.0.0.
2015-10-31 Juanma Barranquero <lekktu@gmail.com>
2015-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
- * lisp/emacs-lisp/cl-generic.el: Accomodate future changes.
+ * lisp/emacs-lisp/cl-generic.el: Accommodate future changes.
(cl--generic-generalizer): Add `name' field.
(cl-generic-make-generalizer): Add corresponding `name' argument.
(cl-generic-define-generalizer): New macro.
* lisp/net/soap-client.el, lisp/net/soap-inspect.el: Update home page.
+2015-10-25 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/progmodes/grep.el (grep): Doc fix. (Bug#21754)
+
+2015-10-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * src/keyboard.c (post-command-hook): Extend the docstring.
+ Mainly, explain how to use it without hanging Emacs, or giving the
+ impression that it is hanging. Also mention `pre-command-hook'.
+ (pre-command-hook): Mention `post-command-hook'.
+
+2015-10-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/custom.el (custom-declare-variable): Shorten code again.
+ Without using pcase this time. We can't use pcase because it is
+ loaded after custom in loadup.el. Also add a comment explaining
+ this to future dummies like me.
+
+2015-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/lispref/os.texi (File Notifications): Document `stopped event'.
+
+2015-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ Introduce `stopped' event in file notification
+
+ * lisp/filenotify.el (file-notify--rm-descriptor): New defun.
+ (file-notify-rm-watch): Use it.
+ (file-notify-callback): Implement `stopped' event.
+ (file-notify-add-watch): Mention `stopped' in the docstring.
+ Check, that upper directory exists.
+
+ * test/automated/file-notify-tests.el (file-notify-test01-add-watch):
+ Add two test cases.
+ (file-notify-test02-events): Handle also `stopped' event.
+ (file-notify-test04-file-validity): Add another test case.
+
+2015-10-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert commit that broke 'make bootstrap'
+
+ * lisp/custom.el (custom-declare-variable): Revert commit
+ 79fac080d277fed07b3c192890ad59d36d9f83b6. custom.el needs to work
+ even when pcase has not been defined yet, when doing bootstrapping.
+
+2015-10-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port recent inline functions fix to Standard C
+
+ * src/lisp.h (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): Remove.
+ All uses rewritten to define the function directly rather than to
+ use a macro to define the function. This conforms to Standard C,
+ which does not allow stray semicolons at the top level. I hope it
+ also avoids the problems with TAGS. Those macros, though clever,
+ were pretty confusing anyway, and it wasn’t clear they were worth
+ the aggravation even without the TAGS problem.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/isearch.el: Make character-fold search the default again.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/character-fold.el: Many improvements.
+ (character-fold-search-forward, character-fold-search-backward):
+ New command.
+ (character-fold-to-regexp): Remove lax-whitespace hack.
+ (character-fold-search): Remove variable. Only isearch and
+ query-replace use char-folding, and they both have their own
+ variables to configure that.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/isearch.el: Generalize definition of regexp-function toggles.
+ (isearch-specify-regexp-function): New macro for specifying
+ possible values of `isearch-regexp-function'.
+ (isearch-toggle-character-fold, isearch-toggle-symbol)
+ (isearch-toggle-word): Define with `isearch-specify-regexp-function'.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/isearch.el (search-default-regexp-mode): New variable.
+ (isearch-mode): Use it.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/isearch.el (search-exit-option, search-slow-window-lines)
+ (search-slow-speed, search-upper-case)
+ (search-nonincremental-instead, search-whitespace-regexp)
+ (search-invisible, isearch-hide-immediately)
+ (isearch-resume-in-command-history, search-ring-max)
+ (regexp-search-ring-max, search-ring-update, search-highlight)
+ (isearch-fail): Delete :group entries.
+
+2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * lisp/custom.el (custom-declare-variable): Shorten code a bit.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ addpm.c: Silence some warnings.
+
+ * nt/addpm.c (DdeCommand): Cast pData argument of DdeClientTransaction
+ to LPBYTE.
+ (add_registry): Pass NULL to optional lpClass argument of
+ RegCreateKeyEx, not an empty string.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ addpm.c: Do not add obsolete GTK libraries to the path.
+
+ * nt/addpm.c (REG_GTK, REG_RUNEMACS_PATH): Delete.
+ (add_registry): Remove variables `size' and `gtk_key'.
+ Do not add the GTK DLL directory to the library search path; it is
+ confusing behavior (in particular, the same Emacs version with and
+ without invoking addpm will use a different path), and the GTK image
+ libraries are obsolete anyway.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ addpm.c: Replace existing registry entries, but do not create new ones
+
+ * nt/addpm.c (add_registry): If the Emacs registry key exists, replace
+ existing values from previous versions, but do not add new ones; the
+ key could exist for other reasons unrelated to old Emacsen, like X-style
+ resources, or to set some environment variables like HOME or LANG, and
+ in that case we don't want to populate it with obsolete values.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * nt/addpm.c (add_registry): Do not compute unused return value.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ addpm.c: Don't pass REG_OPTION_NON_VOLATILE to RegOpenKeyEx
+
+ * nt/addpm.c (add_registry): Pass 0 to ulOptions argument of
+ RegOpenKeyEx, not REG_OPTION_NON_VOLATILE. This doesn't change
+ current behavior because REG_OPTION_NON_VOLATILE is defined to
+ be 0L anyway, but that option is actually documented only for
+ RegCreateKeyEx.
+
+2015-10-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * src/w32notify.c (Fw32notify_add_watch): Fix version check.
+
+2015-10-24 Eli Zaretskii <eliz@gnu.org>
+
+ Update frame title when redisplay scrolls selected window
+
+ * src/xdisp.c (redisplay_window): Reconsider the frame's title
+ when the mode-line of the frame's selected window needs to be
+ updated.
+
+2015-10-24 Eli Zaretskii <eliz@gnu.org>
+
+ Update frame title when scrolling the selected window
+
+ * src/window.c (wset_update_mode_line): New function, sets either
+ the window's update_mode_line flag or the global update_mode_lines
+ variable.
+ (Fset_window_start, set_window_buffer, window_scroll_pixel_based)
+ (window_scroll_line_based): Call it instead of only setting the
+ window's update_mode_line flag.
+
+2015-10-24 Eli Zaretskii <eliz@gnu.org>
+
+ An even better fix for bug#21739
+
+ * src/window.c (set_window_buffer): If the window is the frame's
+ selected window, set update_mode_lines, not the window's
+ update_mode_line flag.
+ * src/buffer.c (Fkill_buffer): Undo last change.
+ (set_update_modelines_for_buf): Function deleted.
+
+2015-10-24 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+ Alexandru Harsanyi <AlexHarsanyi@gmail.com>
+
+ Sync with soap-client repository, version 3.0.0
+
* lisp/net/soap-client.el, lisp/net/soap-inspect.el:
Bump version to 3.0.0.
* lisp/net/soap-client.el (soap-invoke): Encode the string for
`url-request-data' as UTF-8. Fixes issue 16.
-2015-10-25 Eli Zaretskii <eliz@gnu.org>
-
- * lisp/progmodes/grep.el (grep): Doc fix. (Bug#21754)
-
-2015-10-25 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * src/keyboard.c (post-command-hook): Extend the docstring.
- Mainly, explain how to use it without hanging Emacs, or giving the
- impression that it is hanging. Also mention `pre-command-hook'.
- (pre-command-hook): Mention `post-command-hook'.
-
-2015-10-25 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/custom.el (custom-declare-variable): Shorten code again.
- Without using pcase this time. We can't use pcase because it is
- loaded after custom in loadup.el. Also add a comment explaining
- this to future dummies like me.
-
-2015-10-25 Michael Albinus <michael.albinus@gmx.de>
-
- * doc/lispref/os.texi (File Notifications): Document `stopped event'.
-
-2015-10-25 Michael Albinus <michael.albinus@gmx.de>
-
- Introduce `stopped' event in file notification
-
- * lisp/filenotify.el (file-notify--rm-descriptor): New defun.
- (file-notify-rm-watch): Use it.
- (file-notify-callback): Implement `stopped' event.
- (file-notify-add-watch): Mention `stopped' in the docstring.
- Check, that upper directory exists.
-
- * test/automated/file-notify-tests.el (file-notify-test01-add-watch):
- Add two test cases.
- (file-notify-test02-events): Handle also `stopped' event.
- (file-notify-test04-file-validity): Add another test case.
-
-2015-10-25 Paul Eggert <eggert@cs.ucla.edu>
-
- Revert commit that broke 'make bootstrap'
-
- * lisp/custom.el (custom-declare-variable): Revert commit
- 79fac080d277fed07b3c192890ad59d36d9f83b6. custom.el needs to work
- even when pcase has not been defined yet, when doing bootstrapping.
-
-2015-10-25 Paul Eggert <eggert@cs.ucla.edu>
-
- Port recent inline functions fix to Standard C
-
- * src/lisp.h (LISP_MACRO_DEFUN, LISP_MACRO_DEFUN_VOID): Remove.
- All uses rewritten to define the function directly rather than to
- use a macro to define the function. This conforms to Standard C,
- which does not allow stray semicolons at the top level. I hope it
- also avoids the problems with TAGS. Those macros, though clever,
- were pretty confusing anyway, and it wasn’t clear they were worth
- the aggravation even without the TAGS problem.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/isearch.el: Make character-fold search the default again.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/character-fold.el: Many improvements.
- (character-fold-search-forward, character-fold-search-backward):
- New command.
- (character-fold-to-regexp): Remove lax-whitespace hack.
- (character-fold-search): Remove variable. Only isearch and
- query-replace use char-folding, and they both have their own
- variables to configure that.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/isearch.el: Generalize definition of regexp-function toggles.
- (isearch-specify-regexp-function): New macro for specifying
- possible values of `isearch-regexp-function'.
- (isearch-toggle-character-fold, isearch-toggle-symbol)
- (isearch-toggle-word): Define with `isearch-specify-regexp-function'.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/isearch.el (search-default-regexp-mode): New variable.
- (isearch-mode): Use it.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/isearch.el (search-exit-option, search-slow-window-lines)
- (search-slow-speed, search-upper-case)
- (search-nonincremental-instead, search-whitespace-regexp)
- (search-invisible, isearch-hide-immediately)
- (isearch-resume-in-command-history, search-ring-max)
- (regexp-search-ring-max, search-ring-update, search-highlight)
- (isearch-fail): Delete :group entries.
-
-2015-10-24 Artur Malabarba <bruce.connor.am@gmail.com>
-
- * lisp/custom.el (custom-declare-variable): Shorten code a bit.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- addpm.c: Silence some warnings.
-
- * nt/addpm.c (DdeCommand): Cast pData argument of DdeClientTransaction
- to LPBYTE.
- (add_registry): Pass NULL to optional lpClass argument of
- RegCreateKeyEx, not an empty string.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- addpm.c: Do not add obsolete GTK libraries to the path.
-
- * nt/addpm.c (REG_GTK, REG_RUNEMACS_PATH): Delete.
- (add_registry): Remove variables `size' and `gtk_key'.
- Do not add the GTK DLL directory to the library search path; it is
- confusing behavior (in particular, the same Emacs version with and
- without invoking addpm will use a different path), and the GTK image
- libraries are obsolete anyway.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- addpm.c: Replace existing registry entries, but do not create new ones
-
- * nt/addpm.c (add_registry): If the Emacs registry key exists, replace
- existing values from previous versions, but do not add new ones; the
- key could exist for other reasons unrelated to old Emacsen, like X-style
- resources, or to set some environment variables like HOME or LANG, and
- in that case we don't want to populate it with obsolete values.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- * nt/addpm.c (add_registry): Do not compute unused return value.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- addpm.c: Don't pass REG_OPTION_NON_VOLATILE to RegOpenKeyEx
-
- * nt/addpm.c (add_registry): Pass 0 to ulOptions argument of
- RegOpenKeyEx, not REG_OPTION_NON_VOLATILE. This doesn't change
- current behavior because REG_OPTION_NON_VOLATILE is defined to
- be 0L anyway, but that option is actually documented only for
- RegCreateKeyEx.
-
-2015-10-24 Juanma Barranquero <lekktu@gmail.com>
-
- * src/w32notify.c (Fw32notify_add_watch): Fix version check.
-
-2015-10-24 Eli Zaretskii <eliz@gnu.org>
-
- Update frame title when redisplay scrolls selected window
-
- * src/xdisp.c (redisplay_window): Reconsider the frame's title
- when the mode-line of the frame's selected window needs to be
- updated.
-
-2015-10-24 Eli Zaretskii <eliz@gnu.org>
-
- Update frame title when scrolling the selected window
-
- * src/window.c (wset_update_mode_line): New function, sets either
- the window's update_mode_line flag or the global update_mode_lines
- variable.
- (Fset_window_start, set_window_buffer, window_scroll_pixel_based)
- (window_scroll_line_based): Call it instead of only setting the
- window's update_mode_line flag.
-
-2015-10-24 Eli Zaretskii <eliz@gnu.org>
-
- An even better fix for bug#21739
-
- * src/window.c (set_window_buffer): If the window is the frame's
- selected window, set update_mode_lines, not the window's
- update_mode_line flag.
- * src/buffer.c (Fkill_buffer): Undo last change.
- (set_update_modelines_for_buf): Function deleted.
-
-2015-10-24 Thomas Fitzsimmons <fitzsim@fitzsim.org>
-
- Sync with soap-client repository, version 3.0.0
-
2015-10-24 Nicolas Petton <nicolas@petton.fr>
Update the new icon
2015-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/progmodes/prolog.el: Improve handling of if/then/else.
- (prolog-smie-rules): Accomodate standard if/then/else special
+ (prolog-smie-rules): Accommodate standard if/then/else special
indentation.
(prolog-mode): Add . to electric-indent-chars.
(prolog-electric--if-then-else): Re-indent the line before adding space
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit cb56d4cec80a4da41710e2fa68dcd3d95e2a8e4c (inclusive).
+commit 8a8613bcf4227dfe46a694b761e9575bdf6ca2ce (inclusive).
See ChangeLog.1 for earlier changes.
;; Local Variables:
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
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
'((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*"
;; 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))
"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)))
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.
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
named @file{.dir-locals.el}@footnote{ On MS-DOS, the name of this file
should be @file{_dir-locals.el}, due to limitations of the DOS
filesystems. If the filesystem is limited to 8+3 file names, the name
-of the file will be truncated by the OS to @file{_dir-loc.el}. } in a
+of the file will be truncated by the OS to @file{_dir-loc.el}.
+}@footnote{ You can also use files like @file{.dir-locals2.el}, which
+are loaded in addition. This is useful when @file{.dir-locals.el} is
+under version control in a shared repository and can't be used for
+personal customizations. } in a
directory. Whenever Emacs visits any file in that directory or any of
its subdirectories, it will apply the directory-local variables
specified in @file{.dir-locals.el}, as though they had been defined as
@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,
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
(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
@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
@dfn{project class} for that directory.
@defvr Constant dir-locals-file
-This constant is the name of the file where Emacs expects to find the
-directory-local variables. The name of the file is
-@file{.dir-locals.el}@footnote{
-The MS-DOS version of Emacs uses @file{_dir-locals.el} instead, due to
+This constant is a wildcard pattern matching the name of files where
+Emacs expects to find directory-local variables. Its value is
+@file{.dir-locals*.el}@footnote{
+The MS-DOS version of Emacs uses @file{_dir-locals*.el} instead, due to
limitations of the DOS filesystems.
-}. A file by that name in a directory causes Emacs to apply its
-settings to any file in that directory or any of its subdirectories
-(optionally, you can exclude subdirectories; see below).
-If some of the subdirectories have their own @file{.dir-locals.el}
-files, Emacs uses the settings from the deepest file it finds starting
-from the file's directory and moving up the directory tree. The file
-specifies local variables as a specially formatted list; see
-@ref{Directory Variables, , Per-directory Local Variables, emacs, The
-GNU Emacs Manual}, for more details.
+}, and the most common file name to use is @file{.dir-locals.el}.
+
+Any file matching this name pattern in a directory causes Emacs to
+apply its settings when visiting files in that directory or any of its
+subdirectories (optionally, you can exclude subdirectories; see
+below).
+If some of the subdirectories have their own file matching
+@file{.dir-locals*.el}, Emacs uses the settings from the deepest file
+it finds starting from the file's directory and moving up the
+directory tree. The file specifies local variables as a specially
+formatted list; see @ref{Directory Variables, , Per-directory Local
+Variables, emacs, The GNU Emacs Manual}, for more details.
+
+If the same directory contains multiple such files (for instance,
+@file{.dir-locals.el} and @file{.dir-locals2.el}), then all of them
+are used in @code{string<} order. This means that, if two files
+specify different values for the same variable, the file sorted after
+will override the value of the previous file (for instance, values in
+@file{.dir-locals2.el} override those in @file{.dir-locals.el}). Note
+that, because of how lexicographic order works, values in
+@file{.dir-locals10.el} are overridden by values in @file{.dir-locals2.el}.
+This can be avoided by using @file{.dir-locals02.el} instead.
@end defvr
@defun hack-dir-local-variables
@group
(let ((edges (window-absolute-body-pixel-edges))
(position (pos-visible-in-window-p nil nil t)))
- (x-set-mouse-absolute-pixel-position
+ (set-mouse-absolute-pixel-position
(+ (nth 0 edges) (nth 0 position))
(+ (nth 1 edges) (nth 1 position))))
@end group
@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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
\f
* Changes in Emacs 25.1
+** Any file of the form .dir-locals*.el is now considered a dir-local
+ file, and multiple can be used in the same directory. See the
+ variable `dir-locals-file' for more information.
** `xref-find-definitions' and `describe-function' now display
information about mode local overrides (defined by
cedet/mode-local.el `define-overloadable-function' and
\f
* Changes in Specialized Modes and Packages in Emacs 25.1
+** New function `bookmark-set-no-overwrite' bound to C-x r M.
+It raises an error if a bookmark of that name already exists,
+unlike `bookmark-set' which silently updates an existing bookmark.
+
** JSON
---
*** `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.
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
# 'ysave-buffer', and 'ybuffer-contents'. The 'y' prefix avoids any
# namespace collisions with emacs/src/.gdbinit.
-# Since the internal data structures in Emacs occasionally from time to
+# Since the internal data structures in Emacs change from time to
# time, you should use the version of this file that came with your
# particular Emacs version; older versions might not work anymore.
set $endptr = $beg + $buf->gpt_byte - 1
dump binary memory $arg1 $beg $endptr
else
- dump binary memory $arg1 $beg $gap-1
- append binary memory $arg1 $gap_end $end
+ if $gap - $beg > 1
+ dump binary memory $arg1 $beg $gap-1
+ append binary memory $arg1 $gap_end $end
+ else
+ dump binary memory $arg1 $gap_end $end
+ end
set $endptr = $end
end
end
#include <limits.h>
-/* Return an integer value, converted to the same type as the integer
- expression E after integer type promotion. V is the unconverted value. */
+/* Return a value with the common real type of E and V and the value of V. */
#define _GL_INT_CONVERT(e, v) (0 * (e) + (v))
/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see
/* True if the signed integer expression E uses two's complement. */
#define _GL_INT_TWOS_COMPLEMENT(e) (~ _GL_INT_CONVERT (e, 0) == -1)
-/* True if the arithmetic type T is signed. */
+/* True if the real type T is signed. */
#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
-/* Return 1 if the integer expression E, after integer promotion, has
- a signed type. */
-#define _GL_INT_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0)
+/* Return 1 if the real expression E, after promotion, has a
+ signed or floating type. */
+#define EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0)
/* Minimum and maximum values for integer types and expressions. These
/* The maximum and minimum values for the type of the expression E,
after integer promotion. E should not have side effects. */
#define _GL_INT_MINIMUM(e) \
- (_GL_INT_SIGNED (e) \
+ (EXPR_SIGNED (e) \
? - _GL_INT_TWOS_COMPLEMENT (e) - _GL_SIGNED_INT_MAXIMUM (e) \
: _GL_INT_CONVERT (e, 0))
#define _GL_INT_MAXIMUM(e) \
- (_GL_INT_SIGNED (e) \
+ (EXPR_SIGNED (e) \
? _GL_SIGNED_INT_MAXIMUM (e) \
: _GL_INT_NEGATE_CONVERT (e, 1))
#define _GL_SIGNED_INT_MAXIMUM(e) \
The INT_<op>_OVERFLOW macros return 1 if the corresponding C operators
might not yield numerically correct answers due to arithmetic overflow.
- The INT_<op>_WRAPV macros return the low-order bits of the answer.
- For example, INT_ADD_WRAPV (INT_MAX, 1) returns INT_MIN on a two's
- complement host, even if INT_MAX + 1 would trap.
-
+ The INT_<op>_WRAPV macros also store the low-order bits of the answer.
These macros work correctly on all known practical hosts, and do not rely
on undefined behavior due to signed arithmetic overflow.
- Example usage:
+ Example usage, assuming A and B are long int:
- long int a = ...;
- long int b = ...;
long int result = INT_MULTIPLY_WRAPV (a, b);
printf ("result is %ld (%s)\n", result,
INT_MULTIPLY_OVERFLOW (a, b) ? "after overflow" : "no overflow");
- enum {
- INT_PRODUCTS_FIT_IN_LONG
- = ! INT_CONST_MULTIPLY_OVERFLOW ((long int) INT_MIN, INT_MIN)
- };
+ Example usage with WRAPV flavor:
+
+ long int result;
+ bool overflow = INT_MULTIPLY_WRAPV (a, b, &result);
+ printf ("result is %ld (%s)\n", result,
+ overflow ? "after overflow" : "no overflow");
Restrictions on these macros:
These macros may evaluate their arguments zero or multiple times, so the
arguments should not have side effects.
- On non-GCC-compatible compilers that do not support C11, the type
- of INT_<op>_WRAPV (A, B) might differ from the native type of (A op
- B), so it is wise to convert the result to the native type. Such a
- conversion is safe and cannot trap.
-
- For runtime efficiency GCC 5 and later has builtin functions for +,
- -, * when doing integer overflow checking or wraparound arithmetic.
- Unfortunately, these builtins require nonnull pointer arguments and
- so cannot be used in constant expressions; see GCC bug 68120
- <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68120>. In constant
- expressions, use the macros INT_CONST_ADD_OVERFLOW and
- INT_CONST_ADD_WRAPV instead, and similarly for SUBTRACT and
- MULTIPLY; these macros avoid the builtins and are slower in
- non-constant expressions. Perhaps someday GCC's API for overflow
- checking will be improved and we can remove the need for the
- INT_CONST_ variants.
+ The WRAPV macros are not constant expressions. They support only
+ +, binary -, and *. The result type must be signed.
These macros are tuned for their last argument being a constant.
Return 1 if the integer expressions A * B, A - B, -A, A * B, A / B,
A % B, and A << B would overflow, respectively. */
-#define INT_CONST_ADD_OVERFLOW(a, b) \
+#define INT_ADD_OVERFLOW(a, b) \
_GL_BINARY_OP_OVERFLOW (a, b, _GL_ADD_OVERFLOW)
-#define INT_CONST_SUBTRACT_OVERFLOW(a, b) \
+#define INT_SUBTRACT_OVERFLOW(a, b) \
_GL_BINARY_OP_OVERFLOW (a, b, _GL_SUBTRACT_OVERFLOW)
#define INT_NEGATE_OVERFLOW(a) \
INT_NEGATE_RANGE_OVERFLOW (a, _GL_INT_MINIMUM (a), _GL_INT_MAXIMUM (a))
-#define INT_CONST_MULTIPLY_OVERFLOW(a, b) \
+#define INT_MULTIPLY_OVERFLOW(a, b) \
_GL_BINARY_OP_OVERFLOW (a, b, _GL_MULTIPLY_OVERFLOW)
#define INT_DIVIDE_OVERFLOW(a, b) \
_GL_BINARY_OP_OVERFLOW (a, b, _GL_DIVIDE_OVERFLOW)
_GL_INT_MINIMUM (0 * (b) + (a)), \
_GL_INT_MAXIMUM (0 * (b) + (a)))
-/* Return the low order bits of the integer expressions
- A * B, A - B, -A, A * B, A / B, A % B, and A << B, respectively.
- See above for restrictions. */
-#define INT_CONST_ADD_WRAPV(a, b) _GL_INT_OP_WRAPV (a, b, +)
-#define INT_CONST_SUBTRACT_WRAPV(a, b) _GL_INT_OP_WRAPV (a, b, -)
-#define INT_NEGATE_WRAPV(a) INT_CONST_SUBTRACT_WRAPV (0, a)
-#define INT_CONST_MULTIPLY_WRAPV(a, b) _GL_INT_OP_WRAPV (a, b, *)
-#define INT_DIVIDE_WRAPV(a, b) \
- (INT_DIVIDE_OVERFLOW(a, b) ? INT_NEGATE_WRAPV (a) : (a) / (b))
-#define INT_REMAINDER_WRAPV(a, b) \
- (INT_REMAINDER_OVERFLOW(a, b) ? 0 : (a) % (b))
-#define INT_LEFT_SHIFT_WRAPV(a, b) _GL_INT_OP_WRAPV (a, b, <<)
-
-/* Return the low order bits of A <op> B, where OP specifies the operation.
- See above for restrictions. */
-#if !_GL_HAVE___TYPEOF__ && 201112 <= __STDC_VERSION__
-# define _GL_INT_OP_WRAPV(a, b, op) \
- _Generic ((a) op (b), \
- int: _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, int), \
- long int: _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, long int), \
- long long int: _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, \
- long long int), \
- default: (a) op (b))
+/* Compute A + B, A - B, A * B, respectively, storing the result into *R.
+ Return 1 if the result overflows. See above for restrictions. */
+#define INT_ADD_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, +, __builtin_add_overflow, INT_ADD_OVERFLOW)
+#define INT_SUBTRACT_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, -, __builtin_sub_overflow, INT_SUBTRACT_OVERFLOW)
+#define INT_MULTIPLY_WRAPV(a, b, r) \
+ _GL_INT_OP_WRAPV (a, b, r, *, __builtin_mul_overflow, INT_MULTIPLY_OVERFLOW)
+
+#ifndef __has_builtin
+# define __has_builtin(x) 0
+#endif
+
+/* Nonzero if this compiler has GCC bug 68193 or Clang bug 25390. See:
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68193
+ https://llvm.org/bugs/show_bug.cgi?id=25390
+ For now, assume all versions of GCC-like compilers generate bogus
+ warnings for _Generic. This matters only for older compilers that
+ lack __builtin_add_overflow. */
+#if __GNUC__
+# define _GL__GENERIC_BOGUS 1
#else
-# define _GL_INT_OP_WRAPV(a, b, op) \
- (! _GL_INT_SIGNED ((0 * (a)) op (0 * (b))) \
- ? ((a) op (b)) \
- : _GL_EXPR_CAST ((a) op (b), \
- (sizeof ((a) op (b)) <= sizeof (int) \
- ? _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, int) \
- : _GL_INT_OP_WRAPV_LONGISH (a, b, op))))
-
-/* Cast to E's type the value of V if possible. Yield V as-is otherwise. */
-# if _GL_HAVE___TYPEOF__
-# define _GL_EXPR_CAST(e, v) ((__typeof__ (e)) (v))
-# else
-# define _GL_EXPR_CAST(e, v) (v)
-# endif
+# define _GL__GENERIC_BOGUS 0
+#endif
+/* Store A <op> B into *R, where OP specifies the operation.
+ BUILTIN is the builtin operation, and OVERFLOW the overflow predicate.
+ See above for restrictions. */
+#if 5 <= __GNUC__ || __has_builtin (__builtin_add_overflow)
+# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) builtin (a, b, r)
+#elif 201112 <= __STDC_VERSION__ && !_GL__GENERIC_BOGUS
+# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \
+ (_Generic \
+ (*(r), \
+ signed char: \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned char, \
+ signed char, SCHAR_MIN, SCHAR_MAX), \
+ short int: \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned short int, \
+ short int, SHRT_MIN, SHRT_MAX), \
+ int: \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \
+ int, INT_MIN, INT_MAX), \
+ long int: \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \
+ long int, LONG_MIN, LONG_MAX), \
+ long long int: \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \
+ long long int, LLONG_MIN, LLONG_MAX)))
+#else
+# define _GL_INT_OP_WRAPV(a, b, r, op, builtin, overflow) \
+ (sizeof *(r) == sizeof (signed char) \
+ ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned char, \
+ signed char, SCHAR_MIN, SCHAR_MAX) \
+ : sizeof *(r) == sizeof (short int) \
+ ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned short int, \
+ short int, SHRT_MIN, SHRT_MAX) \
+ : sizeof *(r) == sizeof (int) \
+ ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned int, \
+ int, INT_MIN, INT_MAX) \
+ : _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow))
# ifdef LLONG_MAX
-# define _GL_INT_OP_WRAPV_LONGISH(a, b, op) \
- (sizeof ((a) op (b)) <= sizeof (long int) \
- ? _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, long int) \
- : _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, long long int))
+# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \
+ (sizeof *(r) == sizeof (long int) \
+ ? _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \
+ long int, LONG_MIN, LONG_MAX) \
+ : _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long long int, \
+ long long int, LLONG_MIN, LLONG_MAX))
# else
-# define _GL_INT_OP_WRAPV_LONGISH(a, b, op) \
- _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, long int)
+# define _GL_INT_OP_WRAPV_LONGISH(a, b, r, op, overflow) \
+ _GL_INT_OP_CALC (a, b, r, op, overflow, unsigned long int, \
+ long int, LONG_MIN, LONG_MAX))
# endif
#endif
-/* Return A <op> B, where the operation is given by OP and the result
- type is T. T is a signed integer type that is at least as wide as int.
- Do arithmetic using 'unsigned T' to avoid signed integer overflow.
- Subtract TYPE_MINIMUM (T) before converting back to T, and add it
- back afterwards, to avoid signed overflow during conversion. */
-#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, t) \
- ((unsigned t) (a) op (unsigned t) (b) <= TYPE_MAXIMUM (t) \
- ? (t) ((unsigned t) (a) op (unsigned t) (b)) \
- : ((t) ((unsigned t) (a) op (unsigned t) (b) - TYPE_MINIMUM (t)) \
- + TYPE_MINIMUM (t)))
-
-/* Calls to the INT_<op>_<result> macros are like their INT_CONST_<op>_<result>
- counterparts, except they are faster with GCC 5 or later, and they
- are not constant expressions due to limitations in the GNU C API. */
-
-#define INT_ADD_OVERFLOW(a, b) \
- _GL_OP_OVERFLOW (a, b, INT_CONST_ADD_OVERFLOW, __builtin_add_overflow)
-#define INT_SUBTRACT_OVERFLOW(a, b) \
- _GL_OP_OVERFLOW (a, b, INT_CONST_SUBTRACT_OVERFLOW, __builtin_sub_overflow)
-#define INT_MULTIPLY_OVERFLOW(a, b) \
- _GL_OP_OVERFLOW (a, b, INT_CONST_MULTIPLY_OVERFLOW, __builtin_mul_overflow)
-
-#define INT_ADD_WRAPV(a, b) \
- _GL_OP_WRAPV (a, b, INT_CONST_ADD_WRAPV, __builtin_add_overflow)
-#define INT_SUBTRACT_WRAPV(a, b) \
- _GL_OP_WRAPV (a, b, INT_CONST_SUBTRACT_WRAPV, __builtin_sub_overflow)
-#define INT_MULTIPLY_WRAPV(a, b) \
- _GL_OP_WRAPV (a, b, INT_CONST_MULTIPLY_WRAPV, __builtin_mul_overflow)
-
-#if __GNUC__ < 5
-# define _GL_OP_OVERFLOW(a, b, portable, builtin) portable (a, b)
-# define _GL_OP_WRAPV(a, b, portable, builtin) portable (a, b)
-#else
-# define _GL_OP_OVERFLOW(a, b, portable, builtin) \
- builtin (a, b, &(__typeof__ ((a) + (b))) {0})
-# define _GL_OP_WRAPV(a, b, portable, builtin) \
- _GL_OP_WRAPV_GENSYM(a, b, builtin, __gl_wrapv##__COUNTER__)
-# define _GL_OP_WRAPV_GENSYM(a, b, builtin, r) \
- ({__typeof__ ((a) + (b)) r; builtin (a, b, &r); r; })
-#endif
+/* Store the low-order bits of A <op> B into *R, where the operation
+ is given by OP. Use the unsigned type UT for calculation to avoid
+ overflow problems. *R's type is T, with extremal values TMIN and
+ TMAX. T must be a signed integer type. */
+#define _GL_INT_OP_CALC(a, b, r, op, overflow, ut, t, tmin, tmax) \
+ (sizeof ((a) op (b)) < sizeof (t) \
+ ? _GL_INT_OP_CALC1 ((t) (a), (t) (b), r, op, overflow, ut, t, tmin, tmax) \
+ : _GL_INT_OP_CALC1 (a, b, r, op, overflow, ut, t, tmin, tmax))
+#define _GL_INT_OP_CALC1(a, b, r, op, overflow, ut, t, tmin, tmax) \
+ ((overflow (a, b) \
+ || (EXPR_SIGNED ((a) op (b)) && ((a) op (b)) < (tmin)) \
+ || (tmax) < ((a) op (b))) \
+ ? (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t, tmin, tmax), 1) \
+ : (*(r) = _GL_INT_OP_WRAPV_VIA_UNSIGNED (a, b, op, ut, t, tmin, tmax), 0))
+
+/* Return A <op> B, where the operation is given by OP. Use the
+ unsigned type UT for calculation to avoid overflow problems.
+ Convert the result to type T without overflow by subtracting TMIN
+ from large values before converting, and adding it afterwards.
+ Compilers can optimize all the operations except OP. */
+#define _GL_INT_OP_WRAPV_VIA_UNSIGNED(a, b, op, ut, t, tmin, tmax) \
+ (((ut) (a) op (ut) (b)) <= (tmax) \
+ ? (t) ((ut) (a) op (ut) (b)) \
+ : ((t) (((ut) (a) op (ut) (b)) - (tmin)) + (tmin)))
#endif /* _GL_INTPROPS_H */
int ns = a.tv_nsec + b.tv_nsec;
int nsd = ns - TIMESPEC_RESOLUTION;
int rns = ns;
+ time_t tmin = TYPE_MINIMUM (time_t);
+ time_t tmax = TYPE_MAXIMUM (time_t);
if (0 <= nsd)
{
rns = nsd;
- if (rs == TYPE_MAXIMUM (time_t))
- {
- if (0 <= bs)
- goto high_overflow;
- bs++;
- }
- else
+ if (bs < tmax)
+ bs++;
+ else if (rs < 0)
rs++;
+ else
+ goto high_overflow;
}
- if (INT_ADD_OVERFLOW (rs, bs))
+ /* INT_ADD_WRAPV is not appropriate since time_t might be unsigned.
+ In theory time_t might be narrower than int, so plain
+ INT_ADD_OVERFLOW does not suffice. */
+ if (! INT_ADD_OVERFLOW (rs, bs) && tmin <= rs + bs && rs + bs <= tmax)
+ rs += bs;
+ else
{
if (rs < 0)
{
- rs = TYPE_MINIMUM (time_t);
+ rs = tmin;
rns = 0;
}
else
{
high_overflow:
- rs = TYPE_MAXIMUM (time_t);
+ rs = tmax;
rns = TIMESPEC_RESOLUTION - 1;
}
}
- else
- rs += bs;
return make_timespec (rs, rns);
}
time_t bs = b.tv_sec;
int ns = a.tv_nsec - b.tv_nsec;
int rns = ns;
+ time_t tmin = TYPE_MINIMUM (time_t);
+ time_t tmax = TYPE_MAXIMUM (time_t);
if (ns < 0)
{
rns = ns + TIMESPEC_RESOLUTION;
- if (rs == TYPE_MINIMUM (time_t))
- {
- if (bs <= 0)
- goto low_overflow;
- bs--;
- }
- else
+ if (bs < tmax)
+ bs++;
+ else if (- TYPE_SIGNED (time_t) < rs)
rs--;
+ else
+ goto low_overflow;
}
- if (INT_SUBTRACT_OVERFLOW (rs, bs))
+ /* INT_SUBTRACT_WRAPV is not appropriate since time_t might be unsigned.
+ In theory time_t might be narrower than int, so plain
+ INT_SUBTRACT_OVERFLOW does not suffice. */
+ if (! INT_SUBTRACT_OVERFLOW (rs, bs) && tmin <= rs - bs && rs - bs <= tmax)
+ rs -= bs;
+ else
{
if (rs < 0)
{
low_overflow:
- rs = TYPE_MINIMUM (time_t);
+ rs = tmin;
rns = 0;
}
else
{
- rs = TYPE_MAXIMUM (time_t);
+ rs = tmax;
rns = TIMESPEC_RESOLUTION - 1;
}
}
- else
- rs -= bs;
return make_timespec (rs, rns);
}
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
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_ */
2014-12-14 Steve Purcell <steve@sanityinc.com> (tiny change)
* emacs-lisp/package.el (package-menu-mode): Use an extra column
- for the "Version" column, to accomodate date-and-time-based versions.
+ for the "Version" column, to accommodate date-and-time-based versions.
2014-12-14 Cameron Desautels <camdez@gmail.com>
(python-shell-prompt-detect)
(python-shell-prompt-validate-regexps): New functions.
(python-shell-prompt-set-calculated-regexps): New function.
- (inferior-python-mode): Use it. Also honor overriden
+ (inferior-python-mode): Use it. Also honor overridden
python-shell-interpreter and python-shell-interpreter-args.
- (python-shell-make-comint): Honor overriden
+ (python-shell-make-comint): Honor overridden
python-shell-interpreter and python-shell-interpreter-args.
(python-shell-get-or-create-process): Make it testable by allowing
to call run-python non-interactively.
* faces.el (face-spec-recalc): Apply X resources only after the
defface spec has been applied. Thus, X resources are no longer
- overriden by the defface spec which also fixes issues on win32 where
+ overridden by the defface spec which also fixes issues on win32 where
the toolbar coloring was wrong because it is set through X resources
- and was (wrongfully) overriden. (Bug#16694)
+ and was (wrongfully) overridden. (Bug#16694)
2014-04-30 Stefan Monnier <monnier@iro.umontreal.ca>
,@(if (cadr props) (list :system (cadr props))))))
(unless (plist-get props :count)
(setq props (plist-put props :count 0)))
+ (setq props (plist-put props :abbrev-table-modiff
+ (abbrev-table-get table :abbrev-table-modiff)))
(let ((system-flag (plist-get props :system))
(sym (intern name table)))
;; Don't override a prior user-defined abbrev with a system abbrev,
(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)
;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
+;;;###autoload (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
;;;###autoload
;; Read the help on all of these functions for details...
(define-key map "x" 'bookmark-set)
(define-key map "m" 'bookmark-set) ;"m"ark
+ (define-key map "M" 'bookmark-set-no-overwrite) ;"M"aybe mark
(define-key map "j" 'bookmark-jump)
(define-key map "g" 'bookmark-jump) ;"g"o
(define-key map "o" 'bookmark-jump-other-window)
(define-key map "\C-w" 'bookmark-yank-word)
map))
-;;;###autoload
-(defun bookmark-set (&optional name no-overwrite)
- "Set a bookmark named NAME at the current location.
-If name is nil, then prompt the user.
-
-With a prefix arg (non-nil NO-OVERWRITE), do not overwrite any
-existing bookmark that has the same name as NAME, but instead push the
-new bookmark onto the bookmark alist. The most recently set bookmark
-with name NAME is thus the one in effect at any given time, but the
-others are still there, should the user decide to delete the most
-recent one.
+(defun bookmark-set-internal (prompt name overwrite-or-push)
+ "Interactively set a bookmark named NAME at the current location.
-To yank words from the text of the buffer and use them as part of the
-bookmark name, type C-w while setting a bookmark. Successive C-w's
-yank successive words.
+Begin the interactive prompt with PROMPT, followed by a space, a
+generated default name in parentheses, a colon and a space.
-Typing C-u inserts (at the bookmark name prompt) the name of the last
-bookmark used in the document where the new bookmark is being set;
-this helps you use a single bookmark name to track progress through a
-large document. If there is no prior bookmark for this document, then
-C-u inserts an appropriate name based on the buffer or file.
-
-Use \\[bookmark-delete] to remove bookmarks (you give it a name and
-it removes only the first instance of a bookmark with that name from
-the list of bookmarks.)"
+If OVERWRITE-OR-PUSH is nil, then error if there is already a
+bookmark named NAME; if `overwrite', then replace any existing
+bookmark if there is one; if `push' then push the new bookmark
+onto the bookmark alist. The `push' behavior means that among
+bookmarks named NAME, this most recently set one becomes the one in
+effect, but the others are still there, in order, if the topmost one
+is ever deleted."
(interactive (list nil current-prefix-arg))
(unwind-protect
(let* ((record (bookmark-make-record))
(let ((str
(or name
(read-from-minibuffer
- (format "Set bookmark (%s): " default)
+ (format "%s (default: \"%s\"): " prompt default)
nil
bookmark-minibuffer-read-name-map
nil nil defaults))))
(and (string-equal str "") (setq str default))
- (bookmark-store str (cdr record) no-overwrite)
+
+ (cond
+ ((eq overwrite-or-push nil)
+ (if (bookmark-get-bookmark str t)
+ (error "A bookmark named \"%s\" already exists." str)
+ (bookmark-store str (cdr record) nil)))
+ ((eq overwrite-or-push 'overwrite)
+ (bookmark-store str (cdr record) nil))
+ ((eq overwrite-or-push 'push)
+ (bookmark-store str (cdr record) t))
+ (t
+ (error "Unrecognized value for `overwrite-or-push': %S"
+ overwrite-or-push)))
;; Ask for an annotation buffer for this bookmark
(when bookmark-use-annotations
(setq bookmark-current-buffer nil)))
+;;;###autoload
+(defun bookmark-set (&optional name no-overwrite)
+ "Set a bookmark named NAME at the current location.
+If NAME is nil, then prompt the user.
+
+With a prefix arg (non-nil NO-OVERWRITE), do not overwrite any
+existing bookmark that has the same name as NAME, but instead push the
+new bookmark onto the bookmark alist. The most recently set bookmark
+with name NAME is thus the one in effect at any given time, but the
+others are still there, should the user decide to delete the most
+recent one.
+
+To yank words from the text of the buffer and use them as part of the
+bookmark name, type C-w while setting a bookmark. Successive C-w's
+yank successive words.
+
+Typing C-u inserts (at the bookmark name prompt) the name of the last
+bookmark used in the document where the new bookmark is being set;
+this helps you use a single bookmark name to track progress through a
+large document. If there is no prior bookmark for this document, then
+C-u inserts an appropriate name based on the buffer or file.
+
+Use \\[bookmark-delete] to remove bookmarks (you give it a name and
+it removes only the first instance of a bookmark with that name from
+the list of bookmarks.)"
+ (interactive (list nil current-prefix-arg))
+ (let ((prompt
+ (if no-overwrite "Set bookmark" "Set bookmark unconditionally")))
+ (bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite))))
+
+;;;###autoload
+(defun bookmark-set-no-overwrite (&optional name push-bookmark)
+ "Set a bookmark named NAME at the current location.
+If NAME is nil, then prompt the user.
+
+If a bookmark named NAME already exists and prefix argument
+PUSH-BOOKMARK is non-nil, then push the new bookmark onto the
+bookmark alist. Pushing it means that among bookmarks named
+NAME, this one becomes the one in effect, but the others are
+still there, in order, and become effective again if the user
+ever deletes the most recent one.
+
+Otherwise, if a bookmark named NAME already exists but PUSH-BOOKMARK
+is nil, raise an error.
+
+To yank words from the text of the buffer and use them as part of the
+bookmark name, type C-w while setting a bookmark. Successive C-w's
+yank successive words.
+
+Typing C-u inserts (at the bookmark name prompt) the name of the last
+bookmark used in the document where the new bookmark is being set;
+this helps you use a single bookmark name to track progress through a
+large document. If there is no prior bookmark for this document, then
+C-u inserts an appropriate name based on the buffer or file.
+
+Use \\[bookmark-delete] to remove bookmarks (you give it a name and
+it removes only the first instance of a bookmark with that name from
+the list of bookmarks.)"
+ (interactive (list nil current-prefix-arg))
+ (bookmark-set-internal "Set bookmark" name (if push-bookmark 'push nil)))
+
+
(defun bookmark-kill-line (&optional newline-too)
"Kill from point to end of line.
If optional arg NEWLINE-TOO is non-nil, delete the newline too.
(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.
(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
(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))
(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)
(defmacro cl-generic-define-context-rewriter (name args &rest body)
"Define a special kind of context named NAME.
-Whenever a context specializer of the form (NAME . ACTUALS) appears,
+Whenever a context specializer of the form (NAME . ARGS) appears,
the specializer used will be the one returned by BODY."
(declare (debug (&define name lambda-list def-body)) (indent defun))
`(eval-and-compile
slots defaults)))
(push `(cl-defsubst ,cname
(&cl-defs (nil ,@descs) ,@args)
- ,(if (stringp doc) (list doc)
+ ,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
(memq (car cl-list1) cl-list2))
(push (car cl-list1) cl-res))
(pop cl-list1))
- cl-res))))
+ (nreverse cl-res)))))
;;;###autoload
(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
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)
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)
(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)
MAP can be a list, hash-table or array."
(catch 'map--break
(map-apply (lambda (key value)
- (or (funcall pred key value)
- (throw 'map--break nil)))
- map)
+ (or (funcall pred key value)
+ (throw 'map--break nil)))
+ map)
t))
(defun map-merge (type &rest maps)
(let (result)
(while maps
(map-apply (lambda (key value)
- (setf (map-elt result key) value))
- (pop maps)))
+ (setf (map-elt result key) value))
+ (pop maps)))
+ (map-into result type)))
+
+(defun map-merge-with (type function &rest maps)
+ "Merge into a map of type TYPE all the key/value pairs in MAPS.
+When two maps contain the same key, call FUNCTION on the two
+values and use the value returned by it.
+MAP can be a list, hash-table or array."
+ (let (result)
+ (while maps
+ (map-apply (lambda (key value)
+ (setf (map-elt result key)
+ (if (map-contains-key result key)
+ (funcall function (map-elt result key) value)
+ value)))
+ (pop maps)))
(map-into result type)))
(defun map-into (map type)
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
-;; Version: 2.2
+;; Version: 2.3
;; Package: seq
;; Maintainer: emacs-devel@gnu.org
;; - `seq-elt'
;; - `seq-length'
;; - `seq-do'
-;; - `seq-p'
+;; - `seqp'
;; - `seq-subseq'
;; - `seq-into-sequence'
;; - `seq-copy'
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)
(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))
"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)))
(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
(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)
(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")))
+2015-11-07 Kelvin White <kwhite@gnu.org>
+
+ * erc-pcomplete.el (pcomplete-erc-nicks): Fix bug for tab complete
+ (bug#18771)
+
2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
* erc.el (erc-switch-to-buffer): Fix last change (bug#20187).
(erc-get-channel-user-list)))
(nicks nil))
(dolist (user users)
- (unless (and ignore-self
- (string= (erc-server-user-nickname (car user))
- (erc-current-nick)))
+ (unless (or (not user)
+ (and ignore-self
+ (string= (erc-server-user-nickname (car user))
+ (erc-current-nick))))
(setq nicks (cons (concat (erc-server-user-nickname (car user))
postfix)
nicks))))
;; Send `stopped' event.
(dolist (entry (cdr registered))
(funcall (cdr entry)
- `(,(file-notify--descriptor desc) stopped
+ `(,descriptor stopped
,(or (and (stringp (car entry))
(expand-file-name (car entry) dir))
dir))))
;; `inotify' returns the same descriptor when the file (directory)
;; uses the same inode. We want to distinguish, and apply a virtual
;; descriptor which make the difference.
-(defun file-notify--descriptor (descriptor)
+(defun file-notify--descriptor (desc file)
"Return the descriptor to be used in `file-notify-*-watch'.
For `gfilenotify' and `w32notify' it is the same descriptor as
used in the low-level file notification package."
- (if (and (natnump descriptor) (eq file-notify--library 'inotify))
- (cons descriptor
- (car (cadr (gethash descriptor file-notify-descriptors))))
- descriptor))
+ (if (and (natnump desc) (eq file-notify--library 'inotify))
+ (cons desc
+ (and (stringp file)
+ (car (assoc
+ (file-name-nondirectory file)
+ (gethash desc file-notify-descriptors)))))
+ desc))
;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(car file-notify--pending-event)))
;; If the source is handled by another watch, we
;; must fire the rename event there as well.
- (when (not (equal (file-notify--descriptor desc)
+ (when (not (equal (file-notify--descriptor desc file1)
(file-notify--descriptor
- (caar file-notify--pending-event))))
+ (caar file-notify--pending-event)
+ (file-notify--event-file-name
+ file-notify--pending-event))))
(setq pending-event
`((,(caar file-notify--pending-event)
renamed ,file ,file1)
;; Apply pending callback.
(when pending-event
(setcar
- (car pending-event) (file-notify--descriptor (caar pending-event)))
+ (car pending-event)
+ (file-notify--descriptor
+ (caar pending-event)
+ (file-notify--event-file-name file-notify--pending-event)))
(funcall (cadr pending-event) (car pending-event))
(setq pending-event nil))
(if file1
(funcall
callback
- `(,(file-notify--descriptor desc) ,action ,file ,file1))
+ `(,(file-notify--descriptor desc file) ,action ,file ,file1))
(funcall
callback
- `(,(file-notify--descriptor desc) ,action ,file)))))
+ `(,(file-notify--descriptor desc file) ,action ,file)))))
;; Modify `file-notify-descriptors'.
(when stopped
- (file-notify--rm-descriptor (file-notify--descriptor desc) file)))))
+ (file-notify--rm-descriptor
+ (file-notify--descriptor desc file) file)))))
;; `gfilenotify' and `w32notify' return a unique descriptor for every
;; `file-notify-add-watch', while `inotify' returns a unique
file-notify-descriptors)
;; Return descriptor.
- (file-notify--descriptor desc)))
+ (file-notify--descriptor
+ desc (unless (file-directory-p file) (file-name-nondirectory file)))))
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.
(if handler
;; A file name handler could exist even if there is no local
;; file notification support.
- (funcall handler 'file-notify-rm-watch desc)
+ (funcall handler 'file-notify-rm-watch descriptor)
(funcall
(cond
(catch 'exit
(unless enable-local-variables
(throw 'exit (message "Directory-local variables are disabled")))
- (let ((variables-file (or (and (buffer-file-name)
- (not (file-remote-p (buffer-file-name)))
- (dir-locals-find-file (buffer-file-name)))
- dir-locals-file))
+ (let ((variables-file (and (buffer-file-name)
+ (not (file-remote-p (buffer-file-name)))
+ (dir-locals-find-file (buffer-file-name))))
variables)
- (if (consp variables-file) ; result from cache
- ;; If cache element has an mtime, assume it came from a file.
- ;; Otherwise, assume it was set directly.
- (setq variables-file (if (nth 2 variables-file)
- (expand-file-name dir-locals-file
- (car variables-file))
- (cadr variables-file))))
+ (setq variables-file
+ ;; If there are several .dir-locals, the user probably
+ ;; wants to edit the last one (the highest priority).
+ (cond ((stringp variables-file)
+ (car (last (dir-locals--all-files variables-file))))
+ ((consp variables-file) ; result from cache
+ ;; If cache element has an mtime, assume it came from a file.
+ ;; Otherwise, assume it was set directly.
+ (if (nth 2 variables-file)
+ (car (last (dir-locals--all-files (car variables-file))))
+ (cadr variables-file)))
+ ;; Try to make a proper file-name. This doesn't cover all
+ ;; wildcards, but it covers the default value of `dir-locals-file'.
+ (t (replace-regexp-in-string
+ "\\*" "" (replace-regexp-in-string "\\?" "-" dir-locals-file)))))
;; I can't be bothered to handle this case right now.
;; Dir locals were set directly from a class. You need to
;; directly modify the class in dir-locals-class-alist.
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
- (message ".dir-locals error: %s" (error-message-string err))
+ (message "%s error: %s" dir-locals-file (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
applied by recursively following these rules."
(setf (alist-get class dir-locals-class-alist) variables))
-(defconst dir-locals-file ".dir-locals.el"
- "File that contains directory-local variables.
-It has to be constant to enforce uniform values
-across different environments and users.")
+(defconst dir-locals-file ".dir-locals*.el"
+ "Pattern for files that contain directory-local variables.
+It has to be constant to enforce uniform values across different
+environments and users.
+
+Multiple dir-locals files in the same directory are loaded in
+`string<' order.
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defun dir-locals--all-files (file-or-dir)
+ "Return a list of all readable dir-locals files matching FILE-OR-DIR.
+If FILE-OR-DIR is a file pattern, expand wildcards in it and
+return a sorted list of the results. If it is a directory name,
+return a sorted list of all files matching `dir-locals-file' in
+this directory.
+The returned list is sorted by `string<' order."
+ (require 'seq)
+ (let ((default-directory (if (file-directory-p file-or-dir)
+ file-or-dir
+ default-directory)))
+ (seq-filter (lambda (f) (and (file-readable-p f)
+ (file-regular-p f)))
+ (file-expand-wildcards
+ (cond ((not (file-directory-p file-or-dir)) file-or-dir)
+ ((eq system-type 'ms-dos) (dosified-file-name dir-locals-file))
+ (t dir-locals-file))
+ 'full))))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
This function returns either nil (no directory local variables found),
or the matching entry from `dir-locals-directory-cache' (a list),
or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry."
+of no valid cache entry. If `dir-locals-file' contains
+wildcards, then the return value is not a proper filename, it is
+an absolute version of `dir-locals-file' which is guaranteed to
+expand to at least one file."
(setq file (expand-file-name file))
- (let* ((dir-locals-file-name
- (if (eq system-type 'ms-dos)
- (dosified-file-name dir-locals-file)
- dir-locals-file))
- (locals-file (locate-dominating-file file dir-locals-file-name))
- (dir-elt nil))
+ (let* ((locals-dir (locate-dominating-file (file-name-directory file)
+ #'dir-locals--all-files))
+ locals-file dir-elt)
;; `locate-dominating-file' may have abbreviated the name.
- (and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
- ;; Let dir-locals-read-from-file inform us via demoted-errors
- ;; about unreadable files, etc.
- ;; Maybe we'd want to keep searching though - that is
- ;; a locate-dominating-file issue.
-;;; (or (not (file-readable-p locals-file))
-;;; (not (file-regular-p locals-file)))
-;;; (setq locals-file nil))
+ (when locals-dir
+ (setq locals-dir (expand-file-name locals-dir))
+ (setq locals-file (expand-file-name (if (eq system-type 'ms-dos)
+ (dosified-file-name dir-locals-file)
+ dir-locals-file)
+ locals-dir)))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (string-prefix-p (car elt) file
- (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
(if (and dir-elt
- (or (null locals-file)
- (<= (length (file-name-directory locals-file))
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-file (expand-file-name dir-locals-file-name
- (car dir-elt))))
- (and (file-readable-p cached-file)
- (equal (nth 2 dir-elt)
- (nth 5 (file-attributes cached-file))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-file)
+ (or (null locals-dir)
+ (<= (length locals-dir)
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-files (dir-locals--all-files (car dir-elt))))
+ ;; The entry MTIME should match the most recent
+ ;; MTIME among matching files.
+ (and cached-files
+ (= (time-to-seconds (nth 2 dir-elt))
+ (apply #'max (mapcar (lambda (f) (time-to-seconds (nth 5 (file-attributes f))))
+ cached-files))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-file)
;; No cache entry.
locals-file)))
(defun dir-locals-read-from-file (file)
"Load a variables FILE and register a new class and instance.
-FILE is the name of the file holding the variables to apply.
+FILE is the absolute name of the file holding the variables to
+apply. It may contain wildcards.
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
- (with-temp-buffer
+ (require 'map)
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (files (dir-locals--all-files file))
+ (read-circle nil)
+ (success nil)
+ (variables))
(with-demoted-errors "Error reading dir-locals: %S"
- (insert-file-contents file)
- (unless (zerop (buffer-size))
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))))
+ (dolist (file files)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (condition-case-unless-debug nil
+ (setq variables
+ (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
+ variables
+ (read (current-buffer))))
+ (end-of-file nil))))
+ (setq success t))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class
+ dir-name class-name
+ (seconds-to-time
+ (if success
+ (apply #'max (mapcar (lambda (file)
+ (time-to-seconds (nth 5 (file-attributes file))))
+ files))
+ ;; If there was a problem, use the values we could get but
+ ;; don't let the cache prevent future reads.
+ 0)))
+ class-name))
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file
- (or (buffer-file-name) default-directory)))
+ (let ((file-pattern-or-cache (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
- ((stringp variables-file)
- (setq dir-name (file-name-directory variables-file)
- class (dir-locals-read-from-file variables-file)))
- ((consp variables-file)
- (setq dir-name (nth 0 variables-file))
- (setq class (nth 1 variables-file))))
+ ((stringp file-pattern-or-cache)
+ (setq dir-name (file-name-directory file-pattern-or-cache)
+ class (dir-locals-read-from-file file-pattern-or-cache)))
+ ((consp file-pattern-or-cache)
+ (setq dir-name (nth 0 file-pattern-or-cache))
+ (setq class (nth 1 file-pattern-or-cache))))
(when class
(let ((variables
(dir-locals-collect-variables
(defun file-expand-wildcards (pattern &optional full)
"Expand wildcard pattern PATTERN.
This returns a list of file names which match the pattern.
+Files are sorted in `string<' order.
If PATTERN is written as an absolute file name,
the values are absolute also.
(make-obsolete-variable
'window-system-version "it does not give useful information." "24.3")
-;; These variables should trigger redisplay of the current buffer.
-(setq redisplay--variables
+;; Variables which should trigger redisplay of the current buffer.
+(setq redisplay--variables (make-hash-table :test 'eq :size 10))
+(mapc (lambda (var)
+ (puthash var 1 redisplay--variables))
'(line-spacing
overline-margin
line-prefix
- wrap-prefix))
+ wrap-prefix
+ bidi-paragraph-direction
+ bidi-display-reordering))
(provide 'frame)
"\M-\C-e" gnus-summary-expire-articles-now
"\177" gnus-summary-delete-article
[delete] gnus-summary-delete-article
+ [backspace] gnus-summary-delete-article
"m" gnus-summary-move-article
"r" gnus-summary-respool-article
"w" gnus-summary-edit-article
(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."
(buffer-file-name buffer)))
(dir-locals-find-file
(buffer-file-name buffer))))
- (dir-file t))
+ (is-directory nil))
(princ (substitute-command-keys
" This variable's value is directory-local"))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (if (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- (setq file (expand-file-name
- dir-locals-file (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- dir-file nil)))
- (princ (substitute-command-keys
- (if dir-file
- "by the file\n `"
- "for the directory\n `")))
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ (setq file (expand-file-name
+ dir-locals-file (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (princ ".\n")
+ (princ ", set ")
+ (let ((files (file-expand-wildcards file)))
+ (princ (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((cdr files)
+ (setq file (file-name-directory (car files)))
+ (format "by a file\n matching `%s' in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car files))
+ "by the file\n `"))))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
- 'help-args (list variable file)))
+ 'help-args (list variable file))))
(princ (substitute-command-keys "'.\n"))))
(princ (substitute-command-keys
" This variable's value is file-local.\n"))))
A sample format:
- HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f ASCII-TEXT
+ HEX ADDR: 0011 2233 4455 6677 8899 aabb ccdd eeff ASCII-TEXT
-------- ---- ---- ---- ---- ---- ---- ---- ---- ----------------
00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64 This is hexl-mod
00000010: 652e 2020 4561 6368 206c 696e 6520 7265 e. Each line re
(autoload 'character-fold-to-regexp "character-fold")
-(defcustom search-default-regexp-mode nil
+(defcustom search-default-regexp-mode #'character-fold-to-regexp
"Default mode to use when starting isearch.
Value is nil, t, or a function.
;;; Code:
+(require 'map)
+
;; Parameters
(defvar json-object-type 'alist
"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,
+respectively. The function is called with one argument, which is
+the current JSON key.")
+
+(defvar json-post-element-read-function nil
+ "Function called (if non-nil) by `json-read-array' and
+`json-read-object' right after reading a JSON array or object,
+respectively.")
+
\f
;;; Utilities
(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
\f
+;;; Paths
+
+(defvar json--path '()
+ "Used internally by `json-path-to-position' to keep track of
+the path during recursive calls to `json-read'.")
+
+(defun json--record-path (key)
+ "Record the KEY to the current JSON path.
+Used internally by `json-path-to-position'."
+ (push (cons (point) key) json--path))
+
+(defun json--check-position (position)
+ "Check if the last parsed JSON structure passed POSITION.
+Used internally by `json-path-to-position'."
+ (let ((start (caar json--path)))
+ (when (< start position (+ (point) 1))
+ (throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
+ :match-start start
+ :match-end (point)))))
+ (pop json--path))
+
+(defun json-path-to-position (position &optional string)
+ "Return the path to the JSON element at POSITION.
+
+When STRING is provided, return the path to the position in the
+string, else to the position in the current buffer.
+
+The return value is a property list with the following
+properties:
+
+:path -- A list of strings and numbers forming the path to
+ the JSON element at the given position. Strings
+ denote object names, while numbers denote array
+ indexes.
+
+:match-start -- Position where the matched JSON element begins.
+
+:match-end -- Position where the matched JSON element ends.
+
+This can for instance be useful to determine the path to a JSON
+element in a deeply nested structure."
+ (save-excursion
+ (unless string
+ (goto-char (point-min)))
+ (let* ((json--path '())
+ (json-pre-element-read-function #'json--record-path)
+ (json-post-element-read-function
+ (apply-partially #'json--check-position position))
+ (path (catch :json-path
+ (if string
+ (json-read-from-string string)
+ (json-read)))))
+ (when (plist-get path :path)
+ path))))
+
;;; Keywords
(defvar json-keywords '("true" "false" "null")
(if (char-equal (json-peek) ?:)
(json-advance)
(signal 'json-object-format (list ":" (json-peek))))
+ (json-skip-whitespace)
+ (when json-pre-element-read-function
+ (funcall json-pre-element-read-function key))
(setq value (json-read))
+ (when json-post-element-read-function
+ (funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?})
(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
(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.
;; read values until "]"
(let (elements)
(while (not (char-equal (json-peek) ?\]))
+ (json-skip-whitespace)
+ (when json-pre-element-read-function
+ (funcall json-pre-element-read-function (length elements)))
(push (json-read) elements)
+ (when json-post-element-read-function
+ (funcall json-post-element-read-function))
(json-skip-whitespace)
(unless (char-equal (json-peek) ?\])
(if (char-equal (json-peek) ?,)
(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
(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)
(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.
(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)
;; 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)
-;;;; 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.
;;; Code:
(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'xml)
(require 'xsd-regexp)
(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."
;; SOAP WSDL documents use XML Schema to define the types that are part of the
;; message exchange. We include here an XML schema model with a parser and
-;; serializer/deserialiser.
+;; serializer/deserializer.
(defstruct (soap-xs-type (:include soap-element))
id
(defun soap-xs-element-type (element)
"Retrieve the type of ELEMENT.
This is normally stored in the TYPE^ slot, but if this element
-contains a reference, we retrive the type of the reference."
+contains a reference, retrieve the type of the reference."
(if (soap-xs-element-reference element)
(soap-xs-element-type (soap-xs-element-reference element))
(soap-xs-element-type^ element)))
(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)
)
(defun soap-make-wsdl (origin)
- "Create a new WSDL document, loaded from ORIGIN, and intialize it."
+ "Create a new WSDL document, loaded from ORIGIN, and initialize it."
(let ((wsdl (soap-make-wsdl^ :origin origin)))
;; Add the XSD types to the wsdl document
;;;; 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.
-;;;; 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
(insert "\t")
(soap-insert-describe-button type)))
(when (soap-xs-simple-type-enumeration type)
- (insert "\nEnumeraton values: ")
+ (insert "\nEnumeration values: ")
(dolist (e (soap-xs-simple-type-enumeration type))
(insert "\n\t")
(pp e)))
(file-acl . ignore)
(file-attributes . tramp-adb-handle-file-attributes)
(file-directory-p . tramp-adb-handle-file-directory-p)
- ;; `file-equal-p' performed by default handler.
+ (file-equal-p . tramp-handle-file-equal-p)
;; FIXME: This is too sloppy.
(file-executable-p . tramp-handle-file-exists-p)
(file-exists-p . tramp-handle-file-exists-p)
- ;; `file-in-directory-p' performed by default handler.
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-adb-handle-file-name-all-completions)
(file-acl . ignore)
(file-attributes . tramp-gvfs-handle-file-attributes)
(file-directory-p . tramp-gvfs-handle-file-directory-p)
- ;; `file-equal-p' performed by default handler.
+ (file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
- ;; `file-in-directory-p' performed by default handler.
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-gvfs-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-acl . tramp-sh-handle-file-acl)
(file-attributes . tramp-sh-handle-file-attributes)
(file-directory-p . tramp-sh-handle-file-directory-p)
- ;; `file-equal-p' performed by default handler.
+ (file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-sh-handle-file-executable-p)
(file-exists-p . tramp-sh-handle-file-exists-p)
- ;; `file-in-directory-p' performed by default handler.
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-sh-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-sh-handle-file-name-all-completions)
(file-acl . tramp-smb-handle-file-acl)
(file-attributes . tramp-smb-handle-file-attributes)
(file-directory-p . tramp-smb-handle-file-directory-p)
- ;; `file-equal-p' performed by default handler.
+ (file-file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-handle-file-exists-p)
(file-exists-p . tramp-handle-file-exists-p)
- ;; `file-in-directory-p' performed by default handler.
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-smb-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
(and (file-directory-p filename)
(file-readable-p filename)))
+(defun tramp-handle-file-equal-p (filename1 filename2)
+ "Like `file-equalp-p' for Tramp files."
+ ;; Native `file-equalp-p' calls `file-truename', which requires a
+ ;; remote connection. This can be avoided, if FILENAME1 and
+ ;; FILENAME2 are not located on the same remote host.
+ (when (string-equal
+ (file-remote-p (expand-file-name filename1))
+ (file-remote-p (expand-file-name filename2)))
+ (tramp-run-real-handler 'file-equal-p (list filename1 filename2))))
+
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
(not (null (file-attributes filename))))
+(defun tramp-handle-file-in-directory-p (filename directory)
+ "Like `file-in-directory-p' for Tramp files."
+ ;; Native `file-in-directory-p' calls `file-truename', which
+ ;; requires a remote connection. This can be avoided, if FILENAME
+ ;; and DIRECTORY are not located on the same remote host.
+ (when (string-equal
+ (file-remote-p (expand-file-name filename))
+ (file-remote-p (expand-file-name directory)))
+ (tramp-run-real-handler 'file-in-directory-p (list filename directory))))
+
(defun tramp-handle-file-modes (filename)
"Like `file-modes' for Tramp files."
(let ((truename (or (file-truename filename) filename)))
--- /dev/null
+;;; 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
(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
;; 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
;; 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 -
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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
;; 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)))
;; 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)
;; 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
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)
(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
(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.
(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.
;;
;; 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.
\\{emacs-lisp-mode-map}"
:group 'lisp
- (defvar xref-find-function)
- (defvar xref-identifier-completion-table-function)
- (defvar project-search-path-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)
(setq-local electric-pair-text-pairs
(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)
- (setq-local project-search-path-function #'elisp-search-path)
+ (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))
(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.
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)
xrefs))
-(declare-function project-search-path "project")
+(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)
(xref-collect-references symbol dir))
- (project-search-path (project-current))))
+ (let ((pr (project-current t)))
+ (append
+ (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))
(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
(cl-defmethod xref-location-group ((l xref-elisp-location))
(xref-elisp-location-file l))
-(defun elisp-search-path ()
+(defun elisp-library-roots ()
(defvar package-user-dir)
(cons package-user-dir load-path))
(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))
- (project-search-path (project-current))))
+ (let ((pr (project-current t)))
+ (append
+ (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
(with-slots (tag-info) l
(nth 1 tag-info)))
-(defun etags-search-path ()
+(defun etags-library-roots ()
(mapcar #'file-name-directory tags-table-list))
\f
;; This file contains generic infrastructure for dealing with
;; projects, and a number of public functions: finding the current
-;; root, related project directories, search path, etc.
+;; root, related project directories, and library directories. This
+;; list is to be extended in future versions.
;;
-;; The goal is to make it easy for Lisp programs to operate on the
+;; The goal is to make it easier for Lisp programs to operate on the
;; current project, without having to know which package handles
;; detection of that project type, parsing its config files, etc.
(require 'cl-generic)
-(defvar project-find-functions (list #'project-try-vc
- #'project-ask-user)
+(defvar project-find-functions (list #'project-try-vc)
"Special hook to find the project containing a given directory.
Each functions on this hook is called in turn with one
argument (the directory) and should return either nil to mean
that it is not applicable, or a project instance.")
-(declare-function etags-search-path "etags" ())
-
-(defvar project-search-path-function #'etags-search-path
- "Function that returns a list of source root directories.
+;; FIXME: Using the current approach, major modes are supposed to set
+;; this variable to a buffer-local value. So we don't have access to
+;; the "library roots" of language A from buffers of language B, which
+;; seems desirable in multi-language projects, at least for some
+;; potential uses, like "jump to a file in project or library".
+;;
+;; We can add a second argument to this function: a file extension, or
+;; a language name. Some projects will know the set of languages used
+;; in them; for others, like VC-based projects, we'll need
+;; auto-detection. I see two options:
+;;
+;; - That could be implemented as a separate second hook, with a
+;; list of functions that return file extensions.
+;;
+;; - This variable will be turned into a hook with "append" semantics,
+;; and each function in it will perform auto-detection when passed
+;; nil instead of an actual file extension. Then this hook will, in
+;; general, be modified globally, and not from major mode functions.
+(defvar project-library-roots-function 'etags-library-roots
+ "Function that returns a list of library roots.
-The directories in which we can recursively look for the
-declarations or other references to the symbols used in the
-current buffer. Depending on the language, it should include the
-headers search path, load path, class path, or so on.
+It should return a list of directories that contain source files
+related to the current buffer. Depending on the language, it
+should include the headers search path, load path, class path,
+and so on.
-The directory names should be absolute. This variable is
-normally set by the major mode. Used in the default
-implementation of `project-search-path'.")
+The directory names should be absolute. Used in the default
+implementation of `project-library-roots'.")
;;;###autoload
-(defun project-current (&optional dir)
- "Return the project instance in DIR or `default-directory'."
+(defun project-current (&optional maybe-prompt dir)
+ "Return the project instance in DIR or `default-directory'.
+When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
+the user for a different directory to look in."
(unless dir (setq dir default-directory))
+ (let ((pr (project--find-in-directory dir)))
+ (cond
+ (pr)
+ (maybe-prompt
+ (setq dir (read-directory-name "Choose the project directory: " dir nil t)
+ pr (project--find-in-directory dir))
+ (unless pr
+ (user-error "No project found in `%s'" dir))))
+ pr))
+
+(defun project--find-in-directory (dir)
(run-hook-with-args-until-success 'project-find-functions dir))
;; FIXME: Add MODE argument, like in `ede-source-paths'?
-(cl-defgeneric project-search-path (project)
- "Return the list of source root directories.
-Any directory roots where source (or header, etc) files used by
-the current project may be found, inside or outside of the
-current project tree(s). The directory names should be absolute.
-
-Unless it really knows better, a specialized implementation
-should take into account the value returned by
-`project-search-path-function' and call
-`project-prune-directories' on the result."
- (project-prune-directories
- (append
- ;; We don't know the project layout, like where the sources are,
- ;; so we simply include the roots.
- (project-roots project)
- (funcall project-search-path-function))))
+(cl-defgeneric project-library-roots (project)
+ "Return the list of library roots for PROJECT.
+
+It's the list of directories outside of the project that contain
+related source files.
+
+Project-specific version of `project-library-roots-function',
+which see. Unless it knows better, a specialized implementation
+should use the value returned by that function."
+ (project-subtract-directories
+ (project-combine-directories
+ (funcall project-library-roots-function))
+ (project-roots project)))
(cl-defgeneric project-roots (project)
- "Return the list of directory roots related to the current project.
-It should include the current project root, as well as the roots
-of any other currently open projects, if they're meant to be
-edited together. The directory names should be absolute.")
+ "Return the list of directory roots belonging to the current project.
+
+Most often it's just one directory, which contains the project
+file and everything else in the project. But in more advanced
+configurations, a project can span multiple directories.
+
+The rule of thumb for whether to include a directory here, and not
+in `project-library-roots', is whether its contents are meant to
+be edited together with the rest of the project.
+
+The directory names should be absolute.")
(cl-defgeneric project-ignores (_project _dir)
"Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
To root an entry, start it with `./'. To match directories only,
-end it with `/'. DIR must be either one of `project-roots', or
-an element of `project-search-path'."
+end it with `/'. DIR must be one of `project-roots' or
+`project-library-roots'."
(require 'grep)
(defvar grep-find-ignored-files)
(nconc
"Project implementation using the VC package."
:group 'tools)
-(defcustom project-vc-search-path nil
- "List ot directories to include in `project-search-path'.
+(defcustom project-vc-library-roots nil
+ "List ot directories to include in `project-library-roots'.
The file names can be absolute, or relative to the project root."
:type '(repeat file)
:safe 'listp)
(cl-defmethod project-roots ((project (head vc)))
(list (cdr project)))
-(cl-defmethod project-search-path ((project (head vc)))
- (append
- (let ((root (cdr project)))
- (mapcar
- (lambda (dir) (expand-file-name dir root))
- (project--value-in-dir 'project-vc-search-path root)))
- (cl-call-next-method)))
+(cl-defmethod project-library-roots ((project (head vc)))
+ (project-subtract-directories
+ (project-combine-directories
+ (append
+ (let ((root (cdr project)))
+ (mapcar
+ (lambda (dir) (file-name-as-directory (expand-file-name dir root)))
+ (project--value-in-dir 'project-vc-library-roots root)))
+ (funcall project-library-roots-function)))
+ (project-roots project)))
(cl-defmethod project-ignores ((project (head vc)) dir)
(let* ((root (cdr project))
(project--value-in-dir 'project-vc-ignores root)
(cl-call-next-method))))
-(defun project-ask-user (dir)
- (cons 'user (read-directory-name "Project root: " dir nil t)))
-
-(cl-defmethod project-roots ((project (head user)))
- (list (cdr project)))
-
-(defun project-prune-directories (dirs)
- "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
+(defun project-combine-directories (&rest lists-of-dirs)
+ "Return a sorted and culled list of directory names.
+Appends the elements of LISTS-OF-DIRS together, removes
+non-existing directories, as well as directories a parent of
+whose is already in the list."
(let* ((dirs (sort
(mapcar
(lambda (dir)
(file-name-as-directory (expand-file-name dir)))
- dirs)
+ (apply #'append lists-of-dirs))
#'string<))
(ref dirs))
;; Delete subdirectories from the list.
(setq ref (cdr ref))))
(cl-delete-if-not #'file-exists-p dirs)))
+(defun project-subtract-directories (files dirs)
+ "Return a list of elements from FILES that are outside of DIRS.
+DIRS must contain directory names."
+ ;; Sidestep the issue of expanded/abbreviated file names here.
+ (cl-set-difference files dirs :test #'file-in-directory-p))
+
(defun project--value-in-dir (var dir)
(with-temp-buffer
(setq default-directory dir)
(hack-dir-local-variables-non-file-buffer)
(symbol-value var)))
+(declare-function grep-read-files "grep")
+(declare-function xref-collect-matches "xref")
+(declare-function xref--show-xrefs "xref")
+
+;;;###autoload
+(defun project-find-regexp (regexp)
+ "Find all matches for REGEXP in the current project.
+With \\[universal-argument] prefix, you can specify the directory
+to search in, and the file name pattern to search for."
+ (interactive (list (project--read-regexp)))
+ (let* ((pr (project-current t))
+ (dirs (if current-prefix-arg
+ (list (read-directory-name "Base directory: "
+ nil default-directory t))
+ (project-roots pr))))
+ (project--find-regexp-in dirs regexp pr)))
+
+;;;###autoload
+(defun project-or-libraries-find-regexp (regexp)
+ "Find all matches for REGEXP in the current project or libraries.
+With \\[universal-argument] prefix, you can specify the file name
+pattern to search for."
+ (interactive (list (project--read-regexp)))
+ (let* ((pr (project-current t))
+ (dirs (append
+ (project-roots pr)
+ (project-library-roots pr))))
+ (project--find-regexp-in dirs regexp pr)))
+
+(defun project--read-regexp ()
+ (defvar xref-identifier-at-point-function)
+ (require 'xref)
+ (read-regexp "Find regexp"
+ (funcall xref-identifier-at-point-function)))
+
+(defun project--find-regexp-in (dirs regexp project)
+ (require 'grep)
+ (let* ((files (if current-prefix-arg
+ (grep-read-files regexp)
+ "*"))
+ (xrefs (cl-mapcan
+ (lambda (dir)
+ (xref-collect-matches regexp files dir
+ (project-ignores project dir)))
+ dirs)))
+ (unless xrefs
+ (user-error "No matches for: %s" regexp))
+ (xref--show-xrefs xrefs nil)))
+
(provide 'project)
;;; project.el ends here
;;
;; 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.")
`(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:
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
(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
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:
;;
(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)
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
(verilog-no-change-functions t)
- before-change-functions
- after-change-functions
+ before-change-functions ; XEmacs ignores inhibit-modification-hooks
+ after-change-functions ; XEmacs ignores inhibit-modification-hooks
deactivate-mark
buffer-file-name ; Prevent primitives checking
buffer-file-truename) ; for file modification
(progn ,@body)
(and (not modified)
(buffer-modified-p)
- (set-buffer-modified-p nil)))))
+ (verilog-restore-buffer-modified-p nil)))))
-(defmacro verilog-save-no-change-functions (&rest body)
- "Execute BODY forms, disabling all change hooks in BODY.
-For insignificant changes, see instead `verilog-save-buffer-state'."
- `(let* ((inhibit-point-motion-hooks t)
- (verilog-no-change-functions t)
- before-change-functions
- after-change-functions)
- (progn ,@body)))
(defvar verilog-save-font-mod-hooked nil
- "Local variable when inside a `verilog-save-font-mods' block.")
+ "Local variable when inside a `verilog-save-font-no-change-functions' block.")
(make-variable-buffer-local 'verilog-save-font-mod-hooked)
-(defmacro verilog-save-font-mods (&rest body)
- "Execute BODY forms, disabling text modifications to allow performing BODY.
+(defmacro verilog-save-font-no-change-functions (&rest body)
+ "Execute BODY forms, disabling all change hooks in BODY.
Includes temporary disabling of `font-lock' to restore the buffer
to full text form for parsing. Additional actions may be specified with
-`verilog-before-save-font-hook' and `verilog-after-save-font-hook'."
- ;; Before version 20, match-string with font-lock returns a
- ;; vector that is not equal to the string. IE if on "input"
- ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
- `(let* ((hooked (unless verilog-save-font-mod-hooked
- (verilog-run-hooks 'verilog-before-save-font-hook)
- t))
- (verilog-save-font-mod-hooked t)
- (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode)
- (font-lock-mode 0)
- t)))
- (unwind-protect
- (progn ,@body)
- ;; Unwind forms
- (when fontlocked (font-lock-mode t))
- (when hooked (verilog-run-hooks 'verilog-after-save-font-hook)))))
+`verilog-before-save-font-hook' and `verilog-after-save-font-hook'.
+For insignificant changes, see instead `verilog-save-buffer-state'."
+ `(if verilog-save-font-mod-hooked ; A recursive call?
+ (progn ,@body)
+ ;; Before version 20, match-string with font-lock returns a
+ ;; vector that is not equal to the string. IE if on "input"
+ ;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
+ ;; Therefore we must remove and restore font-lock mode
+ (verilog-run-hooks 'verilog-before-save-font-hook)
+ (let* ((verilog-save-font-mod-hooked (- (point-max) (point-min)))
+ (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-mode 0)
+ t)))
+ (run-hook-with-args 'before-change-functions (point-min) (point-max))
+ (unwind-protect
+ ;; Must inhibit and restore hooks before restoring font-lock
+ (let* ((inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ (verilog-no-change-functions t)
+ before-change-functions ; XEmacs ignores inhibit-modification-hooks
+ after-change-functions) ; XEmacs ignores inhibit-modification-hooks
+ (progn ,@body))
+ ;; Unwind forms
+ (run-hook-with-args 'after-change-functions (point-min) (point-max)
+ verilog-save-font-mod-hooked) ; old length
+ (when fontlocked (font-lock-mode t))
+ (verilog-run-hooks 'verilog-after-save-font-hook)))))
;;
;; Comment detection and caching
(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"))
(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
(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)
(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)))
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"))
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
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"))
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)
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)
"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))
;;
(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)
(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.
(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-*\\.[^(]*(")
(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
(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
(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)
(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 ")")
((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
(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.
(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.
(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)))))
\f
;;; Auto inject:
;;
;; 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))))
(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)))
;; 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-")))
;; 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
(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
(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
(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")
(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
(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
+ )))))
\f
;;; Skeletons:
;;
;; 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
;; 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:
"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:
(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))
(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))
\f
;;; 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.
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.")
+
\f
;;; misc utilities
(defun xref--alistify (list key test)
(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."
(defvar-local xref--display-history nil
"List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
-(defvar-local xref--temporary-buffers nil
- "List of buffers created by xref code.")
-
-(defvar-local xref--current nil
- "Non-nil if this buffer was once current, except while displaying xrefs.
-Used for temporary buffers.")
-
-(defvar xref--inhibit-mark-current nil)
-
-(defun xref--mark-selected ()
- (unless xref--inhibit-mark-current
- (setq xref--current t))
- (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
-
(defun xref--save-to-history (buf win)
(let ((restore (window-parameter win 'quit-restore)))
;; Save the new entry if the window displayed another buffer
(defun xref--show-location (location)
(condition-case err
- (let ((bl (buffer-list))
- (xref--inhibit-mark-current t)
- (marker (xref-location-marker location)))
- (let ((buf (marker-buffer marker)))
- (unless (memq buf bl)
- ;; Newly created.
- (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
- (push buf xref--temporary-buffers))
- (xref--display-position marker t buf)))
+ (let* ((marker (xref-location-marker location))
+ (buf (marker-buffer marker)))
+ (xref--display-position marker t buf))
(user-error (message (error-message-string err)))))
(defun xref-show-location-at-point ()
(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'
(defun xref-quit (&optional kill)
"Bury temporarily displayed buffers, then quit the current window.
-If KILL is non-nil, kill all buffers that were created in the
-process of showing xrefs, and also kill the current buffer.
+If KILL is non-nil, also kill the current buffer.
The buffers that the user has otherwise interacted with in the
meantime are preserved."
(when (and (window-live-p win)
(eq buf (window-buffer win)))
(quit-window nil win)))
- (when kill
- (let ((xref--inhibit-mark-current t)
- kill-buffer-query-functions)
- (dolist (buf xref--temporary-buffers)
- (unless (buffer-local-value 'xref--current buf)
- (kill-buffer buf)))
- (setq xref--temporary-buffers nil)))
(quit-window kill window)))
(defconst xref-buffer-name "*xref*"
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(setq xref--window (assoc-default 'window alist))
- (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
- (dolist (buf xref--temporary-buffers)
- (with-current-buffer buf
- (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
(current-buffer)))))
\f
;; This part of the UI seems fairly uncontroversial: it reads the
;; identifier and deals with the single definition case.
+;; (FIXME: do we really want this case to be handled like that in
+;; "find references" and "find regexp searches"?)
;;
;; The controversial multiple definitions case is handed off to
;; xref-show-xrefs-function.
(defvar xref--read-pattern-history nil)
-(defun xref--show-xrefs (input kind arg window)
- (let* ((bl (buffer-list))
- (xrefs (funcall xref-find-function kind arg))
- (tb (cl-set-difference (buffer-list) bl)))
- (cond
- ((null xrefs)
- (user-error "No %s found for: %s" (symbol-name kind) input))
- ((not (cdr xrefs))
- (xref-push-marker-stack)
- (xref--pop-to-location (car xrefs) window))
- (t
- (xref-push-marker-stack)
- (funcall xref-show-xrefs-function xrefs
- `((window . ,window)
- (temporary-buffers . ,tb)))))))
+(defun xref--show-xrefs (xrefs window)
+ (cond
+ ((not (cdr xrefs))
+ (xref-push-marker-stack)
+ (xref--pop-to-location (car xrefs) window))
+ (t
+ (xref-push-marker-stack)
+ (funcall xref-show-xrefs-function xrefs
+ `((window . ,window))))))
(defun xref--prompt-p (command)
(or (eq xref-prompt-for-identifier t)
(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))
"[ :]+\\'" 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))))
\f
;;; Commands
+(defun xref--find-xrefs (input kind arg window)
+ (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)))
+
(defun xref--find-definitions (id window)
- (xref--show-xrefs id 'definitions id window))
+ (xref--find-xrefs id 'definitions id window))
;;;###autoload
(defun xref-find-definitions (identifier)
"Find references to the identifier at point.
With prefix argument, prompt for the identifier."
(interactive (list (xref--read-identifier "Find references of: ")))
- (xref--show-xrefs identifier 'references identifier nil))
-
-;; TODO: Rename and move to project-find-regexp, as soon as idiomatic
-;; usage of xref from other packages has stabilized.
-;;;###autoload
-(defun xref-find-regexp (regexp)
- "Find all matches for REGEXP.
-With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for."
- (interactive (list (xref--read-identifier "Find regexp: ")))
- (require 'grep)
- (let* ((proj (project-current))
- (files (if current-prefix-arg
- (grep-read-files regexp)
- "*"))
- (dirs (if current-prefix-arg
- (list (read-directory-name "Base directory: "
- nil default-directory t))
- (project-prune-directories
- (append
- (project-roots proj)
- (project-search-path proj)))))
- (xref-find-function
- (lambda (_kind regexp)
- (cl-mapcan
- (lambda (dir)
- (xref-collect-matches regexp files dir
- (project-ignores proj dir)))
- dirs))))
- (xref--show-xrefs regexp 'matches regexp nil)))
+ (xref--find-xrefs identifier 'references identifier nil))
(declare-function apropos-parse-pattern "apropos" (pattern))
"Search for pattern (word list or regexp): "
nil 'xref--read-pattern-history)))
(require 'apropos)
- (xref--show-xrefs pattern 'apropos
+ (xref--find-xrefs pattern 'apropos
(apropos-parse-pattern
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
: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")
-(declare-function grep-read-files "grep")
(declare-function grep-expand-template "grep")
(defun xref-collect-references (symbol dir)
(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)))))
(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)))))
(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))))
(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)
(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.")
#'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)))
(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)
(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)
(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.
(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.
(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)
;; 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))
(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)
(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))
(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))
(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))
(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)
(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)
(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:
;; 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.
"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
(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,
'(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
(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
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
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)))
;; 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))))
(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))))
"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)
;; elisp function to remerge from the .BASE/OTHER/THIS files.
(smerge-start-session)
(add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
- (message "There are unresolved conflicts in this file")))
+ (vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-bzr-version-dirstate (dir)
"Try to return as a string the bzr revision ID of directory DIR.
(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)
(smerge-start-session)
(when vc-git-resolve-conflicts
(add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local))
- (message "There are unresolved conflicts in this file")))
+ (vc-message-unresolved-conflicts buffer-file-name)))
;;; HISTORY FUNCTIONS
(vc-file-setprop buffer-file-name 'vc-state 'conflict)
(smerge-start-session)
(add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t)
- (message "There are unresolved conflicts in this file")))
+ (vc-message-unresolved-conflicts buffer-file-name)))
;; Modeled after the similar function in vc-bzr.el
;; use conflict markers in which case we don't really know what to do.
;; So let's just punt for now.
nil)
- (message "There are unresolved conflicts in this file")))
+ (vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-svn-parse-status (&optional filename)
"Parse output of \"svn status\" command in the current buffer.
(lambda (str)
;; Commented or empty lines.
(string-match-p "\\`\\(?:#\\|[ \t\r\n]*\\'\\)" str))
- (vc--read-lines
- (vc-call-backend backend 'find-ignore-file file))))
+ (let ((file (vc-call-backend backend 'find-ignore-file file)))
+ (and (file-exists-p file)
+ (vc--read-lines file)))))
(defun vc--read-lines (file)
"Return a list of lines of FILE."
(smerge-mode 1)
(message "File contains conflicts.")))
+;;;###autoload
+(defun vc-message-unresolved-conflicts (filename)
+ "Display a message indicating unresolved conflicts in FILENAME."
+ ;; This enables all VC backends to give a standard, recognizable
+ ;; conflict message that indicates which file is conflicted.
+ (message "There are unresolved conflicts in %s" filename))
+
;;;###autoload
(defalias 'vc-resolve-conflicts 'smerge-ediff)
/^#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/
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@
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
eassert (0 <= nitems && 0 < item_size);
- if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
+ ptrdiff_t nbytes;
+ if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
memory_full (SIZE_MAX);
- return xmalloc (nitems * item_size);
+ return xmalloc (nbytes);
}
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
eassert (0 <= nitems && 0 < item_size);
- if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
+ ptrdiff_t nbytes;
+ if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
memory_full (SIZE_MAX);
- return xrealloc (pa, nitems * item_size);
+ return xrealloc (pa, nbytes);
}
xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
ptrdiff_t nitems_max, ptrdiff_t item_size)
{
+ ptrdiff_t n0 = *nitems;
+ eassume (0 < item_size && 0 < nitems_incr_min && 0 <= n0 && -1 <= nitems_max);
+
/* The approximate size to use for initial small allocation
requests. This is the largest "small" request for the GNU C
library malloc. */
enum { DEFAULT_MXFAST = 64 * sizeof (size_t) / 4 };
/* If the array is tiny, grow it to about (but no greater than)
- DEFAULT_MXFAST bytes. Otherwise, grow it by about 50%. */
- ptrdiff_t n = *nitems;
- ptrdiff_t tiny_max = DEFAULT_MXFAST / item_size - n;
- ptrdiff_t half_again = n >> 1;
- ptrdiff_t incr_estimate = max (tiny_max, half_again);
-
- /* Adjust the increment according to three constraints: NITEMS_INCR_MIN,
+ DEFAULT_MXFAST bytes. Otherwise, grow it by about 50%.
+ Adjust the growth according to three constraints: NITEMS_INCR_MIN,
NITEMS_MAX, and what the C language can represent safely. */
- ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / item_size;
- ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
- ? nitems_max : C_language_max);
- ptrdiff_t nitems_incr_max = n_max - n;
- ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
- eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+ ptrdiff_t n, nbytes;
+ if (INT_ADD_WRAPV (n0, n0 >> 1, &n))
+ n = PTRDIFF_MAX;
+ if (0 <= nitems_max && nitems_max < n)
+ n = nitems_max;
+
+ ptrdiff_t adjusted_nbytes
+ = ((INT_MULTIPLY_WRAPV (n, item_size, &nbytes) || SIZE_MAX < nbytes)
+ ? min (PTRDIFF_MAX, SIZE_MAX)
+ : nbytes < DEFAULT_MXFAST ? DEFAULT_MXFAST : 0);
+ if (adjusted_nbytes)
+ {
+ n = adjusted_nbytes / item_size;
+ nbytes = adjusted_nbytes - adjusted_nbytes % item_size;
+ }
+
if (! pa)
*nitems = 0;
- if (nitems_incr_max < incr)
+ if (n - n0 < nitems_incr_min
+ && (INT_ADD_WRAPV (n0, nitems_incr_min, &n)
+ || (0 <= nitems_max && nitems_max < n)
+ || INT_MULTIPLY_WRAPV (n, item_size, &nbytes)))
memory_full (SIZE_MAX);
- n += incr;
- pa = xrealloc (pa, n * item_size);
+ pa = xrealloc (pa, nbytes);
*nitems = n;
return pa;
}
EMACS_INT string_len = XINT (length);
unsigned char *p, *beg, *end;
- if (string_len > STRING_BYTES_MAX / len)
+ if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
string_overflow ();
- nbytes = len * string_len;
val = make_uninit_multibyte_string (string_len, nbytes);
for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
{
are not marked too. But we must be sure that nothing is
marked within OBJ before we really drop it. */
for (i = 0; i < size; i++)
- if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i))))
- break;
+ {
+ Lisp_Object objlist;
+
+ if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i))))
+ break;
+
+ objlist = AREF (AREF (XCDR (obj), i), FONT_OBJLIST_INDEX);
+ for (; CONSP (objlist); objlist = XCDR (objlist))
+ {
+ Lisp_Object val = XCAR (objlist);
+ struct font *font = XFONT_OBJECT (val);
+
+ if (!NILP (AREF (val, FONT_TYPE_INDEX))
+ && VECTOR_MARKED_P(font))
+ break;
+ }
+ if (CONSP (objlist))
+ {
+ /* Found a marked font, bail out. */
+ break;
+ }
+ }
if (i == size)
- drop = 1;
+ {
+ /* No marked fonts were found, so this entire font
+ entity can be dropped. */
+ drop = 1;
+ }
}
if (drop)
*prev = XCDR (tail);
else
nbytes = SBYTES (str);
- if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
+ if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
memory_full (SIZE_MAX);
- ssl->bytes += nbytes;
+ ssl->bytes = nbytes;
if (STRINGP (str2))
{
else
nbytes = SBYTES (str2);
- if (INT_ADD_OVERFLOW (ssl->bytes, nbytes))
+ if (INT_ADD_WRAPV (ssl->bytes, nbytes, &nbytes))
memory_full (SIZE_MAX);
- ssl->bytes += nbytes;
+ ssl->bytes = nbytes;
}
}
unsigned char *p;
ptrdiff_t total;
- if (INT_ADD_OVERFLOW (overlay_heads.bytes, overlay_tails.bytes))
+ if (INT_ADD_WRAPV (overlay_heads.bytes, overlay_tails.bytes, &total))
memory_full (SIZE_MAX);
- total = overlay_heads.bytes + overlay_tails.bytes;
if (total > overlay_str_len)
overlay_str_buf = xpalloc (overlay_str_buf, &overlay_str_len,
total - overlay_str_len, -1, 1);
ptrdiff_t i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
- ptrdiff_t o_size = (size < STRING_BYTES_BOUND / MAX_MULTIBYTE_LENGTH
- ? size * MAX_MULTIBYTE_LENGTH
- : STRING_BYTES_BOUND);
+ ptrdiff_t o_size;
+ if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &o_size))
+ o_size = PTRDIFF_MAX;
unsigned char *dst = SAFE_ALLOCA (o_size);
unsigned char *o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
- if (o_size - (o - dst) < MAX_MULTIBYTE_LENGTH)
+ if (o_size - MAX_MULTIBYTE_LENGTH < o - dst)
string_overflow ();
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
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;
}
}
buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1;
-
- if ((min (PTRDIFF_MAX, SIZE_MAX) - 256) / buf_magnification < str_bytes)
+ outbufsize = str_bytes;
+ if (INT_MULTIPLY_WRAPV (buf_magnification, outbufsize, &outbufsize)
+ || INT_ADD_WRAPV (256, outbufsize, &outbufsize))
memory_full (SIZE_MAX);
- outbufsize = (ccl.buf_magnification
- ? str_bytes * ccl.buf_magnification + 256
- : str_bytes + 256);
outp = outbuf = xmalloc (outbufsize);
consumed_chars = consumed_bytes = 0;
/* At first, see the document in `character.h' to understand the code
in this file. */
-#ifdef emacs
#include <config.h>
-#endif
#include <stdio.h>
-#ifdef emacs
-
#include <sys/types.h>
#include <intprops.h>
#include "lisp.h"
#include "composite.h"
#include "disptab.h"
-#else /* not emacs */
-
-#include "mulelib.h"
-
-#endif /* emacs */
-
/* Char-table of information about which character to unify to which
Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
Lisp_Object Vchar_unify_table;
if (CHARACTERP (ch))
{
int w = CHAR_WIDTH (XFASTINT (ch));
- if (INT_ADD_OVERFLOW (width, w))
+ if (INT_ADD_WRAPV (width, w, &width))
string_overflow ();
- width += w;
}
}
}
int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
ptrdiff_t thiswidth = char_width (c, dp);
- if (precision <= 0)
- {
- if (INT_ADD_OVERFLOW (width, thiswidth))
- string_overflow ();
- }
- else if (precision - width < thiswidth)
+ if (0 < precision && precision - width < thiswidth)
{
*nchars = i;
*nbytes = i_byte;
return width;
}
+ if (INT_ADD_WRAPV (thiswidth, width, &width))
+ string_overflow ();
i++;
i_byte += bytes;
- width += thiswidth;
}
if (precision > 0)
thiswidth = char_width (c, dp);
}
- if (precision <= 0)
- {
-#ifdef emacs
- if (INT_ADD_OVERFLOW (width, thiswidth))
- string_overflow ();
-#endif
- }
- else if (precision - width < thiswidth)
+ if (0 < precision && precision - width < thiswidth)
{
*nchars = i;
*nbytes = i_byte;
return width;
}
+ if (INT_ADD_WRAPV (thiswidth, width, &width))
+ string_overflow ();
i += chars;
i_byte += bytes;
- width += thiswidth;
}
if (precision > 0)
for (bytes = 0; str < endp; str++)
{
int n = *str < 0x80 ? 1 : 2;
- if (INT_ADD_OVERFLOW (bytes, n))
+ if (INT_ADD_WRAPV (bytes, n, &bytes))
string_overflow ();
- bytes += n;
}
return bytes;
}
ptrdiff_t nbytes = SBYTES (string);
bool multibyte = STRING_MULTIBYTE (string);
ptrdiff_t byte8_count;
+ ptrdiff_t thrice_byte8_count, uninit_nchars, uninit_nbytes;
const unsigned char *src, *src_end;
unsigned char *dst;
Lisp_Object val;
if (byte8_count == 0)
return string;
+ if (INT_MULTIPLY_WRAPV (byte8_count, 3, &thrice_byte8_count))
+ string_overflow ();
+
if (multibyte)
{
- if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count
- || (STRING_BYTES_BOUND - nbytes) / 2 < byte8_count)
- string_overflow ();
-
/* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
- val = make_uninit_multibyte_string (nchars + byte8_count * 3,
- nbytes + byte8_count * 2);
+ if (INT_ADD_WRAPV (nchars, thrice_byte8_count, &uninit_nchars)
+ || INT_ADD_WRAPV (nbytes, 2 * byte8_count, &uninit_nbytes))
+ string_overflow ();
+ val = make_uninit_multibyte_string (uninit_nchars, uninit_nbytes);
}
else
{
- if ((STRING_BYTES_BOUND - nbytes) / 3 < byte8_count)
- string_overflow ();
-
/* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
- val = make_uninit_string (nbytes + byte8_count * 3);
+ if (INT_ADD_WRAPV (thrice_byte8_count, nbytes, &uninit_nbytes))
+ string_overflow ();
+ val = make_uninit_string (uninit_nbytes);
}
src = SDATA (string);
return make_number (c);
}
-#ifdef emacs
-
/* Return true if C is an alphabetic character. */
bool
alphabeticp (int c)
/* The correct char-table is setup in characters.el. */
Vunicode_category_table = Qnil;
}
-
-#endif /* emacs */
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).
CHECK_NUMBER (n);
if (eabs (XINT (n)) < 2)
- remove_excessive_undo_boundaries ();
+ call0 (Qundo_auto__amalgamate);
pos = PT + XINT (n);
if (NILP (killflag))
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;
}
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. */
{
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");
static void
coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes)
{
- if (STRING_BYTES_BOUND - coding->dst_bytes < bytes)
+ ptrdiff_t newbytes;
+ if (INT_ADD_WRAPV (coding->dst_bytes, bytes, &newbytes)
+ || SIZE_MAX < newbytes)
string_overflow ();
- coding->destination = xrealloc (coding->destination,
- coding->dst_bytes + bytes);
- coding->dst_bytes += bytes;
+ coding->destination = xrealloc (coding->destination, newbytes);
+ coding->dst_bytes = newbytes;
}
static void
if ((dst_end - dst) / MAX_MULTIBYTE_LENGTH < to_nchars)
{
eassert (growable_destination (coding));
- if (((min (PTRDIFF_MAX, SIZE_MAX) - (buf_end - buf))
- / MAX_MULTIBYTE_LENGTH)
- < to_nchars)
+ ptrdiff_t dst_size;
+ if (INT_MULTIPLY_WRAPV (to_nchars, MAX_MULTIBYTE_LENGTH,
+ &dst_size)
+ || INT_ADD_WRAPV (buf_end - buf, dst_size, &dst_size))
memory_full (SIZE_MAX);
- dst = alloc_destination (coding,
- buf_end - buf
- + MAX_MULTIBYTE_LENGTH * to_nchars,
- dst);
+ dst = alloc_destination (coding, dst_size, dst);
if (EQ (coding->src_object, coding->dst_object))
{
coding_set_source (coding);
return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
\f
+/* Convert the integer I to a cons-of-integers, where I is not in
+ fixnum range. */
+
+#define INTBIG_TO_LISP(i, extremum) \
+ (eassert (FIXNUM_OVERFLOW_P (i)), \
+ (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16)) \
+ ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
+ : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
+ ? Fcons (make_number ((i) >> 16 >> 24), \
+ Fcons (make_number ((i) >> 16 & 0xffffff), \
+ make_number ((i) & 0xffff))) \
+ : make_float (i)))
+
+Lisp_Object
+intbig_to_lisp (intmax_t i)
+{
+ return INTBIG_TO_LISP (i, INTMAX_MIN);
+}
+
+Lisp_Object
+uintbig_to_lisp (uintmax_t i)
+{
+ return INTBIG_TO_LISP (i, UINTMAX_MAX);
+}
+
/* Convert the cons-of-integers, integer, or float value C to an
unsigned value with maximum value MAX. Signal an error if C does not
have a valid format or is out of range. */
switch (code)
{
case Aadd:
- if (INT_ADD_OVERFLOW (accum, next))
- {
- overflow = 1;
- accum &= INTMASK;
- }
- accum += next;
+ overflow |= INT_ADD_WRAPV (accum, next, &accum);
break;
case Asub:
- if (INT_SUBTRACT_OVERFLOW (accum, next))
- {
- overflow = 1;
- accum &= INTMASK;
- }
- accum = argnum ? accum - next : nargs == 1 ? - next : next;
+ if (! argnum)
+ accum = nargs == 1 ? - next : next;
+ else
+ overflow |= INT_SUBTRACT_WRAPV (accum, next, &accum);
break;
case Amult:
- if (INT_MULTIPLY_OVERFLOW (accum, next))
- {
- EMACS_UINT a = accum, b = next, ab = a * b;
- overflow = 1;
- accum = ab & INTMASK;
- }
- else
- accum *= next;
+ overflow |= INT_MULTIPLY_WRAPV (accum, next, &accum);
break;
case Adiv:
if (! (argnum || nargs == 1))
{
if (next == 0)
xsignal0 (Qarith_error);
- accum /= next;
+ if (INT_DIVIDE_OVERFLOW (accum, next))
+ overflow = true;
+ else
+ accum /= next;
}
break;
case Alogand:
|| matrix_dim.width != pool->ncolumns);
/* Enlarge the glyph pool. */
- needed = matrix_dim.width;
- if (INT_MULTIPLY_OVERFLOW (needed, matrix_dim.height))
+ if (INT_MULTIPLY_WRAPV (matrix_dim.height, matrix_dim.width, &needed))
memory_full (SIZE_MAX);
- needed *= matrix_dim.height;
if (needed > pool->nglyphs)
{
ptrdiff_t old_nglyphs = pool->nglyphs;
struct frame *sf = SELECTED_FRAME ();
int width = FRAME_TOTAL_COLS (sf);
int height = FRAME_TOTAL_LINES (sf);
+ int area;
/* If these sizes are so big they cause overflow, just ignore the
change. It's not clear what better we could do. The rest of
the code assumes that (width + 2) * height * sizeof (struct glyph)
does not overflow and does not exceed PTRDIFF_MAX or SIZE_MAX. */
- if (INT_ADD_OVERFLOW (width, 2)
- || INT_MULTIPLY_OVERFLOW (width + 2, height)
- || (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct glyph)
- < (width + 2) * height))
+ if (INT_ADD_WRAPV (width, 2, &area)
+ || INT_MULTIPLY_WRAPV (height, area, &area)
+ || min (PTRDIFF_MAX, SIZE_MAX) / sizeof (struct glyph) < area)
fatal ("screen size %dx%d too big", width, height);
}
ptrdiff_t formatlen = SBYTES (args[0]);
/* Allocate the info and discarded tables. */
- if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs)
+ ptrdiff_t alloca_size;
+ if (INT_MULTIPLY_WRAPV (nargs, sizeof *info, &alloca_size)
+ || INT_ADD_WRAPV (sizeof *info, alloca_size, &alloca_size)
+ || INT_ADD_WRAPV (formatlen, alloca_size, &alloca_size)
+ || SIZE_MAX < alloca_size)
memory_full (SIZE_MAX);
- size_t alloca_size = (nargs + 1) * sizeof *info + formatlen;
/* info[0] is unused. Unused elements have -1 for start. */
info = SAFE_ALLOCA (alloca_size);
memset (info, 0, alloca_size);
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (charval, str);
ptrdiff_t size_byte = SBYTES (array);
+ ptrdiff_t product;
- if (INT_MULTIPLY_OVERFLOW (SCHARS (array), len)
- || SCHARS (array) * len != size_byte)
+ if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
error ("Attempt to change byte length of a string");
for (idx = 0; idx < size_byte; idx++)
*p++ = str[idx % len];
{
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);
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)
{
break;
c = LGLYPH_CHAR (g);
if (CHAR_VARIATION_SELECTOR_P (c))
- with_variation_selector = 1;
+ with_variation_selector = true;
}
len = i;
}
}
- if (INT_MAX / 2 < len)
- memory_full (SIZE_MAX);
-
- if (gstring.allocated == 0)
- {
- gstring.glyph_size = sizeof (MFLTGlyphFT);
- gstring.glyphs = xnmalloc (len * 2, sizeof (MFLTGlyphFT));
- gstring.allocated = len * 2;
- }
- else if (gstring.allocated < len * 2)
- {
- gstring.glyphs = xnrealloc (gstring.glyphs, len * 2,
- sizeof (MFLTGlyphFT));
- gstring.allocated = len * 2;
- }
- 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);
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;
- if (INT_MAX / 2 < gstring.allocated)
- memory_full (SIZE_MAX);
- gstring.glyphs = xnrealloc (gstring.glyphs,
- gstring.allocated, 2 * sizeof (MFLTGlyphFT));
- gstring.allocated *= 2;
+
+ 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++)
gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
{
ptrdiff_t prefix_length = strlen (prefix);
- if ((STRING_BYTES_BOUND - prefix_length) / 3 < buf_size)
+ ptrdiff_t retlen;
+ if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen)
+ || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen))
string_overflow ();
- Lisp_Object ret = make_uninit_string (prefix_length + 3 * buf_size
- - (buf_size != 0));
+ Lisp_Object ret = make_uninit_string (retlen);
char *string = SSDATA (ret);
strcpy (string, prefix);
if (cp) g_free (cp);
len = strlen (str);
- if ((min (PTRDIFF_MAX, SIZE_MAX) - len - 1) / 4 < nr_bad)
+ ptrdiff_t alloc;
+ if (INT_MULTIPLY_WRAPV (nr_bad, 4, &alloc)
+ || INT_ADD_WRAPV (len + 1, alloc, &alloc)
+ || SIZE_MAX < alloc)
memory_full (SIZE_MAX);
- up = utf8_str = xmalloc (len + nr_bad * 4 + 1);
+ up = utf8_str = xmalloc (alloc);
p = (unsigned char *)str;
while (! (cp = g_locale_to_utf8 ((char *)p, -1, &bytes_read,
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)
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;
}
int x, y;
XColor *colors, *p;
XImagePtr_or_DC ximg;
+ ptrdiff_t nbytes;
#ifdef HAVE_NTGUI
HGDIOBJ prev;
#endif /* HAVE_NTGUI */
- if (img->height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *colors / img->width)
+ if (INT_MULTIPLY_WRAPV (sizeof *colors, img->width, &nbytes)
+ || INT_MULTIPLY_WRAPV (img->height, nbytes, &nbytes)
+ || SIZE_MAX < nbytes)
memory_full (SIZE_MAX);
- colors = xmalloc (sizeof *colors * img->width * img->height);
+ colors = xmalloc (nbytes);
/* Get the X image or create a memory device context for IMG. */
ximg = image_get_x_image_or_dc (f, img, 0, &prev);
XColor *colors = x_to_xcolors (f, img, 1);
XColor *new, *p;
int x, y, i, sum;
+ ptrdiff_t nbytes;
for (i = sum = 0; i < 9; ++i)
sum += eabs (matrix[i]);
#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
- if (img->height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *new / img->width)
+ if (INT_MULTIPLY_WRAPV (sizeof *new, img->width, &nbytes)
+ || INT_MULTIPLY_WRAPV (img->height, nbytes, &nbytes))
memory_full (SIZE_MAX);
- new = xmalloc (sizeof *new * img->width * img->height);
+ new = xmalloc (nbytes);
for (y = 0; y < img->height; ++y)
{
png_uint_32 row_bytes;
bool transparent_p;
struct png_memory_storage tbr; /* Data to be read */
+ ptrdiff_t nbytes;
#ifdef USE_CAIRO
unsigned char *data = 0;
row_bytes = png_get_rowbytes (png_ptr, info_ptr);
/* Allocate memory for the image. */
- if (height > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *rows
- || row_bytes > min (PTRDIFF_MAX, SIZE_MAX) / sizeof *pixels / height)
+ if (INT_MULTIPLY_WRAPV (row_bytes, sizeof *pixels, &nbytes)
+ || INT_MULTIPLY_WRAPV (nbytes, height, &nbytes))
memory_full (SIZE_MAX);
- c->pixels = pixels = xmalloc (sizeof *pixels * row_bytes * height);
+ c->pixels = pixels = xmalloc (nbytes);
c->rows = rows = xmalloc (height * sizeof *rows);
for (i = 0; i < height; ++i)
rows[i] = pixels + i * row_bytes;
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)
{
}
#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
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");
XSETCDR (elt, def);
return def;
}
- else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ else if (CONSP (idx)
+ && CHARACTERP (XCAR (idx))
+ && CHARACTERP (XCAR (elt)))
{
int from = XFASTINT (XCAR (idx));
int to = XFASTINT (XCDR (idx));
size += XINT (Flength (prefix));
/* This has one extra element at the end that we don't pass to Fconcat. */
- if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size)
+ EMACS_INT size4;
+ if (INT_MULTIPLY_WRAPV (size, 4, &size4))
memory_full (SIZE_MAX);
- SAFE_ALLOCA_LISP (args, size * 4);
+ SAFE_ALLOCA_LISP (args, size4);
/* In effect, this computes
(mapconcat 'single-key-description keys " ")
#define INTEGER_TO_CONS(i) \
(! FIXNUM_OVERFLOW_P (i) \
? make_number (i) \
- : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \
- || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \
- && FIXNUM_OVERFLOW_P ((i) >> 16)) \
- ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
- : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \
- || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \
- && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
- ? Fcons (make_number ((i) >> 16 >> 24), \
- Fcons (make_number ((i) >> 16 & 0xffffff), \
- make_number ((i) & 0xffff))) \
- : make_float (i))
+ : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i))
+extern Lisp_Object intbig_to_lisp (intmax_t);
+extern Lisp_Object uintbig_to_lisp (uintmax_t);
/* Convert the Emacs representation CONS back to an integer of type
TYPE, storing the result the variable VAR. Signal an error if CONS
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;
} \
} while (false)
-
-/* Return floor (NBYTES / WORD_SIZE). */
-
-INLINE ptrdiff_t
-lisp_word_count (ptrdiff_t nbytes)
-{
- if (-1 >> 1 == -1)
- switch (word_size + 0)
- {
- case 2: return nbytes >> 1;
- case 4: return nbytes >> 2;
- case 8: return nbytes >> 3;
- case 16: return nbytes >> 4;
- default: break;
- }
- return nbytes / word_size - (nbytes % word_size < 0);
-}
-
/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
#define SAFE_ALLOCA_LISP(buf, nelt) \
do { \
- if ((nelt) <= lisp_word_count (sa_avail)) \
- (buf) = AVAIL_ALLOCA ((nelt) * word_size); \
- else if ((nelt) <= min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
+ ptrdiff_t alloca_nbytes; \
+ if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \
+ || SIZE_MAX < alloca_nbytes) \
+ memory_full (SIZE_MAX); \
+ else if (alloca_nbytes <= sa_avail) \
+ (buf) = AVAIL_ALLOCA (alloca_nbytes); \
+ else \
{ \
Lisp_Object arg_; \
- (buf) = xmalloc ((nelt) * word_size); \
+ (buf) = xmalloc (alloca_nbytes); \
arg_ = make_save_memory (buf, nelt); \
sa_must_free = true; \
record_unwind_protect (free_save_value, arg_); \
} \
- else \
- memory_full (SIZE_MAX); \
} while (false)
static ptrdiff_t read_buffer_size;
static char *read_buffer;
+/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
+
+static void
+grow_read_buffer (void)
+{
+ read_buffer = xpalloc (read_buffer, &read_buffer_size,
+ MAX_MULTIBYTE_LENGTH, -1, 1);
+}
+
/* Read a \-escape sequence, assuming we already read the `\'.
If the escape sequence forces unibyte, return eight-bit char. */
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (p == end)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
{
if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
{
- ptrdiff_t ptr_offset, end_offset, nbytes;
-
- ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
- end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *kb->kbd_macro_buffer / 2
- < kb->kbd_macro_bufsize)
- memory_full (SIZE_MAX);
- nbytes = kb->kbd_macro_bufsize * (2 * sizeof *kb->kbd_macro_buffer);
- kb->kbd_macro_buffer = xrealloc (kb->kbd_macro_buffer, nbytes);
- kb->kbd_macro_bufsize *= 2;
+ ptrdiff_t ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
+ ptrdiff_t end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
+ kb->kbd_macro_buffer = xpalloc (kb->kbd_macro_buffer,
+ &kb->kbd_macro_bufsize,
+ 1, -1, sizeof *kb->kbd_macro_buffer);
kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
}
if (hide_char)
fprintf (stdout, "%c", hide_char);
if (len == size)
- {
- if (STRING_BYTES_BOUND / 2 < size)
- memory_full (SIZE_MAX);
- size *= 2;
- line = xrealloc (line, size);
- }
+ line = xpalloc (line, &size, 1, -1, sizeof *line);
line[len++] = c;
}
}
Here, "ns_fullscreen_hook" calls "handleFS", which is turn calls
"performZoom". This function calls "[super performZoom]", which
- isn't annoted (so it doesn't show up in the trace). However, it
+ isn't annotated (so it doesn't show up in the trace). However, it
calls "zoom" which is annotated so it is part of the call trace.
Later, the method "windowWillUseStandardFrame" and the function
"setFSValue" are called. The lines with "+---" contain extra
/* Function enter macros.
- NSTRACE (fmt, ...) -- Enable trace output in curent block
+ NSTRACE (fmt, ...) -- Enable trace output in current block
(typically a function). Accepts printf-style
arguments.
wr = NSMakeRect (0, 0, neww, newh);
NSTRACE_RECT ("setFrame", wr);
[view setFrame: wr];
- [self windowDidMove:nil]; // Update top/left.
+ // to do: consider using [NSNotificationCenter postNotificationName:].
+ [self windowDidMove: // Update top/left.
+ [NSNotification notificationWithName:NSWindowDidMoveNotification
+ object:[view window]]];
}
else
{
/* Restrict the new size to the text gird.
- Don't restict the width if the user only adjusted the height, and
+ Don't restrict the width if the user only adjusted the height, and
vice versa. (Without this, the frame would shrink, and move
slightly, if the window was resized by dragging one of its
borders.) */
- (void)windowDidResize: (NSNotification *)notification
{
NSTRACE ("windowDidResize");
-
+ if (!FRAME_LIVE_P (emacsframe))
+ {
+ NSTRACE_MSG ("Ignored (frame dead)");
+ return;
+ }
if (emacsframe->output_data.ns->in_animation)
{
NSTRACE_MSG ("Ignored (in animation)");
}
#endif
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
+#define NSWindowDidEnterFullScreenNotification "NSWindowDidEnterFullScreenNotification"
+#endif
+
- (void)windowWillEnterFullScreen:(NSNotification *)notification
+{
+ [self windowWillEnterFullScreen];
+}
+- (void)windowWillEnterFullScreen /* provided for direct calls */
{
NSTRACE ("windowWillEnterFullScreen");
fs_before_fs = fs_state;
}
+- (void)windowDidEnterFullScreen /* provided for direct calls */
+{
+ [self windowDidEnterFullScreen:
+ [NSNotification notificationWithName:NSWindowDidEnterFullScreenNotification
+ object:[self window]]];
+}
- (void)windowDidEnterFullScreen:(NSNotification *)notification
{
NSTRACE ("windowDidEnterFullScreen");
- (void)windowWillExitFullScreen:(NSNotification *)notification
{
- NSTRACE ("windowWillExitFullScreen");
+ [self windowWillExitFullScreen];
+}
+- (void)windowWillExitFullScreen /* provided for direct calls */
+{
+ NSTRACE ("windowWillExitFullScreen");
+ if (!FRAME_LIVE_P (emacsframe))
+ {
+ NSTRACE_MSG ("Ignored (frame dead)");
+ return;
+ }
if (next_maximized != -1)
fs_before_fs = next_maximized;
}
- (void)windowDidExitFullScreen:(NSNotification *)notification
{
- NSTRACE ("windowDidExitFullScreen");
+ [self windowDidExitFullScreen];
+}
+- (void)windowDidExitFullScreen /* provided for direct calls */
+{
+ NSTRACE ("windowDidExitFullScreen");
+ if (!FRAME_LIVE_P (emacsframe))
+ {
+ NSTRACE_MSG ("Ignored (frame dead)");
+ return;
+ }
[self setFSValue: fs_before_fs];
fs_before_fs = -1;
#ifdef HAVE_NATIVE_FS
nonfs_window = w;
- [self windowWillEnterFullScreen:nil];
+ [self windowWillEnterFullScreen];
[fw makeKeyAndOrderFront:NSApp];
[fw makeFirstResponder:self];
[w orderOut:self];
r = [fw frameRectForContentRect:[screen frame]];
[fw setFrame: r display:YES animate:ns_use_fullscreen_animation];
- [self windowDidEnterFullScreen:nil];
+ [self windowDidEnterFullScreen];
[fw display];
}
else
if (FRAME_EXTERNAL_TOOL_BAR (f))
FRAME_TOOLBAR_HEIGHT (f) = tobar_height;
- [self windowWillExitFullScreen:nil];
+ // to do: consider using [NSNotificationCenter postNotificationName:] to send notifications.
+
+ [self windowWillExitFullScreen];
[fw setFrame: [w frame] display:YES animate:ns_use_fullscreen_animation];
[fw close];
[w makeKeyAndOrderFront:NSApp];
- [self windowDidExitFullScreen:nil];
+ [self windowDidExitFullScreen];
[self updateFrameSize:YES];
}
}
/* Constrain size and placement of a frame.
By returning the original "frameRect", the frame is not
- contrained. This can lead to unwanted situations where, for
+ constrained. This can lead to unwanted situations where, for
example, the menu bar covers the frame.
The default implementation (accessed using "super") constrains the
#if 0
// Native zoom done using the standard zoom animation. Size of the
- // resulting frame reduced to accomodate the Dock and, if present,
+ // resulting frame reduced to accommodate the Dock and, if present,
// the menu-bar.
[super zoom:sender];
//
// This works for all practical purposes. (The only minor oddity is
// when transiting from full-height frame to a maximized, the
- // animation reduces the height of the frame slighty (to the 4
- // pixels needed to accomodate the Doc) before it snaps back into
+ // animation reduces the height of the frame slightly (to the 4
+ // pixels needed to accommodate the Doc) before it snaps back into
// full height. The user would need a very trained eye to spot
// this.)
NSScreen * screen = [self screen];
}
}
#else
- // Non-native zoom which is done instantaneous. The resulting frame
- // covert the entire scrren, except the menu-bar, if present.
+ // Non-native zoom which is done instantaneously. The resulting frame
+ // covers the entire screen, except the menu-bar, if present.
NSScreen * screen = [self screen];
if (screen != nil)
{
multibyte-form. But, it may be enlarged on demand if
Vglyph_table contains a string or a composite glyph is
encountered. */
- if (min (PTRDIFF_MAX, SIZE_MAX) / MAX_MULTIBYTE_LENGTH < src_len)
+ if (INT_MULTIPLY_WRAPV (src_len, MAX_MULTIBYTE_LENGTH, &required))
memory_full (SIZE_MAX);
- required = src_len;
- required *= MAX_MULTIBYTE_LENGTH;
if (encode_terminal_src_size < required)
- {
- encode_terminal_src = xrealloc (encode_terminal_src, required);
- encode_terminal_src_size = required;
- }
+ encode_terminal_src = xpalloc (encode_terminal_src,
+ &encode_terminal_src_size,
+ required - encode_terminal_src_size,
+ -1, sizeof *encode_terminal_src);
charset_list = coding_charset_list (coding);
doup++, append_len_incr = strlen (up);
else
doleft++, append_len_incr = strlen (left);
- if (INT_ADD_OVERFLOW (append_len, append_len_incr))
+ if (INT_ADD_WRAPV (append_len_incr,
+ append_len, &append_len))
memory_full (SIZE_MAX);
- append_len += append_len_incr;
}
}
*op++ = tem ? tem : 0200;
#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;
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
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)));
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)
{
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;
{
Lisp_Object lbeg, lend, entry;
struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
- bool boundary = false;
if (EQ (BVAR (buf, undo_list), Qt))
return;
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 ();
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,
}
last_boundary_position = PT;
last_boundary_buffer = current_buffer;
+
+ Fset (Qundo_auto__last_boundary_cause, Qexplicit);
return Qnil;
}
&& !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));
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))
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");
pending_boundary = Qnil;
staticpro (&pending_boundary);
- last_undo_buffer = NULL;
last_boundary_buffer = NULL;
defsubr (&Sundo_boundary);
* On some machines, an existing old_name file is required.
*
*/
-
-/* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co.
- * ELF support added.
- *
- * Basic theory: the data space of the running process needs to be
- * dumped to the output file. Normally we would just enlarge the size
- * of .data, scooting everything down. But we can't do that in ELF,
- * because there is often something between the .data space and the
- * .bss space.
- *
- * In the temacs dump below, notice that the Global Offset Table
- * (.got) and the Dynamic link data (.dynamic) come between .data1 and
- * .bss. It does not work to overlap .data with these fields.
- *
- * The solution is to create a new .data segment. This segment is
- * filled with data from the current process. Since the contents of
- * various sections refer to sections by index, the new .data segment
- * is made the last in the table to avoid changing any existing index.
-
- * This is an example of how the section headers are changed. "Addr"
- * is a process virtual address. "Offset" is a file offset.
-
-raid:/nfs/raid/src/dist-18.56/src> dump -h temacs
-
-temacs:
-
- **** SECTION HEADER TABLE ****
- [No] Type Flags Addr Offset Size Name
- Link Info Adralgn Entsize
-
- [1] 1 2 0x80480d4 0xd4 0x13 .interp
- 0 0 0x1 0
-
- [2] 5 2 0x80480e8 0xe8 0x388 .hash
- 3 0 0x4 0x4
-
- [3] 11 2 0x8048470 0x470 0x7f0 .dynsym
- 4 1 0x4 0x10
-
- [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr
- 0 0 0x1 0
-
- [5] 9 2 0x8049010 0x1010 0x338 .rel.plt
- 3 7 0x4 0x8
-
- [6] 1 6 0x8049348 0x1348 0x3 .init
- 0 0 0x4 0
-
- [7] 1 6 0x804934c 0x134c 0x680 .plt
- 0 0 0x4 0x4
-
- [8] 1 6 0x80499cc 0x19cc 0x3c56f .text
- 0 0 0x4 0
-
- [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini
- 0 0 0x4 0
-
- [10] 1 2 0x8085f40 0x3df40 0x69c .rodata
- 0 0 0x4 0
-
- [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1
- 0 0 0x4 0
-
- [12] 1 3 0x8088330 0x3f330 0x20afc .data
- 0 0 0x4 0
-
- [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1
- 0 0 0x4 0
-
- [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got
- 0 0 0x4 0x4
-
- [15] 6 3 0x80a9874 0x60874 0x80 .dynamic
- 4 0 0x4 0x8
-
- [16] 8 3 0x80a98f4 0x608f4 0x449c .bss
- 0 0 0x4 0
-
- [17] 2 0 0 0x608f4 0x9b90 .symtab
- 18 371 0x4 0x10
-
- [18] 3 0 0 0x6a484 0x8526 .strtab
- 0 0 0x1 0
-
- [19] 3 0 0 0x729aa 0x93 .shstrtab
- 0 0 0x1 0
-
- [20] 1 0 0 0x72a3d 0x68b7 .comment
- 0 0 0x1 0
-
- raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs
-
- xemacs:
-
- **** SECTION HEADER TABLE ****
- [No] Type Flags Addr Offset Size Name
- Link Info Adralgn Entsize
-
- [1] 1 2 0x80480d4 0xd4 0x13 .interp
- 0 0 0x1 0
-
- [2] 5 2 0x80480e8 0xe8 0x388 .hash
- 3 0 0x4 0x4
-
- [3] 11 2 0x8048470 0x470 0x7f0 .dynsym
- 4 1 0x4 0x10
-
- [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr
- 0 0 0x1 0
-
- [5] 9 2 0x8049010 0x1010 0x338 .rel.plt
- 3 7 0x4 0x8
-
- [6] 1 6 0x8049348 0x1348 0x3 .init
- 0 0 0x4 0
-
- [7] 1 6 0x804934c 0x134c 0x680 .plt
- 0 0 0x4 0x4
-
- [8] 1 6 0x80499cc 0x19cc 0x3c56f .text
- 0 0 0x4 0
-
- [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini
- 0 0 0x4 0
-
- [10] 1 2 0x8085f40 0x3df40 0x69c .rodata
- 0 0 0x4 0
-
- [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1
- 0 0 0x4 0
-
- [12] 1 3 0x8088330 0x3f330 0x20afc .data
- 0 0 0x4 0
-
- [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1
- 0 0 0x4 0
-
- [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got
- 0 0 0x4 0x4
-
- [15] 6 3 0x80a9874 0x60874 0x80 .dynamic
- 4 0 0x4 0x8
-
- [16] 8 3 0x80c6800 0x7d800 0 .bss
- 0 0 0x4 0
-
- [17] 2 0 0 0x7d800 0x9b90 .symtab
- 18 371 0x4 0x10
-
- [18] 3 0 0 0x87390 0x8526 .strtab
- 0 0 0x1 0
-
- [19] 3 0 0 0x8f8b6 0x93 .shstrtab
- 0 0 0x1 0
-
- [20] 1 0 0 0x8f949 0x68b7 .comment
- 0 0 0x1 0
-
- [21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data
- 0 0 0x4 0
-
- * This is an example of how the file header is changed. "Shoff" is
- * the section header offset within the file. Since that table is
- * after the new .data section, it is moved. "Shnum" is the number of
- * sections, which we increment.
- *
- * "Phoff" is the file offset to the program header. "Phentsize" and
- * "Shentsz" are the program and section header entries sizes respectively.
- * These can be larger than the apparent struct sizes.
-
- raid:/nfs/raid/src/dist-18.56/src> dump -f temacs
-
- temacs:
-
- **** ELF HEADER ****
- Class Data Type Machine Version
- Entry Phoff Shoff Flags Ehsize
- Phentsize Phnum Shentsz Shnum Shstrndx
-
- 1 1 2 3 1
- 0x80499cc 0x34 0x792f4 0 0x34
- 0x20 5 0x28 21 19
-
- raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs
-
- xemacs:
-
- **** ELF HEADER ****
- Class Data Type Machine Version
- Entry Phoff Shoff Flags Ehsize
- Phentsize Phnum Shentsz Shnum Shstrndx
-
- 1 1 2 3 1
- 0x80499cc 0x34 0x96200 0 0x34
- 0x20 5 0x28 22 19
-
- * These are the program headers. "Offset" is the file offset to the
- * segment. "Vaddr" is the memory load address. "Filesz" is the
- * segment size as it appears in the file, and "Memsz" is the size in
- * memory. Below, the third segment is the code and the fourth is the
- * data: the difference between Filesz and Memsz is .bss
-
- raid:/nfs/raid/src/dist-18.56/src> dump -o temacs
-
- temacs:
- ***** PROGRAM EXECUTION HEADER *****
- Type Offset Vaddr Paddr
- Filesz Memsz Flags Align
-
- 6 0x34 0x8048034 0
- 0xa0 0xa0 5 0
-
- 3 0xd4 0 0
- 0x13 0 4 0
-
- 1 0x34 0x8048034 0
- 0x3f2f9 0x3f2f9 5 0x1000
-
- 1 0x3f330 0x8088330 0
- 0x215c4 0x25a60 7 0x1000
-
- 2 0x60874 0x80a9874 0
- 0x80 0 7 0
-
- raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs
-
- xemacs:
- ***** PROGRAM EXECUTION HEADER *****
- Type Offset Vaddr Paddr
- Filesz Memsz Flags Align
-
- 6 0x34 0x8048034 0
- 0xa0 0xa0 5 0
-
- 3 0xd4 0 0
- 0x13 0 4 0
-
- 1 0x34 0x8048034 0
- 0x3f2f9 0x3f2f9 5 0x1000
-
- 1 0x3f330 0x8088330 0
- 0x3e4d0 0x3e4d0 7 0x1000
-
- 2 0x60874 0x80a9874 0
- 0x80 0 7 0
-
-
- */
-\f
-/* Modified by wtien@urbana.mcd.mot.com of Motorola Inc.
- *
- * The above mechanism does not work if the unexeced ELF file is being
- * re-layout by other applications (such as `strip'). All the applications
- * that re-layout the internal of ELF will layout all sections in ascending
- * order of their file offsets. After the re-layout, the data2 section will
- * still be the LAST section in the section header vector, but its file offset
- * is now being pushed far away down, and causes part of it not to be mapped
- * in (ie. not covered by the load segment entry in PHDR vector), therefore
- * causes the new binary to fail.
- *
- * The solution is to modify the unexec algorithm to insert the new data2
- * section header right before the new bss section header, so their file
- * offsets will be in the ascending order. Since some of the section's (all
- * sections AFTER the bss section) indexes are now changed, we also need to
- * modify some fields to make them point to the right sections. This is done
- * by macro PATCH_INDEX. All the fields that need to be patched are:
- *
- * 1. ELF header e_shstrndx field.
- * 2. section header sh_link and sh_info field.
- * 3. symbol table entry st_shndx field.
- *
- * The above example now should look like:
-
- **** SECTION HEADER TABLE ****
- [No] Type Flags Addr Offset Size Name
- Link Info Adralgn Entsize
-
- [1] 1 2 0x80480d4 0xd4 0x13 .interp
- 0 0 0x1 0
-
- [2] 5 2 0x80480e8 0xe8 0x388 .hash
- 3 0 0x4 0x4
-
- [3] 11 2 0x8048470 0x470 0x7f0 .dynsym
- 4 1 0x4 0x10
-
- [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr
- 0 0 0x1 0
-
- [5] 9 2 0x8049010 0x1010 0x338 .rel.plt
- 3 7 0x4 0x8
-
- [6] 1 6 0x8049348 0x1348 0x3 .init
- 0 0 0x4 0
-
- [7] 1 6 0x804934c 0x134c 0x680 .plt
- 0 0 0x4 0x4
-
- [8] 1 6 0x80499cc 0x19cc 0x3c56f .text
- 0 0 0x4 0
-
- [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini
- 0 0 0x4 0
-
- [10] 1 2 0x8085f40 0x3df40 0x69c .rodata
- 0 0 0x4 0
-
- [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1
- 0 0 0x4 0
-
- [12] 1 3 0x8088330 0x3f330 0x20afc .data
- 0 0 0x4 0
-
- [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1
- 0 0 0x4 0
-
- [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got
- 0 0 0x4 0x4
-
- [15] 6 3 0x80a9874 0x60874 0x80 .dynamic
- 4 0 0x4 0x8
-
- [16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data
- 0 0 0x4 0
-
- [17] 8 3 0x80c6800 0x7d800 0 .bss
- 0 0 0x4 0
-
- [18] 2 0 0 0x7d800 0x9b90 .symtab
- 19 371 0x4 0x10
-
- [19] 3 0 0 0x87390 0x8526 .strtab
- 0 0 0x1 0
-
- [20] 3 0 0 0x8f8b6 0x93 .shstrtab
- 0 0 0x1 0
-
- [21] 1 0 0 0x8f949 0x68b7 .comment
- 0 0 0x1 0
-
- */
\f
/* We do not use mmap because that fails with NFS.
Instead we read the whole file, modify it, and write it out. */
/* Get the address of a particular section or program header entry,
* accounting for the size of the entries.
*/
-/*
- On PPC Reference Platform running Solaris 2.5.1
- the plt section is also of type NOBI like the bss section.
- (not really stored) and therefore sections after the bss
- section start at the plt offset. The plt section is always
- the one just before the bss section.
- Thus, we modify the test from
- if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
- to
- if (NEW_SECTION_H (nn).sh_offset >=
- OLD_SECTION_H (old_bss_index-1).sh_offset)
- This is just a hack. We should put the new data section
- before the .plt section.
- And we should not have this routine at all but use
- the libelf library to read the old file and create the new
- file.
- The changed code is minimal and depends on prep set in m/prep.h
- Erik Deumens
- Quantum Theory Project
- University of Florida
- deumens@qtp.ufl.edu
- Apr 23, 1996
- */
static void *
entry_address (void *section_h, ptrdiff_t idx, ptrdiff_t entsize)
(*(ElfW (Shdr) *) entry_address (old_section_h, n, old_file_h->e_shentsize))
#define NEW_SECTION_H(n) \
(*(ElfW (Shdr) *) entry_address (new_section_h, n, new_file_h->e_shentsize))
-#define NEW_PROGRAM_H(n) \
- (*(ElfW (Phdr) *) entry_address (new_program_h, n, new_file_h->e_phentsize))
+#define OLD_PROGRAM_H(n) \
+ (*(ElfW (Phdr) *) entry_address (old_program_h, n, old_file_h->e_phentsize))
-#define PATCH_INDEX(n) ((n) += old_bss_index <= (n))
typedef unsigned char byte;
-/* Round X up to a multiple of Y. */
-
-static ElfW (Addr)
-round_up (ElfW (Addr) x, ElfW (Addr) y)
-{
- ElfW (Addr) rem = x % y;
- if (rem == 0)
- return x;
- return x - rem + y;
-}
-
-/* Return the index of the section named NAME.
- SECTION_NAMES, FILE_NAME and FILE_H give information
- about the file we are looking in.
-
- If we don't find the section NAME, that is a fatal error
- if NOERROR is false; return -1 if NOERROR is true. */
-
-static ptrdiff_t
-find_section (const char *name, const char *section_names, const char *file_name,
- ElfW (Ehdr) *old_file_h, ElfW (Shdr) *old_section_h,
- bool noerror)
-{
- ptrdiff_t idx;
-
- for (idx = 1; idx < old_file_h->e_shnum; idx++)
- {
- char const *found_name = section_names + OLD_SECTION_H (idx).sh_name;
-#ifdef UNEXELF_DEBUG
- fprintf (stderr, "Looking for %s - found %s\n", name, found_name);
-#endif
- if (strcmp (name, found_name) == 0)
- return idx;
- }
-
- if (! noerror)
- fatal ("Can't find %s in %s", name, file_name);
- return -1;
-}
-
/* ****************************************************************
* unexec
*
* driving logic.
*
- * In ELF, this works by replacing the old .bss section with a new
- * .data section, and inserting an empty .bss immediately afterwards.
+ * In ELF, this works by replacing the old bss SHT_NOBITS section with
+ * a new, larger, SHT_PROGBITS section.
*
*/
void
ElfW (Phdr) *old_program_h, *new_program_h;
ElfW (Shdr) *old_section_h, *new_section_h;
- /* Point to the section name table in the old file. */
- char *old_section_names;
+ /* Point to the section name table. */
+ char *old_section_names, *new_section_names;
+ ElfW (Phdr) *old_bss_seg, *new_bss_seg;
ElfW (Addr) old_bss_addr, new_bss_addr;
ElfW (Word) old_bss_size, new_data2_size;
- ElfW (Off) new_data2_offset;
- ElfW (Addr) new_data2_addr;
- ElfW (Off) old_bss_offset;
- ElfW (Word) new_data2_incr;
-
- ptrdiff_t n, nn;
- ptrdiff_t old_bss_index, old_sbss_index, old_plt_index;
- ptrdiff_t old_data_index, new_data2_index;
-#if defined _SYSTYPE_SYSV || defined __sgi
- ptrdiff_t old_mdebug_index;
-#endif
+ ElfW (Off) old_bss_offset, new_data2_offset;
+
+ ptrdiff_t n;
+ ptrdiff_t old_bss_index;
struct stat stat_buf;
off_t old_file_size;
old_section_names = (char *) old_base
+ OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset;
- /* Find the mdebug section, if any. */
-
-#if defined _SYSTYPE_SYSV || defined __sgi
- old_mdebug_index = find_section (".mdebug", old_section_names,
- old_name, old_file_h, old_section_h, 1);
-#endif
-
- /* Find the old .bss section. Figure out parameters of the new
- data2 and bss sections. */
-
- old_bss_index = find_section (".bss", old_section_names,
- old_name, old_file_h, old_section_h, 0);
-
- old_sbss_index = find_section (".sbss", old_section_names,
- old_name, old_file_h, old_section_h, 1);
- if (old_sbss_index != -1)
- if (OLD_SECTION_H (old_sbss_index).sh_type != SHT_NOBITS)
- old_sbss_index = -1;
-
- /* PowerPC64 has .plt in the BSS section. */
- old_plt_index = find_section (".plt", old_section_names,
- old_name, old_file_h, old_section_h, 1);
- if (old_plt_index != -1)
- if (OLD_SECTION_H (old_plt_index).sh_type != SHT_NOBITS)
- old_plt_index = -1;
-
- if (old_sbss_index == -1 && old_plt_index == -1)
- {
- old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr;
- old_bss_size = OLD_SECTION_H (old_bss_index).sh_size;
- old_bss_offset = OLD_SECTION_H (old_bss_index).sh_offset;
- new_data2_index = old_bss_index;
- }
- else if (old_plt_index != -1
- && (old_sbss_index == -1
- || (OLD_SECTION_H (old_sbss_index).sh_addr
- > OLD_SECTION_H (old_plt_index).sh_addr)))
+ /* Find the PT_LOAD header covering the highest address. This
+ segment will be where bss sections are located, past p_filesz. */
+ old_bss_seg = 0;
+ for (n = old_file_h->e_phnum; --n >= 0; )
{
- old_bss_addr = OLD_SECTION_H (old_plt_index).sh_addr;
- old_bss_size = OLD_SECTION_H (old_bss_index).sh_size
- + OLD_SECTION_H (old_plt_index).sh_size;
- if (old_sbss_index != -1)
- old_bss_size += OLD_SECTION_H (old_sbss_index).sh_size;
- old_bss_offset = OLD_SECTION_H (old_plt_index).sh_offset;
- new_data2_index = old_plt_index;
+ ElfW (Phdr) *seg = &OLD_PROGRAM_H (n);
+ if (seg->p_type == PT_LOAD
+ && (old_bss_seg == 0
+ || seg->p_vaddr > old_bss_seg->p_vaddr))
+ old_bss_seg = seg;
}
- else
+
+ /* Note that old_bss_addr may be lower than the first bss section
+ address, since the section may need aligning. */
+ old_bss_addr = old_bss_seg->p_vaddr + old_bss_seg->p_filesz;
+ old_bss_offset = old_bss_seg->p_offset + old_bss_seg->p_filesz;
+ old_bss_size = old_bss_seg->p_memsz - old_bss_seg->p_filesz;
+
+ /* Find the last bss style section in the bss segment range. */
+ old_bss_index = -1;
+ for (n = old_file_h->e_shnum; --n > 0; )
{
- old_bss_addr = OLD_SECTION_H (old_sbss_index).sh_addr;
- old_bss_size = OLD_SECTION_H (old_bss_index).sh_size
- + OLD_SECTION_H (old_sbss_index).sh_size;
- old_bss_offset = OLD_SECTION_H (old_sbss_index).sh_offset;
- new_data2_index = old_sbss_index;
+ ElfW (Shdr) *shdr = &OLD_SECTION_H (n);
+ if (shdr->sh_type == SHT_NOBITS
+ && shdr->sh_addr >= old_bss_addr
+ && shdr->sh_addr + shdr->sh_size <= old_bss_addr + old_bss_size
+ && (old_bss_index == -1
+ || OLD_SECTION_H (old_bss_index).sh_addr < shdr->sh_addr))
+ old_bss_index = n;
}
- /* Find the old .data section. Figure out parameters of
- the new data2 and bss sections. */
-
- old_data_index = find_section (".data", old_section_names,
- old_name, old_file_h, old_section_h, 0);
+ if (old_bss_index == -1)
+ fatal ("no bss section found");
new_break = sbrk (0);
new_bss_addr = (ElfW (Addr)) new_break;
- new_data2_addr = old_bss_addr;
new_data2_size = new_bss_addr - old_bss_addr;
- new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset
- + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr);
- /* This is the amount by which the sections following the bss sections
- must be shifted in the image. It can differ from new_data2_size if
- the end of the old .data section (and thus the offset of the .bss
- section) was unaligned. */
- new_data2_incr = new_data2_size + (new_data2_offset - old_bss_offset);
+ new_data2_offset = old_bss_offset;
#ifdef UNEXELF_DEBUG
fprintf (stderr, "old_bss_index %td\n", old_bss_index);
DEBUG_LOG (old_bss_size);
DEBUG_LOG (old_bss_offset);
DEBUG_LOG (new_bss_addr);
- DEBUG_LOG (new_data2_addr);
DEBUG_LOG (new_data2_size);
DEBUG_LOG (new_data2_offset);
- DEBUG_LOG (new_data2_incr);
#endif
if (new_bss_addr < old_bss_addr + old_bss_size)
if (new_file < 0)
fatal ("Can't creat (%s): %s", new_name, strerror (errno));
- new_file_size = old_file_size + old_file_h->e_shentsize + new_data2_incr;
+ new_file_size = old_file_size + new_data2_size;
if (ftruncate (new_file, new_file_size))
fatal ("Can't ftruncate (%s): %s", new_name, strerror (errno));
if (new_base == MAP_FAILED)
fatal ("Can't allocate buffer for %s: %s", old_name, strerror (errno));
- new_file_h = (ElfW (Ehdr) *) new_base;
- new_program_h = (ElfW (Phdr) *) ((byte *) new_base + old_file_h->e_phoff);
- new_section_h = (ElfW (Shdr) *)
- ((byte *) new_base + old_file_h->e_shoff + new_data2_incr);
-
/* Make our new file, program and section headers as copies of the
originals. */
+ new_file_h = (ElfW (Ehdr) *) new_base;
memcpy (new_file_h, old_file_h, old_file_h->e_ehsize);
- memcpy (new_program_h, old_program_h,
- old_file_h->e_phnum * old_file_h->e_phentsize);
- /* Modify the e_shstrndx if necessary. */
- PATCH_INDEX (new_file_h->e_shstrndx);
+ /* Fix up file header. Section header is further away now. */
+
+ if (new_file_h->e_shoff >= old_bss_offset)
+ new_file_h->e_shoff += new_data2_size;
- /* Fix up file header. We'll add one section. Section header is
- further away now. */
+ new_program_h = (ElfW (Phdr) *) ((byte *) new_base + new_file_h->e_phoff);
+ new_section_h = (ElfW (Shdr) *) ((byte *) new_base + new_file_h->e_shoff);
- new_file_h->e_shoff += new_data2_incr;
- new_file_h->e_shnum += 1;
+ memcpy (new_program_h, old_program_h,
+ old_file_h->e_phnum * old_file_h->e_phentsize);
+ memcpy (new_section_h, old_section_h,
+ old_file_h->e_shnum * old_file_h->e_shentsize);
#ifdef UNEXELF_DEBUG
DEBUG_LOG (old_file_h->e_shoff);
fprintf (stderr, "New section count %td\n", (ptrdiff_t) new_file_h->e_shnum);
#endif
- /* Fix up a new program header. Extend the writable data segment so
- that the bss area is covered too. Find that segment by looking
- for a segment that ends just before the .bss area. Make sure
- that no segments are above the new .data2. Put a loop at the end
- to adjust the offset and address of any segment that is above
- data2, just in case we decide to allow this later. */
-
- for (n = new_file_h->e_phnum; --n >= 0; )
- {
- /* Compute maximum of all requirements for alignment of section. */
- ElfW (Word) alignment = (NEW_PROGRAM_H (n)).p_align;
- if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment)
- alignment = OLD_SECTION_H (old_bss_index).sh_addralign;
-
-#ifdef __sgi
- /* According to r02kar@x4u2.desy.de (Karsten Kuenne)
- and oliva@gnu.org (Alexandre Oliva), on IRIX 5.2, we
- always get "Program segment above .bss" when dumping
- when the executable doesn't have an sbss section. */
- if (old_sbss_index != -1)
-#endif /* __sgi */
- if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz
- > (old_sbss_index == -1
- ? old_bss_addr
- : round_up (old_bss_addr, alignment)))
- fatal ("Program segment above .bss in %s", old_name);
-
- if (NEW_PROGRAM_H (n).p_type == PT_LOAD
- && (round_up ((NEW_PROGRAM_H (n)).p_vaddr
- + (NEW_PROGRAM_H (n)).p_filesz,
- alignment)
- == round_up (old_bss_addr, alignment)))
- break;
- }
- if (n < 0)
- fatal ("Couldn't find segment next to .bss in %s", old_name);
-
- /* Make sure that the size includes any padding before the old .bss
- section. */
- NEW_PROGRAM_H (n).p_filesz = new_bss_addr - NEW_PROGRAM_H (n).p_vaddr;
- NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz;
+ /* Fix up program header. Extend the writable data segment so
+ that the bss area is covered too. */
-#if 0 /* Maybe allow section after data2 - does this ever happen? */
- for (n = new_file_h->e_phnum; --n >= 0; )
- {
- if (NEW_PROGRAM_H (n).p_vaddr
- && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr)
- NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size;
-
- if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset)
- NEW_PROGRAM_H (n).p_offset += new_data2_incr;
- }
-#endif
+ new_bss_seg = new_program_h + (old_bss_seg - old_program_h);
+ new_bss_seg->p_filesz = new_bss_addr - new_bss_seg->p_vaddr;
+ new_bss_seg->p_memsz = new_bss_seg->p_filesz;
- /* Fix up section headers based on new .data2 section. Any section
- whose offset or virtual address is after the new .data2 section
- gets its value adjusted. .bss size becomes zero and new address
- is set. data2 section header gets added by copying the existing
- .data header and modifying the offset, address and size. */
+ /* Copy over what we have in memory now for the bss area. */
+ memcpy (new_base + new_data2_offset, (caddr_t) old_bss_addr, new_data2_size);
- /* Walk through all section headers, insert the new data2 section right
- before the new bss section. */
- for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++)
+ /* Walk through all section headers, copying data and updating. */
+ for (n = 1; n < old_file_h->e_shnum; n++)
{
caddr_t src;
- /* If it is (s)bss section, insert the new data2 section before it. */
- /* new_data2_index is the index of either old_sbss or old_bss, that was
- chosen as a section for new_data2. */
- if (n == new_data2_index)
- {
- /* Steal the data section header for this data2 section. */
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index),
- new_file_h->e_shentsize);
-
- NEW_SECTION_H (nn).sh_addr = new_data2_addr;
- NEW_SECTION_H (nn).sh_offset = new_data2_offset;
- NEW_SECTION_H (nn).sh_size = new_data2_size;
- /* Use the bss section's alignment. This will assure that the
- new data2 section always be placed in the same spot as the old
- bss section by any other application. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign;
-
- /* Now copy over what we have in the memory now. */
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base,
- (caddr_t) OLD_SECTION_H (n).sh_addr,
- new_data2_size);
- nn++;
- }
+ ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n);
+ ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n);
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n),
- old_file_h->e_shentsize);
-
- if (n == old_bss_index
- /* The new bss and sbss section's size is zero, and its file offset
- and virtual address should be off by NEW_DATA2_SIZE. */
- || n == old_sbss_index || n == old_plt_index
- )
- {
- /* NN should be `old_s?bss_index + 1' at this point. */
- NEW_SECTION_H (nn).sh_offset = new_data2_offset + new_data2_size;
- NEW_SECTION_H (nn).sh_addr = new_data2_addr + new_data2_size;
- /* Let the new bss section address alignment be the same as the
- section address alignment followed the old bss section, so
- this section will be placed in exactly the same place. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign;
- NEW_SECTION_H (nn).sh_size = 0;
- }
- else
+ if (new_shdr->sh_type == SHT_NOBITS
+ && new_shdr->sh_addr >= old_bss_addr
+ && (new_shdr->sh_addr + new_shdr->sh_size
+ <= old_bss_addr + old_bss_size))
{
- /* Any section that was originally placed after the .bss
- section should now be off by NEW_DATA2_INCR. If a
- section overlaps the .bss section, consider it to be
- placed after the .bss section. Overlap can occur if the
- section just before .bss has less-strict alignment; this
- was observed between .symtab and .bss on Solaris 2.5.1
- (sparc) with GCC snapshot 960602.
-
-> dump -h temacs
-
-temacs:
-
- **** SECTION HEADER TABLE ****
-[No] Type Flags Addr Offset Size Name
- Link Info Adralgn Entsize
-
-[22] 1 3 0x335150 0x315150 0x4 .data.rel.local
- 0 0 0x4 0
-
-[23] 8 3 0x335158 0x315158 0x42720 .bss
- 0 0 0x8 0
-
-[24] 2 0 0 0x315154 0x1c9d0 .symtab
- 25 1709 0x4 0x10
- */
-
- if (NEW_SECTION_H (nn).sh_offset >= old_bss_offset
- || (NEW_SECTION_H (nn).sh_offset + NEW_SECTION_H (nn).sh_size
- > new_data2_offset))
- NEW_SECTION_H (nn).sh_offset += new_data2_incr;
-
- /* Any section that was originally placed after the section
- header table should now be off by the size of one section
- header table entry. */
- if (NEW_SECTION_H (nn).sh_offset > new_file_h->e_shoff)
- NEW_SECTION_H (nn).sh_offset += new_file_h->e_shentsize;
+ /* This section now has file backing. */
+ new_shdr->sh_type = SHT_PROGBITS;
+
+ /* SHT_NOBITS sections do not need a valid sh_offset, so it
+ might be incorrect. Write the correct value. */
+ new_shdr->sh_offset = (new_shdr->sh_addr - new_bss_seg->p_vaddr
+ + new_bss_seg->p_offset);
+
+ /* If this is was a SHT_NOBITS .plt section, then it is
+ probably a PowerPC PLT. If it is PowerPC64 ELFv1 then
+ glibc ld.so doesn't initialize the toc pointer word. A
+ non-zero toc pointer word can defeat Power7 thread safety
+ during lazy update of a PLT entry. This only matters if
+ emacs becomes multi-threaded. */
+ if (strcmp (old_section_names + new_shdr->sh_name, ".plt") == 0)
+ memset (new_shdr->sh_offset + new_base, 0, new_shdr->sh_size);
+
+ /* Extend the size of the last bss section to cover dumped
+ data. */
+ if (n == old_bss_index)
+ new_shdr->sh_size = new_bss_addr - new_shdr->sh_addr;
+
+ /* We have already copied this section from the current
+ process. */
+ continue;
}
- /* If any section hdr refers to the section after the new .data
- section, make it refer to next one because we have inserted
- a new section in between. */
-
- PATCH_INDEX (NEW_SECTION_H (nn).sh_link);
- /* For symbol tables, info is a symbol table index,
- so don't change it. */
- if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB
- && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM)
- PATCH_INDEX (NEW_SECTION_H (nn).sh_info);
-
- if (old_sbss_index != -1)
- if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".sbss"))
- {
- NEW_SECTION_H (nn).sh_offset =
- round_up (NEW_SECTION_H (nn).sh_offset,
- NEW_SECTION_H (nn).sh_addralign);
- NEW_SECTION_H (nn).sh_type = SHT_PROGBITS;
- }
+ /* Any section that was originally placed after the .bss
+ section should now be offset by NEW_DATA2_SIZE. */
+ if (new_shdr->sh_offset >= old_bss_offset)
+ new_shdr->sh_offset += new_data2_size;
/* Now, start to copy the content of sections. */
- if (NEW_SECTION_H (nn).sh_type == SHT_NULL
- || NEW_SECTION_H (nn).sh_type == SHT_NOBITS)
+ if (new_shdr->sh_type == SHT_NULL
+ || new_shdr->sh_type == SHT_NOBITS)
continue;
- /* Write out the sections. .data and .data1 (and data2, called
- ".data" in the strings table) get copied from the current process
- instead of the old file. */
- if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".sdata")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".lit4")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".lit8")
+ /* Some sections are copied from the current process instead of
+ the old file. */
+ if (!strcmp (old_section_names + new_shdr->sh_name, ".data")
+ || !strcmp (old_section_names + new_shdr->sh_name, ".sdata")
+ || !strcmp (old_section_names + new_shdr->sh_name, ".lit4")
+ || !strcmp (old_section_names + new_shdr->sh_name, ".lit8")
/* The conditional bit below was in Oliva's original code
(1999-08-25) and seems to have been dropped by mistake
subsequently. It prevents a crash at startup under X in
loader, but I never got anywhere with an SGI support call
seeking clues. -- fx 2002-11-29. */
#ifdef IRIX6_5
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".got")
+ || !strcmp (old_section_names + new_shdr->sh_name, ".got")
#endif
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".sdata1")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".data1")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".sbss"))
- src = (caddr_t) OLD_SECTION_H (n).sh_addr;
+ || !strcmp (old_section_names + new_shdr->sh_name, ".sdata1")
+ || !strcmp (old_section_names + new_shdr->sh_name, ".data1"))
+ src = (caddr_t) old_shdr->sh_addr;
else
- src = old_base + OLD_SECTION_H (n).sh_offset;
-
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src,
- NEW_SECTION_H (nn).sh_size);
+ src = old_base + old_shdr->sh_offset;
-#if defined __alpha__ && !defined __OpenBSD__
- /* Update Alpha COFF symbol table: */
- if (strcmp (old_section_names + OLD_SECTION_H (n).sh_name, ".mdebug")
- == 0)
- {
- pHDRR symhdr = (pHDRR) (NEW_SECTION_H (nn).sh_offset + new_base);
-
- symhdr->cbLineOffset += new_data2_size;
- symhdr->cbDnOffset += new_data2_size;
- symhdr->cbPdOffset += new_data2_size;
- symhdr->cbSymOffset += new_data2_size;
- symhdr->cbOptOffset += new_data2_size;
- symhdr->cbAuxOffset += new_data2_size;
- symhdr->cbSsOffset += new_data2_size;
- symhdr->cbSsExtOffset += new_data2_size;
- symhdr->cbFdOffset += new_data2_size;
- symhdr->cbRfdOffset += new_data2_size;
- symhdr->cbExtOffset += new_data2_size;
- }
-#endif /* __alpha__ && !__OpenBSD__ */
+ memcpy (new_shdr->sh_offset + new_base, src, new_shdr->sh_size);
-#if defined (_SYSTYPE_SYSV)
- if (NEW_SECTION_H (nn).sh_type == SHT_MIPS_DEBUG
- && old_mdebug_index != -1)
+#if (defined __alpha__ && !defined __OpenBSD__) || defined _SYSTYPE_SYSV
+ /* Update Alpha and MIPS COFF debug symbol table. */
+ if (strcmp (old_section_names + new_shdr->sh_name, ".mdebug") == 0
+ && new_shdr->sh_offset - old_shdr->sh_offset != 0
+#if defined _SYSTYPE_SYSV
+ && new_shdr->sh_type == SHT_MIPS_DEBUG
+#endif
+ )
{
- ptrdiff_t new_offset = NEW_SECTION_H (nn).sh_offset;
- ptrdiff_t old_offset = OLD_SECTION_H (old_mdebug_index).sh_offset;
- ptrdiff_t diff = new_offset - old_offset;
- HDRR *phdr = (HDRR *)(NEW_SECTION_H (nn).sh_offset + new_base);
-
- if (diff)
- {
- phdr->cbLineOffset += diff;
- phdr->cbDnOffset += diff;
- phdr->cbPdOffset += diff;
- phdr->cbSymOffset += diff;
- phdr->cbOptOffset += diff;
- phdr->cbAuxOffset += diff;
- phdr->cbSsOffset += diff;
- phdr->cbSsExtOffset += diff;
- phdr->cbFdOffset += diff;
- phdr->cbRfdOffset += diff;
- phdr->cbExtOffset += diff;
- }
+ ptrdiff_t diff = new_shdr->sh_offset - old_shdr->sh_offset;
+ HDRR *phdr = (HDRR *) (new_shdr->sh_offset + new_base);
+
+ phdr->cbLineOffset += diff;
+ phdr->cbDnOffset += diff;
+ phdr->cbPdOffset += diff;
+ phdr->cbSymOffset += diff;
+ phdr->cbOptOffset += diff;
+ phdr->cbAuxOffset += diff;
+ phdr->cbSsOffset += diff;
+ phdr->cbSsExtOffset += diff;
+ phdr->cbFdOffset += diff;
+ phdr->cbRfdOffset += diff;
+ phdr->cbExtOffset += diff;
}
-#endif /* _SYSTYPE_SYSV */
+#endif /* __alpha__ || _SYSTYPE_SYSV */
#if __sgi
/* Adjust the HDRR offsets in .mdebug and copy the
the ld bug that gets the line table in a hole in the
elf file rather than in the .mdebug section proper.
David Anderson. davea@sgi.com Jan 16,1994. */
- if (n == old_mdebug_index)
+ if (strcmp (old_section_names + new_shdr->sh_name, ".mdebug") == 0
+ && new_shdr->sh_offset - old_shdr->sh_offset != 0)
{
#define MDEBUGADJUST(__ct,__fileaddr) \
if (n_phdrr->__ct > 0) \
n_phdrr->__fileaddr += movement; \
}
- HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset);
- HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset);
- unsigned movement = new_data2_size;
+ HDRR *o_phdrr = (HDRR *) ((byte *) old_base + old_shdr->sh_offset);
+ HDRR *n_phdrr = (HDRR *) ((byte *) new_base + new_shdr->sh_offset);
+ ptrdiff_t movement = new_shdr->sh_offset - old_shdr->sh_offset;
MDEBUGADJUST (idnMax, cbDnOffset);
MDEBUGADJUST (ipdMax, cbPdOffset);
requires special handling. */
if (n_phdrr->cbLine > 0)
{
- if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset
- + OLD_SECTION_H (n).sh_size))
- {
- /* line data is in a hole in elf. do special copy and adjust
- for this ld mistake.
- */
- n_phdrr->cbLineOffset += movement;
+ n_phdrr->cbLineOffset += movement;
- memcpy (n_phdrr->cbLineOffset + new_base,
- o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine);
- }
- else
- {
- /* somehow line data is in .mdebug as it is supposed to be. */
- MDEBUGADJUST (cbLine, cbLineOffset);
- }
+ if (o_phdrr->cbLineOffset > (old_shdr->sh_offset
+ + old_shdr->sh_size))
+ /* If not covered by section, it hasn't yet been copied. */
+ memcpy (n_phdrr->cbLineOffset + new_base,
+ o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine);
}
}
#endif /* __sgi */
-
- /* If it is the symbol table, its st_shndx field needs to be patched. */
- if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB
- || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM)
- {
- ElfW (Shdr) *spt = &NEW_SECTION_H (nn);
- ptrdiff_t num = spt->sh_size / spt->sh_entsize;
- ElfW (Sym) * sym = (ElfW (Sym) *) (NEW_SECTION_H (nn).sh_offset +
- new_base);
- for (; num--; sym++)
- {
- if ((sym->st_shndx == SHN_UNDEF)
- || (sym->st_shndx == SHN_ABS)
- || (sym->st_shndx == SHN_COMMON))
- continue;
-
- PATCH_INDEX (sym->st_shndx);
- }
- }
}
/* Update the symbol values of _edata and _end. */
{
byte *symnames;
ElfW (Sym) *symp, *symendp;
+ ElfW (Shdr) *sym_shdr = &NEW_SECTION_H (n);
- if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM
- && NEW_SECTION_H (n).sh_type != SHT_SYMTAB)
+ if (sym_shdr->sh_type != SHT_DYNSYM
+ && sym_shdr->sh_type != SHT_SYMTAB)
continue;
symnames = ((byte *) new_base
- + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset);
- symp = (ElfW (Sym) *) (NEW_SECTION_H (n).sh_offset + new_base);
- symendp = (ElfW (Sym) *) ((byte *)symp + NEW_SECTION_H (n).sh_size);
+ + NEW_SECTION_H (sym_shdr->sh_link).sh_offset);
+ symp = (ElfW (Sym) *) (sym_shdr->sh_offset + new_base);
+ symendp = (ElfW (Sym) *) ((byte *) symp + sym_shdr->sh_size);
for (; symp < symendp; symp ++)
{
if (strncmp ((char *) (symnames + symp->st_name),
"_OBJC_", sizeof ("_OBJC_") - 1) == 0)
{
- caddr_t old, new;
-
- new = ((symp->st_value - NEW_SECTION_H (symp->st_shndx).sh_addr)
- + NEW_SECTION_H (symp->st_shndx).sh_offset + new_base);
- /* "Unpatch" index. */
- nn = symp->st_shndx;
- if (nn > old_bss_index)
- nn--;
- if (nn == old_bss_index)
- memset (new, 0, symp->st_size);
- else
+ ElfW (Shdr) *new_shdr = &NEW_SECTION_H (symp->st_shndx);
+ if (new_shdr->sh_type != SHT_NOBITS)
{
- old = ((symp->st_value
- - NEW_SECTION_H (symp->st_shndx).sh_addr)
- + OLD_SECTION_H (nn).sh_offset + old_base);
- memcpy (new, old, symp->st_size);
+ ElfW (Shdr) *old_shdr = &OLD_SECTION_H (symp->st_shndx);
+ ptrdiff_t reladdr = symp->st_value - new_shdr->sh_addr;
+ ptrdiff_t newoff = reladdr + new_shdr->sh_offset;
+
+ if (old_shdr->sh_type == SHT_NOBITS)
+ memset (new_base + newoff, 0, symp->st_size);
+ else
+ {
+ ptrdiff_t oldoff = reladdr + old_shdr->sh_offset;
+ memcpy (new_base + newoff, old_base + oldoff,
+ symp->st_size);
+ }
}
}
#endif
}
}
- /* This loop seeks out relocation sections for the data section, so
- that it can undo relocations performed by the runtime linker. */
+ /* Modify the names of sections we changed from SHT_NOBITS to
+ SHT_PROGBITS. This is really just cosmetic, but some tools that
+ (wrongly) operate on section names rather than types might be
+ confused by a SHT_PROGBITS .bss section. */
+ new_section_names = ((char *) new_base
+ + NEW_SECTION_H (new_file_h->e_shstrndx).sh_offset);
for (n = new_file_h->e_shnum; 0 < --n; )
{
- ElfW (Shdr) section = NEW_SECTION_H (n);
+ ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n);
+ ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n);
+
+ /* Replace the leading '.' with ','. When .shstrtab is string
+ merged this will rename both .bss and .rela.bss to ,bss and
+ .rela,bss. */
+ if (old_shdr->sh_type == SHT_NOBITS
+ && new_shdr->sh_type == SHT_PROGBITS)
+ *(new_section_names + new_shdr->sh_name) = ',';
+ }
- /* Cause a compilation error if anyone uses n instead of nn below. */
- #define n ((void) 0);
- n /* Prevent 'macro "n" is not used' warnings. */
+ /* This loop seeks out relocation sections for the data section, so
+ that it can undo relocations performed by the runtime loader. */
+ for (n = new_file_h->e_shnum; 0 < --n; )
+ {
+ ElfW (Shdr) *rel_shdr = &NEW_SECTION_H (n);
+ ElfW (Shdr) *shdr;
- switch (section.sh_type)
+ switch (rel_shdr->sh_type)
{
default:
break;
/* This code handles two different size structs, but there should
be no harm in that provided that r_offset is always the first
member. */
- nn = section.sh_info;
- if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data")
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".sdata")
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".lit4")
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".lit8")
+ shdr = &NEW_SECTION_H (rel_shdr->sh_info);
+ if (!strcmp (old_section_names + shdr->sh_name, ".data")
+ || !strcmp (old_section_names + shdr->sh_name, ".sdata")
+ || !strcmp (old_section_names + shdr->sh_name, ".lit4")
+ || !strcmp (old_section_names + shdr->sh_name, ".lit8")
#ifdef IRIX6_5 /* see above */
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".got")
+ || !strcmp (old_section_names + shdr->sh_name, ".got")
#endif
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".sdata1")
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".data1"))
+ || !strcmp (old_section_names + shdr->sh_name, ".sdata1")
+ || !strcmp (old_section_names + shdr->sh_name, ".data1"))
{
- ElfW (Addr) offset = (NEW_SECTION_H (nn).sh_addr
- - NEW_SECTION_H (nn).sh_offset);
- caddr_t reloc = old_base + section.sh_offset, end;
- for (end = reloc + section.sh_size; reloc < end;
- reloc += section.sh_entsize)
+ ElfW (Addr) offset = shdr->sh_addr - shdr->sh_offset;
+ caddr_t reloc = old_base + rel_shdr->sh_offset, end;
+ for (end = reloc + rel_shdr->sh_size;
+ reloc < end;
+ reloc += rel_shdr->sh_entsize)
{
ElfW (Addr) addr = ((ElfW (Rel) *) reloc)->r_offset - offset;
-#ifdef __alpha__
- /* The Alpha ELF binutils currently have a bug that
- sometimes results in relocs that contain all
- zeroes. Work around this for now... */
+ /* Ignore R_*_NONE relocs. */
if (((ElfW (Rel) *) reloc)->r_offset == 0)
continue;
-#endif
- memcpy (new_base + addr, old_base + addr, sizeof (ElfW (Addr)));
+ /* Assume reloc applies to a word.
+ ??? This is not always true, eg. TLS module/index
+ pair in .got which occupies two words. */
+ memcpy (new_base + addr, old_base + addr,
+ sizeof (ElfW (Addr)));
}
}
break;
}
-
- #undef n
}
/* Write out new_file, and free the buffers. */
#include <commctrl.h>
#include <commdlg.h>
#include <shellapi.h>
+#include <shlwapi.h>
#include <ctype.h>
#include <winspool.h>
#include <objbase.h>
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 */
+
\f
/***********************************************************************
Initialization
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");
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);
{
/* If this window is the selected window on its frame, set the
global variable update_mode_lines, so that x_consider_frame_title
- will consider this frame's title for rtedisplay. */
+ will consider this frame's title for redisplay. */
Lisp_Object fselected_window = XFRAME (WINDOW_FRAME (w))->selected_window;
if (WINDOWP (fselected_window) && XWINDOW (fselected_window) == w)
void
maybe_set_redisplay (Lisp_Object symbol)
{
- if (!NILP (Fassoc_string (symbol, Vredisplay__variables, Qnil)))
+ if (HASH_TABLE_P (Vredisplay__variables)
+ && hash_lookup (XHASH_TABLE (Vredisplay__variables), symbol, NULL) >= 0)
{
bset_update_mode_line (current_buffer);
current_buffer->prevent_redisplay_optimizations_p = true;
{
struct frame *f = XFRAME (frame);
- if (FRAME_WINDOW_P (f)
- || FRAME_MINIBUF_ONLY_P (f)
- || f->explicit_name)
+ if ((FRAME_WINDOW_P (f)
+ || FRAME_MINIBUF_ONLY_P (f)
+ || f->explicit_name)
+ && NILP (Fframe_parameter (frame, Qtooltip)))
{
/* Do we have more than one visible frame on this X display? */
Lisp_Object tail, other_frame, fmt;
Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL);
DEFVAR_LISP ("redisplay--variables", Vredisplay__variables,
- doc: /* A list of variables changes to which trigger a thorough redisplay. */);
+ doc: /* A hash-table of variables changing which triggers a thorough redisplay. */);
Vredisplay__variables = Qnil;
}
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;
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
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;
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.
| 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))
{
}
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,
}
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 ();
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.
#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;
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.");
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)))
DEFSYM (Qmono, "mono");
#ifdef USE_CAIRO
+ DEFSYM (Qpdf, "pdf");
+
DEFSYM (Qorientation, "orientation");
DEFSYM (Qtop_margin, "top-margin");
DEFSYM (Qbottom_margin, "bottom-margin");
/* Do we have room for this component followed by a '\0'? */
if (path_size - path_len <= next_len)
- {
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 - 1 - path_len < next_len)
- memory_full (SIZE_MAX);
- path_size = (path_len + next_len + 1) * 2;
- path = xrealloc (path, path_size);
- }
+ path = xpalloc (path, &path_size, path_len - path_size + next_len + 1,
+ -1, sizeof *path);
memcpy (path + path_len, next, next_len);
path_len += next_len;
Atom type, int format, unsigned long size)
{
ptrdiff_t format_bytes = format >> 3;
- if (PTRDIFF_MAX / format_bytes < size)
+ ptrdiff_t data_bytes;
+ if (INT_MULTIPLY_WRAPV (size, format_bytes, &data_bytes))
memory_full (SIZE_MAX);
return selection_data_to_lisp_data (FRAME_DISPLAY_INFO (f), data,
- size * format_bytes, type, format);
+ data_bytes, type, format);
}
DEFUN ("x-get-atom-name", Fx_get_atom_name,
props[props_idx]->name = xstrdup (SmRestartCommand);
props[props_idx]->type = xstrdup (SmLISTofARRAY8);
/* /path/to/emacs, --smid=xxx --no-splash --chdir=dir ... */
- if (INT_MAX - 3 < initial_argc)
+ if (INT_ADD_WRAPV (initial_argc, 3, &i))
memory_full (SIZE_MAX);
- i = 3 + initial_argc;
props[props_idx]->num_vals = i;
vp = xnmalloc (i, sizeof *vp);
props[props_idx]->vals = vp;
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)
*sticky = true;
}
+#ifdef USE_XCB
+ free (prop);
+#else
if (tmp_data) XFree (tmp_data);
+#endif
+
unblock_input ();
return ! is_hidden;
}
struct terminal *terminal;
struct x_display_info *dpyinfo;
XrmDatabase xrdb;
- ptrdiff_t lim;
+#ifdef USE_XCB
+ xcb_connection_t *xcb_conn;
+#endif
block_input ();
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);
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;
XSetAfterFunction (x_current_display, x_trace_wire);
#endif
- lim = min (PTRDIFF_MAX, SIZE_MAX) - sizeof "@";
Lisp_Object system_name = Fsystem_name ();
- if (lim - SBYTES (Vinvocation_name) < SBYTES (system_name))
+ ptrdiff_t nbytes;
+ if (INT_ADD_WRAPV (SBYTES (Vinvocation_name), SBYTES (system_name) + 2,
+ &nbytes))
memory_full (SIZE_MAX);
dpyinfo->x_id = ++x_display_id;
- dpyinfo->x_id_name = xmalloc (SBYTES (Vinvocation_name)
- + SBYTES (system_name) + 2);
+ dpyinfo->x_id_name = xmalloc (nbytes);
char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name);
*nametail++ = '@';
lispstpcpy (nametail, system_name);
#include <X11/Xlocale.h>
#endif
+#ifdef USE_XCB
+#include <X11/Xlib-xcb.h>
+#endif
+
#include "dispextern.h"
#include "termhooks.h"
#ifdef USE_CAIRO
XExtCodes *ext_codes;
#endif
+
+#ifdef USE_XCB
+ xcb_connection_t *xcb_connection;
+#endif
};
#ifdef HAVE_X_I18N
--- /dev/null
+;;; abbrev-tests.el --- Test suite for abbrevs.
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Eli Zaretskii <eliz@gnu.org>
+;; Keywords: abbrevs
+
+;; 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)
+(require 'abbrev)
+
+(ert-deftest copy-abbrev-table-test ()
+ (defvar foo-abbrev-table nil) ; Avoid compiler warning
+ (define-abbrev-table 'foo-abbrev-table
+ '())
+ (should (abbrev-table-p foo-abbrev-table))
+ ;; Bug 21828
+ (let ((new-foo-abbrev-table
+ (condition-case nil
+ (copy-abbrev-table foo-abbrev-table)
+ (error nil))))
+ (should (abbrev-table-p new-foo-abbrev-table)))
+ (should-not (string-equal (buffer-name) "*Backtrace*")))
+
+(provide 'abbrev-tests)
+
+;;; abbrev-tests.el ends here
(kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
-(ert-deftest auto-revert-test01-auto-revert-tail-mode ()
+;; This is inspired by Bug#21841.
+(ert-deftest auto-revert-test01-auto-revert-several-files ()
+ "Check autorevert for several files at once."
+ (skip-unless (executable-find "cp"))
+
+ (let* ((cp (executable-find "cp"))
+ (tmpdir1 (make-temp-file "auto-revert-test" 'dir))
+ (tmpdir2 (make-temp-file "auto-revert-test" 'dir))
+ (tmpfile1
+ (make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
+ (tmpfile2
+ (make-temp-file (expand-file-name "auto-revert-test" tmpdir1)))
+ buf1 buf2)
+ (unwind-protect
+ (progn
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (narrow-to-region (point-max) (point-max)))
+ (write-region "any text" nil tmpfile1 nil 'no-message)
+ (setq buf1 (find-file-noselect tmpfile1))
+ (write-region "any text" nil tmpfile2 nil 'no-message)
+ (setq buf2 (find-file-noselect tmpfile2))
+
+ (dolist (buf (list buf1 buf2))
+ (with-current-buffer buf
+ (should (string-equal (buffer-string) "any text"))
+ ;; `buffer-stale--default-function' checks for
+ ;; `verify-visited-file-modtime'. We must ensure that
+ ;; it returns nil.
+ (sleep-for 1)
+ (auto-revert-mode 1)
+ (should auto-revert-mode)))
+
+ ;; Modify files. We wait for a second, in order to have
+ ;; another timestamp.
+ (sleep-for 1)
+ (write-region
+ "another text" nil
+ (expand-file-name (file-name-nondirectory tmpfile1) tmpdir2)
+ nil 'no-message)
+ (write-region
+ "another text" nil
+ (expand-file-name (file-name-nondirectory tmpfile2) tmpdir2)
+ nil 'no-message)
+ ;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents)
+ ;; Strange, that `copy-directory' does not work as expected.
+ ;; The following shell command is not portable on all
+ ;; platforms, unfortunately.
+ (shell-command (format "%s -f %s/* %s" cp tmpdir2 tmpdir1))
+
+ ;; Check, that the buffers have been reverted.
+ (dolist (buf (list buf1 buf2))
+ (with-current-buffer buf
+ (auto-revert--wait-for-revert buf)
+ (should (string-match "another text" (buffer-string))))))
+
+ ;; Exit.
+ (with-current-buffer "*Messages*" (widen))
+ (ignore-errors
+ (dolist (buf (list buf1 buf2))
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)))
+ (ignore-errors (delete-directory tmpdir1 'recursive))
+ (ignore-errors (delete-directory tmpdir2 'recursive)))))
+
+(ert-deftest auto-revert-test02-auto-revert-tail-mode ()
"Check autorevert tail mode."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
(ignore-errors (kill-buffer buf))
(ignore-errors (delete-file tmpfile)))))
-(ert-deftest auto-revert-test02-auto-revert-mode-dired ()
+(ert-deftest auto-revert-test03-auto-revert-mode-dired ()
"Check autorevert for dired."
;; `auto-revert-buffers' runs every 5". And we must wait, until the
;; file has been reverted.
--- /dev/null
+;;; buffer-tests.el --- tests for buffer.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest overlay-modification-hooks-message-other-buf ()
+ "Test for bug#21824.
+After a modification-hook has been run and there is an overlay in
+the *Messages* buffer, the message coalescing [2 times] wrongly
+runs the modification-hook of the overlay in the 1st buffer, but
+with parameters from the *Messages* buffer modification."
+ (let ((buf nil)
+ (msg-ov nil))
+ (with-temp-buffer
+ (insert "123")
+ (overlay-put (make-overlay 1 3)
+ 'modification-hooks
+ (list (lambda (&rest _)
+ (setq buf (current-buffer)))))
+ (goto-char 2)
+ (insert "x")
+ (unwind-protect
+ (progn
+ (setq msg-ov (make-overlay 1 1 (get-buffer-create "*Messages*")))
+ (message "a message")
+ (message "a message")
+ (should (eq buf (current-buffer))))
+ (when msg-ov (delete-overlay msg-ov))))))
+
+;;; buffer-tests.el ends here
(should (equal (cl-set-difference b b) e))
;; Note: this test (and others) is sensitive to the order of the
;; result, which is not documented.
- (should (equal (cl-set-difference a b) (list c2 "x" "" nil 'a)))
- (should (equal (cl-set-difference b a) (list 'x 'y)))
+ (should (equal (cl-set-difference a b) (list 'a nil "" "x" c2)))
+ (should (equal (cl-set-difference b a) (list 'y 'x)))
;; We aren't testing whether this is really using `eq' rather than `eql'.
(should (equal (cl-set-difference e e :test 'eq) e))
(should (equal (cl-set-difference b e :test 'eq) b))
(should (equal (cl-set-difference e b :test 'eq) e))
(should (equal (cl-set-difference b b :test 'eq) e))
- (should (equal (cl-set-difference a b :test 'eq) (list c2 "x" "" nil 'a)))
- (should (equal (cl-set-difference b a :test 'eq) (list 'x 'y)))
+ (should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2)))
+ (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x)))
(should (equal (cl-union e e) e))
(should (equal (cl-union a e) a))
(cl-defstruct (mystruct
(:constructor cl-lib--con-1 (&aux (abc 1)))
- (:constructor cl-lib--con-2 (&optional def)))
+ (:constructor cl-lib--con-2 (&optional def) "Constructor docstring."))
+ "General docstring."
(abc 5 :readonly t) (def nil))
(ert-deftest cl-lib-struct-accessors ()
(let ((x (make-mystruct :abc 1 :def 2)))
(`((cl-tag-slot) (abc 5 :readonly t)
(def . ,(or `nil `(nil))))
t)))))
+(ert-deftest cl-lib-struct-constructors ()
+ (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))))
(ert-deftest cl-lib-arglist-performance ()
;; An `&aux' should not cause lambda's arglist to be turned into an &rest
(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}")
(should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
"\nasdфывfgh\t")))
+(ert-deftest test-json-path-to-position-with-objects ()
+ (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}")
+ (matched-path (json-path-to-position 32 json-string)))
+ (should (equal (plist-get matched-path :path) '("foo" "bar" "baz")))
+ (should (equal (plist-get matched-path :match-start) 25))
+ (should (equal (plist-get matched-path :match-end) 32))))
+
+(ert-deftest test-json-path-to-position-with-arrays ()
+ (let* ((json-string "{\"foo\": [\"bar\", [\"baz\"]]}")
+ (matched-path (json-path-to-position 20 json-string)))
+ (should (equal (plist-get matched-path :path) '("foo" 1 0)))
+ (should (equal (plist-get matched-path :match-start) 18))
+ (should (equal (plist-get matched-path :match-end) 23))))
+
+(ert-deftest test-json-path-to-position-no-match ()
+ (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
+ (matched-path (json-path-to-position 5 json-string)))
+ (should (null matched-path))))
+
(provide 'json-tests)
;;; json-tests.el ends here
--- /dev/null
+;;; 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
(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
(should (= b 2))
(should (null c))))
+(ert-deftest test-map-merge-with ()
+ (should (equal (map-merge-with 'list #'+
+ '((1 . 2))
+ '((1 . 3) (2 . 4))
+ '((1 . 1) (2 . 5) (3 . 0)))
+ '((3 . 0) (2 . 9) (1 . 6)))))
+
(provide 'map-tests)
;;; map-tests.el ends here
--- /dev/null
+;;; 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
(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)))))
+
\f
;;; `newline'
(ert-deftest newline ()
(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
generic_object(); // enter generic_object into ObjectRegistry
// We never copy generic_objects, so we don't need a copy constructor.
~generic_object(void); // delete from ObjectRegistry
- // Simulation steps, accomodate different kinds of time
+ // Simulation steps, accommodate different kinds of time
virtual void compute_next_state(void) { }
virtual void step(void) { }
};