Now on revision 114578. ------------------------------------------------------------ revno: 114578 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-10-08 10:40:09 +0400 message: Do not allocate huge temporary memory areas and objects while encoding for file I/O, thus reducing an enormous memory usage for large buffers. See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html. * coding.h (struct coding_system): New member raw_destination. * coding.c (setup_coding_system): Initialize it to zero. (encode_coding_object): If raw_destination is set, do not create dst_object. Add comment. * fileio.c (toplevel): New constant E_WRITE_MAX. (e_write): Do not encode more than E_WRITE_MAX characters per one loop iteration. Use raw_destination if E_WRITE_MAX characters is encoded. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 06:12:40 +0000 +++ src/ChangeLog 2013-10-08 06:40:09 +0000 @@ -1,3 +1,16 @@ +2013-10-08 Dmitry Antipov + + Do not allocate huge temporary memory areas and objects while encoding + for file I/O, thus reducing an enormous memory usage for large buffers. + See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html. + * coding.h (struct coding_system): New member raw_destination. + * coding.c (setup_coding_system): Initialize it to zero. + (encode_coding_object): If raw_destination is set, do not create + dst_object. Add comment. + * fileio.c (toplevel): New constant E_WRITE_MAX. + (e_write): Do not encode more than E_WRITE_MAX characters per one loop + iteration. Use raw_destination if E_WRITE_MAX characters is encoded. + 2013-10-08 Jan Djärv * nsterm.m (windowDidExitFullScreen:): === modified file 'src/coding.c' --- src/coding.c 2013-08-26 05:20:59 +0000 +++ src/coding.c 2013-10-08 06:40:09 +0000 @@ -5761,6 +5761,7 @@ coding->safe_charsets = SDATA (val); coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs)); coding->carryover_bytes = 0; + coding->raw_destination = 0; coding_type = CODING_ATTR_TYPE (attrs); if (EQ (coding_type, Qundecided)) @@ -8352,6 +8353,11 @@ { if (BUFFERP (coding->dst_object)) coding->dst_object = Fbuffer_string (); + else if (coding->raw_destination) + /* This is used to avoid creating huge Lisp string. + NOTE: caller who sets `raw_destination' is also + responsible for freeing `destination' buffer. */ + coding->dst_object = Qnil; else { coding->dst_object === modified file 'src/coding.h' --- src/coding.h 2013-08-30 12:17:44 +0000 +++ src/coding.h 2013-10-08 06:40:09 +0000 @@ -512,6 +512,10 @@ `charbuf', but at `src_object'. */ unsigned chars_at_source : 1; + /* Nonzero if the result of conversion is in `destination' + buffer rather than in `dst_object'. */ + unsigned raw_destination : 1; + /* Set to 1 if charbuf contains an annotation. */ unsigned annotated : 1; === modified file 'src/fileio.c' --- src/fileio.c 2013-09-11 05:03:23 +0000 +++ src/fileio.c 2013-10-08 06:40:09 +0000 @@ -5263,6 +5263,10 @@ return 1; } +/* Maximum number of characters that the next + function encodes per one loop iteration. */ + +enum { E_WRITE_MAX = 8 * 1024 * 1024 }; /* Write text in the range START and END into descriptor DESC, encoding them with coding system CODING. If STRING is nil, START @@ -5289,9 +5293,16 @@ coding->src_multibyte = SCHARS (string) < SBYTES (string); if (CODING_REQUIRE_ENCODING (coding)) { - encode_coding_object (coding, string, - start, string_char_to_byte (string, start), - end, string_char_to_byte (string, end), Qt); + ptrdiff_t nchars = min (end - start, E_WRITE_MAX); + + /* Avoid creating huge Lisp string in encode_coding_object. */ + if (nchars == E_WRITE_MAX) + coding->raw_destination = 1; + + encode_coding_object + (coding, string, start, string_char_to_byte (string, start), + start + nchars, string_char_to_byte (string, start + nchars), + Qt); } else { @@ -5308,8 +5319,15 @@ coding->src_multibyte = (end - start) < (end_byte - start_byte); if (CODING_REQUIRE_ENCODING (coding)) { - encode_coding_object (coding, Fcurrent_buffer (), - start, start_byte, end, end_byte, Qt); + ptrdiff_t nchars = min (end - start, E_WRITE_MAX); + + /* Likewise. */ + if (nchars == E_WRITE_MAX) + coding->raw_destination = 1; + + encode_coding_object + (coding, Fcurrent_buffer (), start, start_byte, + start + nchars, CHAR_TO_BYTE (start + nchars), Qt); } else { @@ -5330,11 +5348,19 @@ if (coding->produced > 0) { - char *buf = (STRINGP (coding->dst_object) - ? SSDATA (coding->dst_object) - : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)); + char *buf = (coding->raw_destination ? (char *) coding->destination + : (STRINGP (coding->dst_object) + ? SSDATA (coding->dst_object) + : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); coding->produced -= emacs_write_sig (desc, buf, coding->produced); + if (coding->raw_destination) + { + /* We're responsible for freeing this, see + encode_coding_object to check why. */ + xfree (coding->destination); + coding->raw_destination = 0; + } if (coding->produced) return 0; } ------------------------------------------------------------ revno: 114577 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8196 author: Teemu Likonen committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 02:17:49 -0400 message: * indent.el: Provide interactive indent-rigidly mode. Use lexical-binding. (indent-rigidly--current-indentation): New function. (indent-rigidly-map): New var. (indent-rigidly): Use it to provide interactive mode. (indent-region): Add progress reporter. (tab-stop-list): Make it implicitly extend to infinity by repeating the last step. (indent--next-tab-stop): New function to implement this behavior. (tab-to-tab-stop, move-to-tab-stop): Use it. diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-10-07 03:34:26 +0000 +++ etc/NEWS 2013-10-08 06:17:49 +0000 @@ -163,6 +163,13 @@ * Editing Changes in Emacs 24.4 +** C-x TAB enters a transient interactive mode. +You can then use the left/right cursor keys to move the block of text. + +** `tab-stop-list' is now implicitly extended to infinity. +Its default value is changed to nil which means a tab stop every +`tab-width' columns. + ** `split-window' is no longer a command, just a non-interactive function. As a command it was a special case of `split-window-below', and as such superfluous. After being reimplemented in Lisp, its interactive form === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 06:02:20 +0000 +++ lisp/ChangeLog 2013-10-08 06:17:49 +0000 @@ -1,3 +1,18 @@ +2013-10-08 Stefan Monnier + + * indent.el: Use lexical-binding. + (indent-region): Add progress reporter. + (tab-stop-list): Make it implicitly extend to infinity by repeating the + last step. + (indent--next-tab-stop): New function to implement this behavior. + (tab-to-tab-stop, move-to-tab-stop): Use it. + +2013-10-08 Teemu Likonen + + * indent.el (indent-rigidly--current-indentation): New function. + (indent-rigidly-map): New var. + (indent-rigidly): Use it to provide interactive mode (bug#8196). + 2013-10-08 Bastien Guerry * register.el (insert-register): Fix revno:114543. === modified file 'lisp/indent.el' --- lisp/indent.el 2013-01-01 09:11:05 +0000 +++ lisp/indent.el 2013-10-08 06:17:49 +0000 @@ -1,4 +1,4 @@ -;;; indent.el --- indentation commands for Emacs +;;; indent.el --- indentation commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985, 1995, 2001-2013 Free Software Foundation, Inc. @@ -154,27 +154,68 @@ (insert-char ?\t count) (indent-to (* tab-width (+ count (/ (current-column) tab-width))))))) -(defun indent-rigidly (start end arg) +(defun indent-rigidly--current-indentation (beg end) + "Return the smallest indentation in range from BEG to END. +Blank lines are ignored." + (save-excursion + (save-match-data + (let ((beg (progn (goto-char beg) (line-beginning-position))) + indent) + (goto-char beg) + (while (re-search-forward "^\\s-*[[:print:]]" end t) + (setq indent (min (or indent (current-indentation)) + (current-indentation)))) + indent)))) + +(defvar indent-rigidly-map + (let ((map (make-sparse-keymap))) + (define-key map [left] + (lambda (beg end) (interactive "r") (indent-rigidly beg end -1))) + + (define-key map [right] + (lambda (beg end) (interactive "r") (indent-rigidly beg end 1))) + + (define-key map [S-right] + (lambda (beg end) (interactive "r") + (let* ((current (indent-rigidly--current-indentation beg end)) + (next (indent--next-tab-stop current))) + (indent-rigidly beg end (- next current))))) + + (define-key map [S-left] + (lambda (beg end) (interactive "r") + (let* ((current (indent-rigidly--current-indentation beg end)) + (next (indent--next-tab-stop current 'prev))) + (indent-rigidly beg end (- next current))))) + map)) + +(defun indent-rigidly (start end arg &optional interactive) "Indent all lines starting in the region sideways by ARG columns. Called from a program, takes three arguments, START, END and ARG. -You can remove all indentation from a region by giving a large negative ARG." - (interactive "r\np") - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (or (bolp) (forward-line 1)) - (while (< (point) end) - (let ((indent (current-indentation)) - eol-flag) - (save-excursion - (skip-chars-forward " \t") - (setq eol-flag (eolp))) - (or eol-flag - (indent-to (max 0 (+ indent arg)) 0)) - (delete-region (point) (progn (skip-chars-forward " \t") (point)))) - (forward-line 1)) - (move-marker end nil))) +You can remove all indentation from a region by giving a large negative ARG. +If used interactively and no prefix argument is given, use a transient +mode that lets you move the text with cursor keys." + (interactive "r\nP\np") + (if (and (not arg) interactive) + (progn + (message "Edit region indentation with , , \ +and .") + (set-temporary-overlay-map indent-rigidly-map t)) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (or (bolp) (forward-line 1)) + (while (< (point) end) + (let ((indent (current-indentation)) + eol-flag) + (save-excursion + (skip-chars-forward " \t") + (setq eol-flag (eolp))) + (or eol-flag + (indent-to (max 0 (+ indent arg)) 0)) + (delete-region (point) (progn (skip-chars-forward " \t") (point)))) + (forward-line 1)) + (move-marker end nil)))) (defun indent-line-to (column) "Indent current line to COLUMN. @@ -405,6 +446,7 @@ column to indent to; if it is nil, use one of the three methods above." (interactive "r\nP") (cond + ;; If a numeric prefix is given, indent to that column. (column (setq column (prefix-numeric-value column)) (save-excursion @@ -416,8 +458,9 @@ (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) (indent-to column 0)) - (forward-line 1)) + (forward-line 1)) (move-marker end nil))) + ;; If a fill-prefix is specified, use it. (fill-prefix (save-excursion (goto-char end) @@ -429,17 +472,23 @@ (and (bolp) (eolp)) (insert fill-prefix)) (forward-line 1))))) + ;; Use indent-region-function is available. (indent-region-function (funcall indent-region-function start end)) + ;; Else, use a default implementation that calls indent-line-function on + ;; each line. (t (save-excursion (setq end (copy-marker end)) (goto-char start) + (let ((pr (make-progress-reporter "Indenting region..." (point) end))) (while (< (point) end) (or (and (bolp) (eolp)) (indent-according-to-mode)) - (forward-line 1)) - (move-marker end nil)))) + (forward-line 1) + (progress-reporter-update pr (point))) + (progress-reporter-done pr) + (move-marker end nil))))) ;; In most cases, reindenting modifies the buffer, but it may also ;; leave it unmodified, in which case we have to deactivate the mark ;; by hand. @@ -493,9 +542,12 @@ (tab-to-tab-stop)))) (defcustom tab-stop-list - '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120) + nil "List of tab stop positions used by `tab-to-tab-stop'. -This should be a list of integers, ordered from smallest to largest." +This should be a list of integers, ordered from smallest to largest. +It implicitly extends to infinity by repeating the last step (e.g. '(1 2 5) +is equivalent to '(1 2 5 8 11)). +If the list has less than 2 elements, `tab-width' is used as the \"last step\"." :group 'indent :type '(repeat integer)) (put 'tab-stop-list 'safe-local-variable 'listp) @@ -520,8 +572,7 @@ (setq edit-tab-stops-buffer (current-buffer)) (switch-to-buffer (get-buffer-create "*Tab Stops*")) (use-local-map edit-tab-stops-map) - (make-local-variable 'indent-tabs-mode) - (setq indent-tabs-mode nil) + (setq-local indent-tabs-mode nil) (overwrite-mode 1) (setq truncate-lines t) (erase-buffer) @@ -557,6 +608,29 @@ (setq tab-stop-list tabs)) (message "Tab stops installed")) +(defun indent--next-tab-stop (column &optional prev) + "Return the next tab stop after COLUMN. +If PREV is non-nil, return the previous one instead." + (let ((tabs tab-stop-list)) + (while (and tabs (>= column (car tabs))) + (setq tabs (cdr tabs))) + (if tabs + (if (not prev) + (car tabs) + (let ((prevtabs (cdr (memq (car tabs) (reverse tab-stop-list))))) + (if (null prevtabs) 0 + (if (= column (car prevtabs)) + (or (nth 1 prevtabs) 0) + (car prevtabs))))) + ;; We passed the end of tab-stop-list: guess a continuation. + (let* ((last2 (last tab-stop-list 2)) + (step (if (cdr last2) (- (cadr last2) (car last2)) tab-width)) + (last (or (cadr last2) (car last2) 0))) + ;; Repeat the last tab's length. + (+ last (* step (if prev + (if (<= column last) -1 (/ (- column last 1) step)) + (1+ (/ (- column last) step))))))))) + (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. @@ -564,37 +638,29 @@ (interactive) (and abbrev-mode (= (char-syntax (preceding-char)) ?w) (expand-abbrev)) - (let ((tabs tab-stop-list)) - (while (and tabs (>= (current-column) (car tabs))) - (setq tabs (cdr tabs))) - (if tabs - (progn - (delete-horizontal-space t) - (indent-to (car tabs))) - (insert ?\s)))) + (let ((nexttab (indent--next-tab-stop (current-column)))) + (delete-horizontal-space t) + (indent-to nexttab))) (defun move-to-tab-stop () "Move point to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \\[edit-tab-stops] to edit them interactively." (interactive) - (let ((tabs tab-stop-list)) - (while (and tabs (>= (current-column) (car tabs))) - (setq tabs (cdr tabs))) - (if tabs - (let ((before (point))) - (move-to-column (car tabs) t) - (save-excursion - (goto-char before) - ;; If we just added a tab, or moved over one, - ;; delete any superfluous spaces before the old point. - (if (and (eq (preceding-char) ?\s) - (eq (following-char) ?\t)) - (let ((tabend (* (/ (current-column) tab-width) tab-width))) - (while (and (> (current-column) tabend) - (eq (preceding-char) ?\s)) - (forward-char -1)) - (delete-region (point) before)))))))) + (let ((nexttab (indent--next-tab-stop (current-column)))) + (let ((before (point))) + (move-to-column nexttab t) + (save-excursion + (goto-char before) + ;; If we just added a tab, or moved over one, + ;; delete any superfluous spaces before the old point. + (if (and (eq (preceding-char) ?\s) + (eq (following-char) ?\t)) + (let ((tabend (* (/ (current-column) tab-width) tab-width))) + (while (and (> (current-column) tabend) + (eq (preceding-char) ?\s)) + (forward-char -1)) + (delete-region (point) before))))))) (define-key global-map "\t" 'indent-for-tab-command) (define-key esc-map "\C-\\" 'indent-region) ------------------------------------------------------------ revno: 114576 committer: Jan D. branch nick: trunk timestamp: Tue 2013-10-08 08:12:40 +0200 message: * nsterm.m (windowDidExitFullScreen:): (toggleFullScreen:): Change NS_IMPL_COCOA to HAVE_NATIVE_FS. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 05:26:41 +0000 +++ src/ChangeLog 2013-10-08 06:12:40 +0000 @@ -1,3 +1,8 @@ +2013-10-08 Jan Djärv + + * nsterm.m (windowDidExitFullScreen:): + (toggleFullScreen:): Change NS_IMPL_COCOA to HAVE_NATIVE_FS. + 2013-10-08 Paul Eggert Fix race where emacs aborts when sent SIGTERM (Bug#15534). === modified file 'src/nsterm.m' --- src/nsterm.m 2013-10-07 20:00:25 +0000 +++ src/nsterm.m 2013-10-08 06:12:40 +0000 @@ -6160,7 +6160,7 @@ { [self setFSValue: fs_before_fs]; fs_before_fs = -1; -#ifdef NS_IMPL_COCOA +#ifdef HAVE_NATIVE_FS [self updateCollectionBehaviour]; #endif if (FRAME_EXTERNAL_TOOL_BAR (emacsframe)) @@ -6221,7 +6221,7 @@ if (fs_is_native) { -#ifdef NS_IMPL_COCOA +#ifdef HAVE_NATIVE_FS [[self window] toggleFullScreen:sender]; #endif return; ------------------------------------------------------------ revno: 114575 committer: Bastien Guerry branch nick: trunk timestamp: Tue 2013-10-08 08:02:20 +0200 message: * register.el (insert-register): Fix revno:114543. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 05:10:10 +0000 +++ lisp/ChangeLog 2013-10-08 06:02:20 +0000 @@ -1,3 +1,7 @@ +2013-10-08 Bastien Guerry + + * register.el (insert-register): Fix revno:114543. + 2013-10-08 Stefan Monnier * progmodes/perl-mode.el: Use lexical-binding. === modified file 'lisp/register.el' --- lisp/register.el 2013-10-07 03:34:26 +0000 +++ lisp/register.el 2013-10-08 06:02:20 +0000 @@ -395,8 +395,8 @@ Interactively, second arg is non-nil if prefix arg is supplied." (interactive (progn (barf-if-buffer-read-only) - (register-read-with-preview "Insert register: ") - current-prefix-arg)) + (list (register-read-with-preview "Insert register: ") + current-prefix-arg))) (push-mark) (let ((val (get-register register))) (cond ------------------------------------------------------------ revno: 114574 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-10-07 22:26:41 -0700 message: Complete ChangeLog entry that was inadvertently truncated. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 05:13:21 +0000 +++ src/ChangeLog 2013-10-08 05:26:41 +0000 @@ -8,6 +8,9 @@ All uses of 'size_t' and 'SIZE_MAX' changed to use them, when they're talking about words in Lisp bool vectors. (BITS_PER_BITS_WORD): Rename from BITS_PER_SIZE_T. All uses changed. + * data.c (popcount_bits_word): Rename from popcount_size_t. + (bits_word_to_host_endian): Rename from size_t_to_host_endian. + All uses changed. 2013-10-07 Paul Eggert ------------------------------------------------------------ revno: 114573 fixes bug: http://debbugs.gnu.org/15534 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-10-07 22:13:21 -0700 message: Fix race where emacs aborts when sent SIGTERM. * keyboard.c (unblock_input_to): Don't process pending signals if a fatal error is in progress. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 04:25:33 +0000 +++ src/ChangeLog 2013-10-08 05:13:21 +0000 @@ -1,5 +1,9 @@ 2013-10-08 Paul Eggert + Fix race where emacs aborts when sent SIGTERM (Bug#15534). + * keyboard.c (unblock_input_to): Don't process pending signals + if a fatal error is in progress. + * lisp.h (bits_word, BITS_WORD_MAX): New type and macro. All uses of 'size_t' and 'SIZE_MAX' changed to use them, when they're talking about words in Lisp bool vectors. === modified file 'src/keyboard.c' --- src/keyboard.c 2013-09-24 06:43:20 +0000 +++ src/keyboard.c 2013-10-08 05:13:21 +0000 @@ -7090,7 +7090,8 @@ } /* Undo any number of BLOCK_INPUT calls down to level LEVEL, - and also (if the level is now 0) reinvoke any pending signal. */ + and reinvoke any pending signal if the level is now 0 and + a fatal error is not already in progress. */ void unblock_input_to (int level) @@ -7098,7 +7099,7 @@ interrupt_input_blocked = level; if (level == 0) { - if (pending_signals) + if (pending_signals && !fatal_error_in_progress) process_pending_signals (); } else if (level < 0) ------------------------------------------------------------ revno: 114572 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-10-07 22:12:29 -0700 message: ChangeLog consistency. diff: === modified file 'ChangeLog' --- ChangeLog 2013-10-07 21:37:19 +0000 +++ ChangeLog 2013-10-08 05:12:29 +0000 @@ -12,7 +12,7 @@ 2013-10-04 Paul Eggert - Use hardware insns for byteswapping on glibc hosts that support it. + Use hardware support for byteswapping on glibc x86 etc. * lib/byteswap.in.h, m4/byteswap.m4: New files, copied from Gnulib. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. ------------------------------------------------------------ revno: 114571 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 01:10:10 -0400 message: * lisp/progmodes/perl-mode.el: Use lexical-binding. Remove redundant :group args. (perl-nochange): Change default to be closer to other major modes's standard behavior. (perl-indent-line): Don't consider text on current line as a valid beginning of function from which to indent. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 04:30:31 +0000 +++ lisp/ChangeLog 2013-10-08 05:10:10 +0000 @@ -1,5 +1,12 @@ 2013-10-08 Stefan Monnier + * progmodes/perl-mode.el: Use lexical-binding. + Remove redundant :group args. + (perl-nochange): Change default to be closer to other major modes's + standard behavior. + (perl-indent-line): Don't consider text on current line as a + valid beginning of function from which to indent. + * emacs-lisp/backquote.el (backquote-process): Catch uses of , and ,@ with more than one argument (bug#15538). === modified file 'lisp/progmodes/perl-mode.el' --- lisp/progmodes/perl-mode.el 2013-06-18 22:13:25 +0000 +++ lisp/progmodes/perl-mode.el 2013-10-08 05:10:10 +0000 @@ -1,4 +1,4 @@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc. @@ -127,7 +127,7 @@ (modify-syntax-entry ?\n ">" st) (modify-syntax-entry ?# "<" st) ;; `$' is also a prefix char so I was tempted to say "/ p", - ;; but the `p' thingy basically overrides the `/' :-( --stef + ;; but the `p' thingy basically overrides the `/' :-( -- Stef (modify-syntax-entry ?$ "/" st) (modify-syntax-entry ?% ". p" st) (modify-syntax-entry ?@ ". p" st) @@ -494,8 +494,7 @@ (defcustom perl-indent-level 4 "Indentation of Perl statements with respect to containing block." - :type 'integer - :group 'perl) + :type 'integer) ;; Is is not unusual to put both things like perl-indent-level and ;; cperl-indent-level in the local variable section of a file. If only @@ -511,45 +510,37 @@ (defcustom perl-continued-statement-offset 4 "Extra indent for lines not starting new statements." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-continued-brace-offset -4 "Extra indent for substatements that start with open-braces. This is in addition to `perl-continued-statement-offset'." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-offset 0 "Extra indentation for braces, compared with other text in same context." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-imaginary-offset 0 "Imagined indentation of an open brace that actually follows a statement." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-label-offset -2 "Offset of Perl label lines relative to usual indentation." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-indent-continued-arguments nil "If non-nil offset of argument lines relative to usual indentation. If nil, continued arguments are aligned with the first argument." - :type '(choice integer (const nil)) - :group 'perl) + :type '(choice integer (const nil))) (defcustom perl-indent-parens-as-block nil "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks. The closing bracket is aligned with the line of the opening bracket, not the contents of the brackets." :version "24.3" - :type 'boolean - :group 'perl) + :type 'boolean) (defcustom perl-tab-always-indent tab-always-indent "Non-nil means TAB in Perl mode always indents the current line. Otherwise it inserts a tab character if you type it past the first nonwhite character on the line." - :type 'boolean - :group 'perl) + :type 'boolean) ;; I changed the default to nil for consistency with general Emacs ;; conventions -- rms. @@ -558,13 +549,12 @@ For lines which don't need indenting, TAB either indents an existing comment, moves to end-of-line, or if at end-of-line already, create a new comment." - :type 'boolean - :group 'perl) + :type 'boolean) -(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]" +(defcustom perl-nochange "\f" "Lines starting with this regular expression are not auto-indented." :type 'regexp - :group 'perl) + :options '(";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]")) ;; Outline support @@ -685,7 +675,7 @@ (define-obsolete-function-alias 'electric-perl-terminator 'perl-electric-terminator "22.1") -(defun perl-electric-noindent-p (char) +(defun perl-electric-noindent-p (_char) (unless (eolp) 'no-indent)) (defun perl-electric-terminator (arg) @@ -803,7 +793,11 @@ changed by, or (parse-state) if line starts in a quoted string." (let ((case-fold-search nil) (pos (- (point-max) (point))) - (bof (or parse-start (save-excursion (perl-beginning-of-function)))) + (bof (or parse-start (save-excursion + ;; Don't consider text on this line as a + ;; valid BOF from which to indent. + (goto-char (line-end-position 0)) + (perl-beginning-of-function)))) beg indent shift-amt) (beginning-of-line) (setq beg (point)) ------------------------------------------------------------ revno: 114570 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15538 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 00:30:31 -0400 message: * lisp/emacs-lisp/backquote.el (backquote-process): Catch uses of , and ,@ with more than one argument. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 03:48:01 +0000 +++ lisp/ChangeLog 2013-10-08 04:30:31 +0000 @@ -1,5 +1,8 @@ 2013-10-08 Stefan Monnier + * emacs-lisp/backquote.el (backquote-process): Catch uses of , and ,@ + with more than one argument (bug#15538). + * mpc.el (mpc-songs-jump-to): Adjust to different playlist format. * vc/pcvs.el: Use lexical-binding. === modified file 'lisp/emacs-lisp/backquote.el' --- lisp/emacs-lisp/backquote.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lisp/backquote.el 2013-10-08 04:30:31 +0000 @@ -153,11 +153,18 @@ (list 'quote s)))) ((eq (car s) backquote-unquote-symbol) (if (<= level 0) - (cons 1 (nth 1 s)) + (if (> (length s) 2) + ;; We could support it with: (cons 2 `(list . ,(cdr s))) + ;; But let's not encourage such uses. + (error "Multiple args to , are not supported: %S" s) + (cons 1 (nth 1 s))) (backquote-delay-process s (1- level)))) ((eq (car s) backquote-splice-symbol) (if (<= level 0) - (cons 2 (nth 1 s)) + (if (> (length s) 2) + ;; (cons 2 `(append . ,(cdr s))) + (error "Multiple args to ,@ are not supported: %S" s) + (cons 2 (nth 1 s))) (backquote-delay-process s (1- level)))) ((eq (car s) backquote-backquote-symbol) (backquote-delay-process s (1+ level))) ------------------------------------------------------------ revno: 114569 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-10-07 21:25:33 -0700 message: * lisp.h (bits_word, BITS_WORD_MAX): New type and macro. All uses of 'size_t' and 'SIZE_MAX' changed to use them, when they're talking about words in Lisp bool vectors. (BITS_PER_BITS_WORD): Rename from BITS_PER_SIZE_T. All uses changed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-07 21:37:19 +0000 +++ src/ChangeLog 2013-10-08 04:25:33 +0000 @@ -1,3 +1,10 @@ +2013-10-08 Paul Eggert + + * lisp.h (bits_word, BITS_WORD_MAX): New type and macro. + All uses of 'size_t' and 'SIZE_MAX' changed to use them, when + they're talking about words in Lisp bool vectors. + (BITS_PER_BITS_WORD): Rename from BITS_PER_SIZE_T. All uses changed. + 2013-10-07 Paul Eggert Improve support for popcount and counting trailing zeros (Bug#15550). === modified file 'src/alloc.c' --- src/alloc.c 2013-10-07 10:27:48 +0000 +++ src/alloc.c 2013-10-08 04:25:33 +0000 @@ -2017,8 +2017,8 @@ return val; } -verify (sizeof (size_t) * CHAR_BIT == BITS_PER_SIZE_T); -verify ((BITS_PER_SIZE_T & (BITS_PER_SIZE_T - 1)) == 0); +verify (sizeof (size_t) * CHAR_BIT == BITS_PER_BITS_WORD); +verify ((BITS_PER_BITS_WORD & (BITS_PER_BITS_WORD - 1)) == 0); static ptrdiff_t bool_vector_payload_bytes (ptrdiff_t nr_bits, @@ -2030,14 +2030,14 @@ eassert (nr_bits >= 0); exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT; - needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_SIZE_T) / CHAR_BIT; + needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_BITS_WORD) / CHAR_BIT; if (needed_bytes == 0) { /* Always allocate at least one machine word of payload so that bool-vector operations in data.c don't need a special case for empty vectors. */ - needed_bytes = sizeof (size_t); + needed_bytes = sizeof (bits_word); } if (exact_needed_bytes_out != NULL) === modified file 'src/data.c' --- src/data.c 2013-10-07 21:37:19 +0000 +++ src/data.c 2013-10-08 04:25:33 +0000 @@ -2963,24 +2963,24 @@ /* Because we round up the bool vector allocate size to word_size units, we can safely read past the "end" of the vector in the operations below. These extra bits are always zero. Also, we - always allocate bool vectors with at least one size_t of storage so + always allocate bool vectors with at least one bits_word of storage so that we don't have to special-case empty bit vectors. */ -static size_t +static bits_word bool_vector_spare_mask (ptrdiff_t nr_bits) { eassert (nr_bits > 0); - return (((size_t) 1) << (nr_bits % BITS_PER_SIZE_T)) - 1; + return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1; } -#if SIZE_MAX <= UINT_MAX -# define popcount_size_t count_one_bits -#elif SIZE_MAX <= ULONG_MAX -# define popcount_size_t count_one_bits_l -#elif SIZE_MAX <= ULLONG_MAX -# define popcount_size_t count_one_bits_ll +#if BITS_WORD_MAX <= UINT_MAX +# define popcount_bits_word count_one_bits +#elif BITS_WORD_MAX <= ULONG_MAX +# define popcount_bits_word count_one_bits_l +#elif BITS_WORD_MAX <= ULLONG_MAX +# define popcount_bits_word count_one_bits_ll #else -# error "size_t wider than long long? Please file a bug report." +# error "bits_word wider than long long? Please file a bug report." #endif enum bool_vector_op { bool_vector_exclusive_or, @@ -2996,10 +2996,10 @@ enum bool_vector_op op) { EMACS_INT nr_bits; - size_t *adata, *bdata, *cdata; + bits_word *adata, *bdata, *cdata; ptrdiff_t i; - size_t changed = 0; - size_t mword; + bits_word changed = 0; + bits_word mword; ptrdiff_t nr_words; CHECK_BOOL_VECTOR (op1); @@ -3020,11 +3020,11 @@ } eassert (nr_bits >= 0); - nr_words = ROUNDUP (nr_bits, BITS_PER_SIZE_T) / BITS_PER_SIZE_T; + nr_words = ROUNDUP (nr_bits, BITS_PER_BITS_WORD) / BITS_PER_BITS_WORD; - adata = (size_t *) XBOOL_VECTOR (dest)->data; - bdata = (size_t *) XBOOL_VECTOR (op1)->data; - cdata = (size_t *) XBOOL_VECTOR (op2)->data; + adata = (bits_word *) XBOOL_VECTOR (dest)->data; + bdata = (bits_word *) XBOOL_VECTOR (op1)->data; + cdata = (bits_word *) XBOOL_VECTOR (op2)->data; i = 0; do { @@ -3054,47 +3054,47 @@ /* Compute the number of trailing zero bits in val. If val is zero, return the number of bits in val. */ static int -count_trailing_zero_bits (size_t val) +count_trailing_zero_bits (bits_word val) { - if (SIZE_MAX == UINT_MAX) + if (BITS_WORD_MAX == UINT_MAX) return count_trailing_zeros (val); - if (SIZE_MAX == ULONG_MAX) + if (BITS_WORD_MAX == ULONG_MAX) return count_trailing_zeros_l (val); # if HAVE_UNSIGNED_LONG_LONG_INT - if (SIZE_MAX == ULLONG_MAX) + if (BITS_WORD_MAX == ULLONG_MAX) return count_trailing_zeros_ll (val); # endif - /* The rest of this code is for the unlikely platform where size_t differs + /* The rest of this code is for the unlikely platform where bits_word differs in width from unsigned int, unsigned long, and unsigned long long. */ if (val == 0) return CHAR_BIT * sizeof (val); - if (SIZE_MAX <= UINT_MAX) + if (BITS_WORD_MAX <= UINT_MAX) return count_trailing_zeros (val); - if (SIZE_MAX <= ULONG_MAX) + if (BITS_WORD_MAX <= ULONG_MAX) return count_trailing_zeros_l (val); { # if HAVE_UNSIGNED_LONG_LONG_INT - verify (SIZE_MAX <= ULLONG_MAX); + verify (BITS_WORD_MAX <= ULLONG_MAX); return count_trailing_zeros_ll (val); # else - verify (SIZE_MAX <= ULONG_MAX); + verify (BITS_WORD_MAX <= ULONG_MAX); # endif } } -static size_t -size_t_to_host_endian (size_t val) +static bits_word +bits_word_to_host_endian (bits_word val) { #ifndef WORDS_BIGENDIAN return val; -#elif SIZE_MAX >> 31 == 1 +#elif BITS_WORD_MAX >> 31 == 1 return bswap_32 (val); -#elif SIZE_MAX >> 31 >> 31 >> 1 == 1 +#elif BITS_WORD_MAX >> 31 >> 31 >> 1 == 1 return bswap_64 (val); #else int i; - size_t r = 0; + bits_word r = 0; for (i = 0; i < sizeof val; i++) { r = (r << CHAR_BIT) | (val & ((1u << CHAR_BIT) - 1)); @@ -3167,9 +3167,9 @@ (Lisp_Object a, Lisp_Object b) { EMACS_INT nr_bits; - size_t *bdata, *adata; + bits_word *bdata, *adata; ptrdiff_t i; - size_t mword; + bits_word mword; CHECK_BOOL_VECTOR (a); nr_bits = XBOOL_VECTOR (a)->size; @@ -3182,20 +3182,20 @@ nr_bits = min (nr_bits, XBOOL_VECTOR (b)->size); } - bdata = (size_t *) XBOOL_VECTOR (b)->data; - adata = (size_t *) XBOOL_VECTOR (a)->data; + bdata = (bits_word *) XBOOL_VECTOR (b)->data; + adata = (bits_word *) XBOOL_VECTOR (a)->data; eassert (nr_bits >= 0); - for (i = 0; i < nr_bits / BITS_PER_SIZE_T; i++) + for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; i++) bdata[i] = ~adata[i]; - if (nr_bits % BITS_PER_SIZE_T) + if (nr_bits % BITS_PER_BITS_WORD) { - mword = size_t_to_host_endian (adata[i]); + mword = bits_word_to_host_endian (adata[i]); mword = ~mword; mword &= bool_vector_spare_mask (nr_bits); - bdata[i] = size_t_to_host_endian (mword); + bdata[i] = bits_word_to_host_endian (mword); } return b; @@ -3209,28 +3209,28 @@ { ptrdiff_t count; EMACS_INT nr_bits; - size_t *adata; - size_t match; + bits_word *adata; + bits_word match; ptrdiff_t i; CHECK_BOOL_VECTOR (a); nr_bits = XBOOL_VECTOR (a)->size; count = 0; - match = NILP (b) ? (size_t) -1 : 0; - adata = (size_t *) XBOOL_VECTOR (a)->data; + match = NILP (b) ? -1 : 0; + adata = (bits_word *) XBOOL_VECTOR (a)->data; eassert (nr_bits >= 0); - for (i = 0; i < nr_bits / BITS_PER_SIZE_T; ++i) - count += popcount_size_t (adata[i] ^ match); + for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; ++i) + count += popcount_bits_word (adata[i] ^ match); /* Mask out trailing parts of final mword. */ - if (nr_bits % BITS_PER_SIZE_T) + if (nr_bits % BITS_PER_BITS_WORD) { - size_t mword = adata[i] ^ match; - mword = size_t_to_host_endian (mword); - count += popcount_size_t (mword & bool_vector_spare_mask (nr_bits)); + bits_word mword = adata[i] ^ match; + mword = bits_word_to_host_endian (mword); + count += popcount_bits_word (mword & bool_vector_spare_mask (nr_bits)); } return make_number (count); @@ -3247,9 +3247,9 @@ ptrdiff_t count; EMACS_INT nr_bits; ptrdiff_t offset; - size_t *adata; - size_t twiddle; - size_t mword; /* Machine word. */ + bits_word *adata; + bits_word twiddle; + bits_word mword; /* Machine word. */ ptrdiff_t pos; ptrdiff_t nr_words; @@ -3260,30 +3260,30 @@ if (XFASTINT (i) > nr_bits) /* Allow one past the end for convenience */ args_out_of_range (a, i); - adata = (size_t *) XBOOL_VECTOR (a)->data; + adata = (bits_word *) XBOOL_VECTOR (a)->data; assume (nr_bits >= 0); - nr_words = ROUNDUP (nr_bits, BITS_PER_SIZE_T) / BITS_PER_SIZE_T; + nr_words = ROUNDUP (nr_bits, BITS_PER_BITS_WORD) / BITS_PER_BITS_WORD; - pos = XFASTINT (i) / BITS_PER_SIZE_T; - offset = XFASTINT (i) % BITS_PER_SIZE_T; + pos = XFASTINT (i) / BITS_PER_BITS_WORD; + offset = XFASTINT (i) % BITS_PER_BITS_WORD; count = 0; /* By XORing with twiddle, we transform the problem of "count consecutive equal values" into "count the zero bits". The latter operation usually has hardware support. */ - twiddle = NILP (b) ? 0 : (size_t) -1; + twiddle = NILP (b) ? 0 : -1; /* Scan the remainder of the mword at the current offset. */ if (pos < nr_words && offset != 0) { - mword = size_t_to_host_endian (adata[pos]); + mword = bits_word_to_host_endian (adata[pos]); mword ^= twiddle; mword >>= offset; count = count_trailing_zero_bits (mword); - count = min (count, BITS_PER_SIZE_T - offset); + count = min (count, BITS_PER_BITS_WORD - offset); pos++; - if (count + offset < BITS_PER_SIZE_T) + if (count + offset < BITS_PER_BITS_WORD) return make_number (count); } @@ -3292,7 +3292,7 @@ endian-independent. */ while (pos < nr_words && adata[pos] == twiddle) { - count += BITS_PER_SIZE_T; + count += BITS_PER_BITS_WORD; ++pos; } @@ -3300,16 +3300,16 @@ { /* If we stopped because of a mismatch, see how many bits match in the current mword. */ - mword = size_t_to_host_endian (adata[pos]); + mword = bits_word_to_host_endian (adata[pos]); mword ^= twiddle; count += count_trailing_zero_bits (mword); } - else if (nr_bits % BITS_PER_SIZE_T != 0) + else if (nr_bits % BITS_PER_BITS_WORD != 0) { /* If we hit the end, we might have overshot our count. Reduce the total by the number of spare bits at the end of the vector. */ - count -= BITS_PER_SIZE_T - nr_bits % BITS_PER_SIZE_T; + count -= BITS_PER_BITS_WORD - nr_bits % BITS_PER_BITS_WORD; } return make_number (count); === modified file 'src/lisp.h' --- src/lisp.h 2013-10-07 21:37:19 +0000 +++ src/lisp.h 2013-10-08 04:25:33 +0000 @@ -64,6 +64,11 @@ # endif #endif +/* An unsigned integer type representing a fixed-length bit sequence, + suitable for words in a Lisp bool vector. */ +typedef size_t bits_word; +#define BITS_WORD_MAX SIZE_MAX + /* Number of bits in some machine integer types. */ enum { @@ -71,7 +76,7 @@ BITS_PER_SHORT = CHAR_BIT * sizeof (short), BITS_PER_INT = CHAR_BIT * sizeof (int), BITS_PER_LONG = CHAR_BIT * sizeof (long int), - BITS_PER_SIZE_T = CHAR_BIT * sizeof (size_t), + BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word), BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) }; ------------------------------------------------------------ revno: 114568 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 23:48:01 -0400 message: * lisp/mpc.el (mpc-songs-jump-to): Adjust to different playlist format. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-08 03:47:24 +0000 +++ lisp/ChangeLog 2013-10-08 03:48:01 +0000 @@ -1,5 +1,7 @@ 2013-10-08 Stefan Monnier + * mpc.el (mpc-songs-jump-to): Adjust to different playlist format. + * vc/pcvs.el: Use lexical-binding. (cvs-temp-buffer, cvs-make-cvs-buffer): Pass some vars in the lexical environment of `eval'. === modified file 'lisp/mpc.el' --- lisp/mpc.el 2013-09-18 04:44:20 +0000 +++ lisp/mpc.el 2013-10-08 03:48:01 +0000 @@ -2009,7 +2009,9 @@ posn)))) (let* ((plbuf (mpc-proc-cmd "playlist")) (re (if song-file - (concat "^\\([0-9]+\\):" (regexp-quote song-file) "$"))) + ;; Newer MPCs apparently include "file: " in the buffer. + (concat "^\\([0-9]+\\):\\(?:file: \\)?" + (regexp-quote song-file) "$"))) (sn (with-current-buffer plbuf (goto-char (point-min)) (when (and re (re-search-forward re nil t)) ------------------------------------------------------------ revno: 114567 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 23:47:24 -0400 message: * lisp/vc/pcvs.el: Use lexical-binding. (cvs-temp-buffer, cvs-make-cvs-buffer): Pass some vars in the lexical environment of `eval'. (cvs-mode-run, cvs-mode-do): Change `postproc' to be a function rather than a list of expressions. Adjust callers. * lisp/vc/pcvs-defs.el (cvs-postprocess): Remove, unused. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 23:01:23 +0000 +++ lisp/ChangeLog 2013-10-08 03:47:24 +0000 @@ -1,8 +1,16 @@ +2013-10-08 Stefan Monnier + + * vc/pcvs.el: Use lexical-binding. + (cvs-temp-buffer, cvs-make-cvs-buffer): Pass some vars in the lexical + environment of `eval'. + (cvs-mode-run, cvs-mode-do): Change `postproc' to be a function rather + than a list of expressions. Adjust callers. + * vc/pcvs-defs.el (cvs-postprocess): Remove, unused. + 2013-10-07 Dmitry Gutov * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Handle the - case of the dot in a chained method call being on the following - line. + case of the dot in a chained method call being on the following line. 2013-10-07 Stefan Monnier === modified file 'lisp/vc/pcvs-defs.el' --- lisp/vc/pcvs-defs.el 2013-01-01 09:11:05 +0000 +++ lisp/vc/pcvs-defs.el 2013-10-08 03:47:24 +0000 @@ -245,13 +245,6 @@ ;;;; -;;;; Internal variables, used in the process buffer. -;;;; - -(defvar cvs-postprocess nil - "(Buffer local) what to do once the process exits.") - -;;;; ;;;; Internal variables for the *cvs* buffer. ;;;; === modified file 'lisp/vc/pcvs.el' --- lisp/vc/pcvs.el 2013-09-20 05:39:53 +0000 +++ lisp/vc/pcvs.el 2013-10-08 03:47:24 +0000 @@ -1,4 +1,4 @@ -;;; pcvs.el --- a front-end to CVS +;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*- ;; Copyright (C) 1991-2013 Free Software Foundation, Inc. @@ -349,7 +349,7 @@ from the current buffer." (let* ((cvs-buf (current-buffer)) (info (cdr (assoc cmd cvs-buffer-name-alist))) - (name (eval (nth 0 info))) + (name (eval (nth 0 info) `((cmd . ,cmd)))) (mode (nth 1 info)) (dir default-directory) (buf (cond @@ -359,9 +359,10 @@ (t (set (make-local-variable 'cvs-temp-buffer) (cvs-get-buffer-create - (eval cvs-temp-buffer-name) 'noreuse)))))) + (eval cvs-temp-buffer-name `((dir . ,dir))) + 'noreuse)))))) - ;; handle the potential pre-existing process + ;; Handle the potential pre-existing process. (let ((proc (get-buffer-process buf))) (when (and (not normal) (processp proc) (memq (process-status proc) '(run stop))) @@ -416,7 +417,7 @@ If non-nil, NEW means to create a new buffer no matter what." ;; the real cvs-buffer creation (setq dir (cvs-expand-dir-name dir)) - (let* ((buffer-name (eval cvs-buffer-name)) + (let* ((buffer-name (eval cvs-buffer-name `((dir . ,dir)))) (buffer (or (and (not new) (eq cvs-reuse-cvs-buffer 'current) @@ -569,9 +570,9 @@ process 'cvs-postprocess (if (null rest) ;; this is the last invocation - postprocess + postprocess ;; else, we have to register ourselves to be rerun on the rest - `(cvs-run-process ',args ',rest ',postprocess ',single-dir))) + (lambda () (cvs-run-process args rest postprocess single-dir)))) (set-process-sentinel process 'cvs-sentinel) (set-process-filter process 'cvs-update-filter) (set-marker (process-mark process) (point-max)) @@ -675,7 +676,8 @@ (error "cvs' process buffer was killed") (with-current-buffer procbuf ;; Do the postprocessing like parsing and such. - (save-excursion (eval cvs-postproc))))))) + (save-excursion + (funcall cvs-postproc))))))) ;; Check whether something is left. (when (and procbuf (not (get-buffer-process procbuf))) (with-current-buffer procbuf @@ -755,7 +757,8 @@ - NOARGS will get all the arguments from the *cvs* buffer and will always behave as if called interactively. - DOUBLE is the generic case." - (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body)) + (declare (debug (&define sexp lambda-list stringp + ("interactive" interactive) def-body)) (doc-string 3)) (let ((style (cvs-cdr fun)) (fun (cvs-car fun))) @@ -1465,7 +1468,7 @@ (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap) (run-hooks 'cvs-mode-commit-hook))) -(defun cvs-commit-minor-wrap (buf f) +(defun cvs-commit-minor-wrap (_buf f) (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit"))) (funcall f))) @@ -1598,24 +1601,25 @@ (interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags"))) (let ((fis (cvs-mode-marked 'add)) (needdesc nil) (dirs nil)) - ;; find directories and look for fis needing a description + ;; Find directories and look for fis needing a description. (dolist (fi fis) (cond ((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs)) ((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t)))) - ;; prompt for description if necessary + ;; Prompt for description if necessary. (let* ((msg (if (and needdesc (or current-prefix-arg (not cvs-add-default-message))) (read-from-minibuffer "Enter description: ") (or cvs-add-default-message ""))) (flags `("-m" ,msg ,@flags)) (postproc - ;; setup postprocessing for the directory entries + ;; Setup postprocessing for the directory entries. (when dirs - `((cvs-run-process (list "-n" "update") - ',dirs - '(cvs-parse-process t)) - (cvs-mark-fis-dead ',dirs))))) + (lambda () + (cvs-run-process (list "-n" "update") + dirs + (lambda () (cvs-parse-process t))) + (cvs-mark-fis-dead dirs))))) (cvs-mode-run "add" flags fis :postproc postproc)))) (defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags) @@ -1666,10 +1670,7 @@ (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked)))) (unless (consp fis) (error "No files with a backup file selected!")) - ;; let's extract some info into the environment for `buffer-name' - (let* ((dir (cvs-fileinfo->dir (car fis))) - (file (cvs-fileinfo->file (car fis)))) - (set-buffer (cvs-temp-buffer "diff"))) + (set-buffer (cvs-temp-buffer "diff")) (message "cvs diff backup...") (cvs-execute-single-file-list fis 'cvs-diff-backup-extractor cvs-diff-program flags)) @@ -1851,15 +1852,16 @@ ret))) (cl-defun cvs-mode-run (cmd flags fis - &key (buf (cvs-temp-buffer)) - dont-change-disc cvsargs postproc) + &key (buf (cvs-temp-buffer)) + dont-change-disc cvsargs postproc) "Generic cvs-mode- function. Executes `cvs CVSARGS CMD FLAGS FIS'. BUF is the buffer to be used for cvs' output. DONT-CHANGE-DISC non-nil indicates that the command will not change the contents of files. This is only used by the parser. -POSTPROC is a list of expressions to be evaluated at the very end (after - parsing if applicable). It will be prepended with `progn' if necessary." +POSTPROC is a function of no argument to be evaluated at the very end (after + parsing if applicable)." + (unless postproc (setq postproc #'ignore)) (let ((def-dir default-directory)) ;; Save the relevant buffers (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir)))) @@ -1878,14 +1880,17 @@ (cvs-cleanup-collection cvs-cookies ;cleanup remaining messages (eq cvs-auto-remove-handled 'delayed) nil t) (when (fboundp after-mode) - (setq postproc (append postproc `((,after-mode))))) + (setq postproc (let ((pp postproc)) + (lambda () (funcall pp) (funcall after-mode))))) (when parse (let ((old-fis (when (member cmd '("status" "update")) ;FIXME: Yuck!! ;; absence of `cvs update' output has a specific meaning. - (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))) - (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc))) - (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc))) + (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))) + (pp postproc)) + (setq postproc (lambda () + (cvs-parse-process dont-change-disc nil old-fis) + (funcall pp))))) (with-current-buffer buf (let ((inhibit-read-only t)) (erase-buffer)) (message "Running cvs %s ..." cmd) @@ -1893,7 +1898,7 @@ (cl-defun cvs-mode-do (cmd flags filter - &key show dont-change-disc cvsargs postproc) + &key show dont-change-disc cvsargs postproc) "Generic cvs-mode- function. Executes `cvs CVSARGS CMD FLAGS' on the selected files. FILTER is passed to `cvs-applicable-p' to only apply the command to @@ -1915,8 +1920,9 @@ (interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags"))) (cvs-mode-do "status" flags nil :dont-change-disc t :show t :postproc (when (eq cvs-auto-remove-handled 'status) - `((with-current-buffer ,(current-buffer) - (cvs-mode-remove-handled)))))) + (let ((buf (current-buffer))) + (lambda () (with-current-buffer buf + (cvs-mode-remove-handled))))))) (defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags) "Call cvstree using the file under the point as a keyfile." @@ -1924,7 +1930,7 @@ (cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status") :buf (cvs-temp-buffer "tree") :dont-change-disc t - :postproc '((cvs-status-cvstrees)))) + :postproc #'cvs-status-cvstrees)) ;; cvs log @@ -1958,7 +1964,7 @@ (cvs-mode-do "update" flags nil :cvsargs '("-n") :dont-change-disc t)) -(defun-cvs-mode cvs-mode-ignore (&optional pattern) +(defun-cvs-mode cvs-mode-ignore () "Arrange so that CVS ignores the selected files. This command ignores files that are not flagged as `Unknown'." (interactive) @@ -2065,8 +2071,10 @@ (cvs-mode-run "update" flags fis-other :postproc (when fis-removed - `((with-current-buffer ,(current-buffer) - (cvs-mode-run "add" nil ',fis-removed))))))))) + (let ((buf (current-buffer))) + (lambda () + (with-current-buffer buf + (cvs-mode-run "add" nil fis-removed)))))))))) (defun-cvs-mode (cvs-mode-revert-to-rev . NOARGS) (rev) @@ -2077,11 +2085,14 @@ (cvs-flags-query 'cvs-idiff-version))))) (let* ((fis (cvs-mode-marked 'revert "revert" :file t)) (tag (concat "tmp_pcl_tag_" (make-temp-name ""))) - (untag `((with-current-buffer ,(current-buffer) - (cvs-mode-run "tag" (list "-d" ',tag) ',fis)))) - (update `((with-current-buffer ,(current-buffer) - (cvs-mode-run "update" (list "-j" ',tag "-j" ',rev) ',fis - :postproc ',untag))))) + (buf (current-buffer)) + (untag (lambda () + (with-current-buffer buf + (cvs-mode-run "tag" (list "-d" tag) fis)))) + (update (lambda () + (with-current-buffer buf + (cvs-mode-run "update" (list "-j" tag "-j" rev) fis + :postproc untag))))) (cvs-mode-run "tag" (list tag) fis :postproc update))) @@ -2185,7 +2196,8 @@ With prefix argument, prompt for cvs flags." (interactive (list (setq cvs-tag-name - (cvs-query-read cvs-tag-name "Tag to delete: " cvs-qtypedesc-tag)) + (cvs-query-read cvs-tag-name "Tag to delete: " + cvs-qtypedesc-tag)) (cvs-flags-query 'cvs-tag-flags "tag flags"))) (cvs-mode-do "tag" (append '("-d") flags (list tag)) (when cvs-force-dir-tag 'tag))) @@ -2203,6 +2215,7 @@ (byte-compile-file filename)))))) ;; ChangeLog support. +(defvar add-log-buffer-file-name-function) (defun-cvs-mode cvs-mode-add-change-log-entry-other-window () "Add a ChangeLog entry in the ChangeLog of the current directory." ------------------------------------------------------------ revno: 114566 committer: Dmitry Gutov branch nick: trunk timestamp: Tue 2013-10-08 02:03:16 +0300 message: Refine the last change diff: === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-10-07 23:01:23 +0000 +++ lisp/progmodes/ruby-mode.el 2013-10-07 23:03:16 +0000 @@ -293,7 +293,7 @@ ;; Make sure it's not the end of a regexp. (not (eq (car (syntax-after (1- (point)))) 7))) (and (memq (char-before) '(?\? ?=)) - (let ((tok (ruby-smie--backward-token))) + (let ((tok (save-excursion (ruby-smie--backward-token)))) (or (equal tok "?") (string-match "\\`\\s." tok)))) (save-excursion ------------------------------------------------------------ revno: 114565 committer: Dmitry Gutov branch nick: trunk timestamp: Tue 2013-10-08 02:01:23 +0300 message: * lisp/progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Handle the case of the dot in a chained method call being on the following line. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 18:51:26 +0000 +++ lisp/ChangeLog 2013-10-07 23:01:23 +0000 @@ -1,3 +1,9 @@ +2013-10-07 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Handle the + case of the dot in a chained method call being on the following + line. + 2013-10-07 Stefan Monnier * electric.el (electric-indent-inhibit): New var. === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-10-07 16:56:51 +0000 +++ lisp/progmodes/ruby-mode.el 2013-10-07 23:01:23 +0000 @@ -295,7 +295,10 @@ (and (memq (char-before) '(?\? ?=)) (let ((tok (ruby-smie--backward-token))) (or (equal tok "?") - (string-match "\\`\\s." tok)))))))) + (string-match "\\`\\s." tok)))) + (save-excursion + (forward-comment 1) + (eq (char-after) ?.)))))) (defun ruby-smie--redundant-do-p (&optional skip) (save-excursion === modified file 'test/indent/ruby.rb' --- test/indent/ruby.rb 2013-10-07 13:27:29 +0000 +++ test/indent/ruby.rb 2013-10-07 23:01:23 +0000 @@ -137,8 +137,6 @@ foo. bar -# Examples below still fail with `ruby-use-smie' on: - # https://github.com/rails/rails/blob/17f5d8e062909f1fcae25351834d8e89967b645e/activesupport/lib/active_support/time_with_zone.rb#L206 foo .bar @@ -150,6 +148,8 @@ } } +# Examples below still fail with `ruby-use-smie' on: + foo + bar ------------------------------------------------------------ revno: 114564 fixes bug: http://debbugs.gnu.org/15550 committer: Paul Eggert branch nick: trunk timestamp: Mon 2013-10-07 14:37:19 -0700 message: Improve support for popcount and counting trailing zeros. Do this by using the Gnulib modules for this. This should generate faster code on non-GCC, non-MSC platforms, and make the code a bit more portable, at least in theory. * admin/merge-gnulib (GNULIB_MODULES): Add count-one-bits and count-trailing-zeros. * lib/count-one-bits.c, lib/count-one-bits.h: * lib/count-trailing-zeros.c, lib/count-trailing-zeros.h: * m4/count-one-bits.m4, m4/count-trailing-zeros.m4: New files, copied from gnulib. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. * nt/gnulib.mk: Merge changes from lib/gnulib.mk. * src/data.c: Include , . (USE_MSC_POPCOUNT, POPCOUNT_STATIC_INLINE) (NEED_GENERIC_POPCOUNT, popcount_size_t_generic) (popcount_size_t_msc, popcount_size_t_gcc): Remove; now done by Gnulib. (popcount_size_t): Now a macro that defers to Gnulib. (count_trailing_zero_bits): Return int, for consistency with Gnulib and because Emacs prefers signed to unsigned int. Don't assume that size_t is either unsigned int or unsigned long or unsigned long long. (size_t_to_host_endian): Do not assume that size_t is either exactly 32 or exactly 64 bits wide. * src/lisp.h (BITS_PER_SIZE_T): Define consistently with BITS_PER_LONG etc., so that it's now an enum constant, not a macro. No need to assume that it's either 32 or 64. diff: === modified file 'ChangeLog' --- ChangeLog 2013-10-04 07:36:22 +0000 +++ ChangeLog 2013-10-07 21:37:19 +0000 @@ -1,3 +1,15 @@ +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + Do this by using the Gnulib modules for this. + This should generate faster code on non-GCC, non-MSC platforms, + and make the code a bit more portable, at least in theory. + * lib/count-one-bits.c, lib/count-one-bits.h: + * lib/count-trailing-zeros.c, lib/count-trailing-zeros.h: + * m4/count-one-bits.m4, m4/count-trailing-zeros.m4: + New files, copied from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + 2013-10-04 Paul Eggert Use hardware insns for byteswapping on glibc hosts that support it. === modified file 'admin/ChangeLog' --- admin/ChangeLog 2013-10-04 07:36:22 +0000 +++ admin/ChangeLog 2013-10-07 21:37:19 +0000 @@ -1,3 +1,9 @@ +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + * merge-gnulib (GNULIB_MODULES): Add count-one-bits + and count-trailing-zeros. + 2013-10-04 Paul Eggert Use hardware support for byteswapping on glibc x86 etc. === modified file 'admin/merge-gnulib' --- admin/merge-gnulib 2013-10-04 07:36:22 +0000 +++ admin/merge-gnulib 2013-10-07 21:37:19 +0000 @@ -27,7 +27,8 @@ GNULIB_MODULES=' alloca-opt byteswap c-ctype c-strcase - careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 + careadlinkat close-stream count-one-bits count-trailing-zeros + crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday === added file 'lib/count-one-bits.c' --- lib/count-one-bits.c 1970-01-01 00:00:00 +0000 +++ lib/count-one-bits.c 2013-10-07 21:37:19 +0000 @@ -0,0 +1,7 @@ +#include +#define COUNT_ONE_BITS_INLINE _GL_EXTERN_INLINE +#include "count-one-bits.h" + +#if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64) +int popcount_support = -1; +#endif === added file 'lib/count-one-bits.h' --- lib/count-one-bits.h 1970-01-01 00:00:00 +0000 +++ lib/count-one-bits.h 2013-10-07 21:37:19 +0000 @@ -0,0 +1,136 @@ +/* count-one-bits.h -- counts the number of 1-bits in a word. + Copyright (C) 2007-2013 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Ben Pfaff. */ + +#ifndef COUNT_ONE_BITS_H +#define COUNT_ONE_BITS_H 1 + +#include +#include + +#ifndef _GL_INLINE_HEADER_BEGIN + #error "Please include config.h first." +#endif +_GL_INLINE_HEADER_BEGIN +#ifndef COUNT_ONE_BITS_INLINE +# define COUNT_ONE_BITS_INLINE _GL_INLINE +#endif + +/* Expand to code that computes the number of 1-bits of the local + variable 'x' of type TYPE (an unsigned integer type) and return it + from the current function. */ +#define COUNT_ONE_BITS_GENERIC(TYPE) \ + do \ + { \ + int count = 0; \ + int bits; \ + for (bits = 0; bits < sizeof (TYPE) * CHAR_BIT; bits += 32) \ + { \ + count += count_one_bits_32 (x); \ + x = x >> 31 >> 1; \ + } \ + return count; \ + } \ + while (0) + +/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN, + expand to code that computes the number of 1-bits of the local + variable 'x' of type TYPE (an unsigned integer type) and return it + from the current function. */ +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) return BUILTIN (x) +#else + +/* Compute and return the number of 1-bits set in the least + significant 32 bits of X. */ +COUNT_ONE_BITS_INLINE int +count_one_bits_32 (unsigned int x) +{ + x = ((x & 0xaaaaaaaaU) >> 1) + (x & 0x55555555U); + x = ((x & 0xccccccccU) >> 2) + (x & 0x33333333U); + x = (x >> 16) + (x & 0xffff); + x = ((x & 0xf0f0) >> 4) + (x & 0x0f0f); + return (x >> 8) + (x & 0x00ff); +} + +# if 1500 <= _MSC_VER && (defined _M_IX86 || defined _M_X64) + +/* While gcc falls back to its own generic code if the machine + on which it's running doesn't support popcount, with Microsoft's + compiler we need to detect and fallback ourselves. */ +# pragma intrinsic __cpuid +# pragma intrinsic __popcnt +# pragma intrinsic __popcnt64 + +/* Return nonzero if popcount is supported. */ + +/* 1 if supported, 0 if not supported, -1 if unknown. */ +extern int popcount_support; + +COUNT_ONE_BITS_INLINE int +popcount_supported (void) +{ + if (popcount_support < 0) + { + int cpu_info[4]; + __cpuid (cpu_info, 1); + popcount_support = (cpu_info[2] >> 23) & 1; /* See MSDN. */ + } + return popcount_support; +} + +# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) \ + do \ + { \ + if (popcount_supported ()) \ + return MSC_BUILTIN (x); \ + else \ + COUNT_ONE_BITS_GENERIC (TYPE); \ + } \ + while (0) +# else +# define COUNT_ONE_BITS(BUILTIN, MSC_BUILTIN, TYPE) \ + COUNT_ONE_BITS_GENERIC (TYPE) +# endif +#endif + +/* Compute and return the number of 1-bits set in X. */ +COUNT_ONE_BITS_INLINE int +count_one_bits (unsigned int x) +{ + COUNT_ONE_BITS (__builtin_popcount, __popcnt, unsigned int); +} + +/* Compute and return the number of 1-bits set in X. */ +COUNT_ONE_BITS_INLINE int +count_one_bits_l (unsigned long int x) +{ + COUNT_ONE_BITS (__builtin_popcountl, __popcnt, unsigned long int); +} + +#if HAVE_UNSIGNED_LONG_LONG_INT +/* Compute and return the number of 1-bits set in X. */ +COUNT_ONE_BITS_INLINE int +count_one_bits_ll (unsigned long long int x) +{ + COUNT_ONE_BITS (__builtin_popcountll, __popcnt64, unsigned long long int); +} +#endif + +_GL_INLINE_HEADER_END + +#endif /* COUNT_ONE_BITS_H */ === added file 'lib/count-trailing-zeros.c' --- lib/count-trailing-zeros.c 1970-01-01 00:00:00 +0000 +++ lib/count-trailing-zeros.c 2013-10-07 21:37:19 +0000 @@ -0,0 +1,3 @@ +#include +#define COUNT_TRAILING_ZEROS_INLINE _GL_EXTERN_INLINE +#include "count-trailing-zeros.h" === added file 'lib/count-trailing-zeros.h' --- lib/count-trailing-zeros.h 1970-01-01 00:00:00 +0000 +++ lib/count-trailing-zeros.h 2013-10-07 21:37:19 +0000 @@ -0,0 +1,106 @@ +/* count-trailing-zeros.h -- counts the number of trailing 0 bits in a word. + Copyright 2013 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +#ifndef COUNT_TRAILING_ZEROS_H +#define COUNT_TRAILING_ZEROS_H 1 + +#include +#include + +#ifndef _GL_INLINE_HEADER_BEGIN + #error "Please include config.h first." +#endif +_GL_INLINE_HEADER_BEGIN +#ifndef COUNT_TRAILING_ZEROS_INLINE +# define COUNT_TRAILING_ZEROS_INLINE _GL_INLINE +#endif + +/* Assuming the GCC builtin is BUILTIN and the MSC builtin is MSC_BUILTIN, + expand to code that computes the number of trailing zeros of the local + variable 'x' of type TYPE (an unsigned integer type) and return it + from the current function. */ +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ + return x ? BUILTIN (x) : CHAR_BIT * sizeof x; +#elif _MSC_VER +# pragma intrinsic _BitScanForward +# pragma intrinsic _BitScanForward64 +# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ + do \ + { \ + unsigned long result; \ + return MSC_BUILTIN (&result, x) ? result : CHAR_BIT * sizeof x; \ + } \ + while (0) +#else +# define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ + do \ + { \ + int count = 0; \ + if (! x) \ + return CHAR_BIT * sizeof x; \ + for (count = 0; \ + (count < CHAR_BIT * sizeof x - 32 \ + && ! (x & 0xffffffffU)); \ + count += 32) \ + x = x >> 31 >> 1; \ + return count + count_trailing_zeros_32 (x); \ + } \ + while (0) + +/* Compute and return the number of trailing zeros in the least + significant 32 bits of X. One of these bits must be nonzero. */ +COUNT_TRAILING_ZEROS_INLINE int +count_trailing_zeros_32 (unsigned int x) +{ + /* http://graphics.stanford.edu/~seander/bithacks.html */ + static const char de_Bruijn_lookup[32] = { + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 + }; + return de_Bruijn_lookup[(((x & -x) * 0x077cb531U) & 0xffffffffU) >> 27]; +} +#endif + +/* Compute and return the number of trailing zeros in X. */ +COUNT_TRAILING_ZEROS_INLINE int +count_trailing_zeros (unsigned int x) +{ + COUNT_TRAILING_ZEROS (__builtin_ctz, _BitScanForward, unsigned int); +} + +/* Compute and return the number of trailing zeros in X. */ +COUNT_TRAILING_ZEROS_INLINE int +count_trailing_zeros_l (unsigned long int x) +{ + COUNT_TRAILING_ZEROS (__builtin_ctzl, _BitScanForward, unsigned long int); +} + +#if HAVE_UNSIGNED_LONG_LONG_INT +/* Compute and return the number of trailing zeros in X. */ +COUNT_TRAILING_ZEROS_INLINE int +count_trailing_zeros_ll (unsigned long long int x) +{ + COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64, + unsigned long long int); +} +#endif + +_GL_INLINE_HEADER_END + +#endif === modified file 'lib/gnulib.mk' --- lib/gnulib.mk 2013-10-04 07:36:22 +0000 +++ lib/gnulib.mk 2013-10-07 21:37:19 +0000 @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings MOSTLYCLEANFILES += core *.stackdump @@ -132,6 +132,22 @@ ## end gnulib module close-stream +## begin gnulib module count-one-bits + +libgnu_a_SOURCES += count-one-bits.c + +EXTRA_DIST += count-one-bits.h + +## end gnulib module count-one-bits + +## begin gnulib module count-trailing-zeros + +libgnu_a_SOURCES += count-trailing-zeros.c + +EXTRA_DIST += count-trailing-zeros.h + +## end gnulib module count-trailing-zeros + ## begin gnulib module crypto/md5 libgnu_a_SOURCES += md5.c === added file 'm4/count-one-bits.m4' --- m4/count-one-bits.m4 1970-01-01 00:00:00 +0000 +++ m4/count-one-bits.m4 2013-10-07 21:37:19 +0000 @@ -0,0 +1,12 @@ +# count-one-bits.m4 serial 3 +dnl Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_COUNT_ONE_BITS], +[ + dnl We don't need (and can't compile) count_one_bits_ll + dnl unless the type 'unsigned long long int' exists. + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) +]) === added file 'm4/count-trailing-zeros.m4' --- m4/count-trailing-zeros.m4 1970-01-01 00:00:00 +0000 +++ m4/count-trailing-zeros.m4 2013-10-07 21:37:19 +0000 @@ -0,0 +1,12 @@ +# count-trailing-zeros.m4 +dnl Copyright (C) 2013 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_COUNT_TRAILING_ZEROS], +[ + dnl We don't need (and can't compile) count_trailing_zeros_ll + dnl unless the type 'unsigned long long int' exists. + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) +]) === modified file 'm4/gnulib-comp.m4' --- m4/gnulib-comp.m4 2013-10-04 07:36:22 +0000 +++ m4/gnulib-comp.m4 2013-10-07 21:37:19 +0000 @@ -48,6 +48,8 @@ # Code from module careadlinkat: # Code from module clock-time: # Code from module close-stream: + # Code from module count-one-bits: + # Code from module count-trailing-zeros: # Code from module crypto/md5: # Code from module crypto/sha1: # Code from module crypto/sha256: @@ -175,6 +177,8 @@ gl_CLOCK_TIME gl_CLOSE_STREAM gl_MODULE_INDICATOR([close-stream]) + gl_COUNT_ONE_BITS + gl_COUNT_TRAILING_ZEROS gl_MD5 gl_SHA1 gl_SHA256 @@ -806,6 +810,10 @@ lib/careadlinkat.h lib/close-stream.c lib/close-stream.h + lib/count-one-bits.c + lib/count-one-bits.h + lib/count-trailing-zeros.c + lib/count-trailing-zeros.h lib/dirent.in.h lib/dosname.h lib/dtoastr.c @@ -919,6 +927,8 @@ m4/c-strtod.m4 m4/clock_time.m4 m4/close-stream.m4 + m4/count-one-bits.m4 + m4/count-trailing-zeros.m4 m4/dirent_h.m4 m4/dup2.m4 m4/environ.m4 === modified file 'nt/ChangeLog' --- nt/ChangeLog 2013-10-04 14:27:11 +0000 +++ nt/ChangeLog 2013-10-07 21:37:19 +0000 @@ -1,3 +1,8 @@ +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + * gnulib.mk: Merge changes from ../lib/gnulib.mk. + 2013-10-04 Paul Eggert * gnulib.mk: Create from . === modified file 'nt/gnulib.mk' --- nt/gnulib.mk 2013-10-04 14:27:11 +0000 +++ nt/gnulib.mk 2013-10-07 21:37:19 +0000 @@ -43,7 +43,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=dup --avoid=fchdir --avoid=fcntl --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat close-stream crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings memrchr mktime pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt byteswap c-ctype c-strcase careadlinkat close-stream count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode fstatat fsync getloadavg getopt-gnu gettime gettimeofday intprops largefile lstat manywarnings memrchr mkostemp mktime pipe2 pselect pthread_sigmask putenv qacl readlink readlinkat sig2str socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub unsetenv utimens warnings MOSTLYCLEANFILES += core *.stackdump @@ -121,6 +121,22 @@ ## end gnulib module close-stream +## begin gnulib module count-one-bits + +libgnu_a_SOURCES += count-one-bits.c + +EXTRA_DIST += count-one-bits.h + +## end gnulib module count-one-bits + +## begin gnulib module count-trailing-zeros + +libgnu_a_SOURCES += count-trailing-zeros.c + +EXTRA_DIST += count-trailing-zeros.h + +## end gnulib module count-trailing-zeros + ## begin gnulib module crypto/md5 libgnu_a_SOURCES += md5.c === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-07 20:00:25 +0000 +++ src/ChangeLog 2013-10-07 21:37:19 +0000 @@ -1,3 +1,22 @@ +2013-10-07 Paul Eggert + + Improve support for popcount and counting trailing zeros (Bug#15550). + * data.c: Include , . + (USE_MSC_POPCOUNT, POPCOUNT_STATIC_INLINE) + (NEED_GENERIC_POPCOUNT, popcount_size_t_generic) + (popcount_size_t_msc, popcount_size_t_gcc): + Remove; now done by Gnulib. + (popcount_size_t): Now a macro that defers to Gnulib. + (count_trailing_zero_bits): Return int, for consistency with + Gnulib and because Emacs prefers signed to unsigned int. + Don't assume that size_t is either unsigned int or unsigned long + or unsigned long long. + (size_t_to_host_endian): Do not assume that size_t is either + exactly 32 or exactly 64 bits wide. + * lisp.h (BITS_PER_SIZE_T): Define consistently with BITS_PER_LONG + etc., so that it's now an enum constant, not a macro. + No need to assume that it's either 32 or 64. + 2013-10-07 Jan Djärv * nsterm.m (windowDidEnterFullScreen:): setPresentationOptions only === modified file 'src/data.c' --- src/data.c 2013-10-04 07:36:22 +0000 +++ src/data.c 2013-10-07 21:37:19 +0000 @@ -22,6 +22,8 @@ #include #include +#include +#include #include #include "lisp.h" @@ -2971,107 +2973,15 @@ return (((size_t) 1) << (nr_bits % BITS_PER_SIZE_T)) - 1; } -#if _MSC_VER >= 1500 && (defined _M_IX86 || defined _M_X64) -# define USE_MSC_POPCOUNT -# define POPCOUNT_STATIC_INLINE static inline -#elif __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) -# define USE_GCC_POPCOUNT -# if 199901L <= __STDC_VERSION__ || !__STRICT_ANSI__ -# define POPCOUNT_STATIC_INLINE static inline -# endif -#else -# define NEED_GENERIC_POPCOUNT -#endif -#ifndef POPCOUNT_STATIC_INLINE -# define POPCOUNT_STATIC_INLINE static -#endif - -#ifdef USE_MSC_POPCOUNT -# define NEED_GENERIC_POPCOUNT -#endif - -#ifdef NEED_GENERIC_POPCOUNT -POPCOUNT_STATIC_INLINE unsigned int -popcount_size_t_generic (size_t val) -{ - unsigned short j; - unsigned int count = 0; - - for (j = 0; j < BITS_PER_SIZE_T; ++j) - count += !!((((size_t) 1) << j) & val); - - return count; -} -#endif - -#ifdef USE_MSC_POPCOUNT -POPCOUNT_STATIC_INLINE unsigned int -popcount_size_t_msc (size_t val) -{ - unsigned int count; - -#pragma intrinsic __cpuid - /* While gcc falls back to its own generic code if the machine on - which it's running doesn't support popcount, we need to perform the - detection and fallback ourselves when compiling with Microsoft's - compiler. */ - - static enum { - popcount_unknown_support, - popcount_use_generic, - popcount_use_intrinsic - } popcount_state; - - if (popcount_state == popcount_unknown_support) - { - int cpu_info[4]; - __cpuid (cpu_info, 1); - if (cpu_info[2] & (1<<23)) /* See MSDN. */ - popcount_state = popcount_use_intrinsic; - else - popcount_state = popcount_use_generic; - } - - if (popcount_state == popcount_use_intrinsic) - { -# if BITS_PER_SIZE_T == 64 -# pragma intrinsic __popcnt64 - count = __popcnt64 (val); -# else -# pragma intrinsic __popcnt - count = __popcnt (val); -# endif - } - else - count = popcount_size_t_generic (val); - - return count; -} -#endif /* USE_MSC_POPCOUNT */ - -#ifdef USE_GCC_POPCOUNT -POPCOUNT_STATIC_INLINE unsigned int -popcount_size_t_gcc (size_t val) -{ -# if BITS_PER_SIZE_T == 64 - return __builtin_popcountll (val); -# else - return __builtin_popcount (val); -# endif -} -#endif /* USE_GCC_POPCOUNT */ - -POPCOUNT_STATIC_INLINE unsigned int -popcount_size_t (size_t val) -{ -#if defined USE_MSC_POPCOUNT - return popcount_size_t_msc (val); -#elif defined USE_GCC_POPCOUNT - return popcount_size_t_gcc (val); -#else - return popcount_size_t_generic (val); -#endif -} +#if SIZE_MAX <= UINT_MAX +# define popcount_size_t count_one_bits +#elif SIZE_MAX <= ULONG_MAX +# define popcount_size_t count_one_bits_l +#elif SIZE_MAX <= ULLONG_MAX +# define popcount_size_t count_one_bits_ll +#else +# error "size_t wider than long long? Please file a bug report." +#endif enum bool_vector_op { bool_vector_exclusive_or, bool_vector_union, @@ -3143,55 +3053,54 @@ /* Compute the number of trailing zero bits in val. If val is zero, return the number of bits in val. */ -static unsigned int +static int count_trailing_zero_bits (size_t val) { + if (SIZE_MAX == UINT_MAX) + return count_trailing_zeros (val); + if (SIZE_MAX == ULONG_MAX) + return count_trailing_zeros_l (val); +# if HAVE_UNSIGNED_LONG_LONG_INT + if (SIZE_MAX == ULLONG_MAX) + return count_trailing_zeros_ll (val); +# endif + + /* The rest of this code is for the unlikely platform where size_t differs + in width from unsigned int, unsigned long, and unsigned long long. */ if (val == 0) return CHAR_BIT * sizeof (val); - -#if defined USE_GCC_POPCOUNT && BITS_PER_SIZE_T == 64 - return __builtin_ctzll (val); -#elif defined USE_GCC_POPCOUNT && BITS_PER_SIZE_T == 32 - return __builtin_ctz (val); -#elif _MSC_VER && BITS_PER_SIZE_T == 64 -# pragma intrinsic _BitScanForward64 - { - /* No support test needed: support since 386. */ - unsigned long result; - _BitScanForward64 (&result, val); - return (unsigned int) result; - } -#elif _MSC_VER && BITS_PER_SIZE_T == 32 -# pragma intrinsic _BitScanForward - { - /* No support test needed: support since 386. */ - unsigned long result; - _BitScanForward (&result, val); - return (unsigned int) result; - } -#else - { - unsigned int count; - count = 0; - for (val = ~val; val & 1; val >>= 1) - ++count; - - return count; - } -#endif + if (SIZE_MAX <= UINT_MAX) + return count_trailing_zeros (val); + if (SIZE_MAX <= ULONG_MAX) + return count_trailing_zeros_l (val); + { +# if HAVE_UNSIGNED_LONG_LONG_INT + verify (SIZE_MAX <= ULLONG_MAX); + return count_trailing_zeros_ll (val); +# else + verify (SIZE_MAX <= ULONG_MAX); +# endif + } } static size_t size_t_to_host_endian (size_t val) { -#ifdef WORDS_BIGENDIAN -# if BITS_PER_SIZE_T == 64 +#ifndef WORDS_BIGENDIAN + return val; +#elif SIZE_MAX >> 31 == 1 + return bswap_32 (val); +#elif SIZE_MAX >> 31 >> 31 >> 1 == 1 return bswap_64 (val); -# else - return bswap_32 (val); -# endif #else - return val; + int i; + size_t r = 0; + for (i = 0; i < sizeof val; i++) + { + r = (r << CHAR_BIT) | (val & ((1u << CHAR_BIT) - 1)); + val >>= CHAR_BIT; + } + return r; #endif } === modified file 'src/lisp.h' --- src/lisp.h 2013-10-07 08:05:00 +0000 +++ src/lisp.h 2013-10-07 21:37:19 +0000 @@ -71,6 +71,7 @@ BITS_PER_SHORT = CHAR_BIT * sizeof (short), BITS_PER_INT = CHAR_BIT * sizeof (int), BITS_PER_LONG = CHAR_BIT * sizeof (long int), + BITS_PER_SIZE_T = CHAR_BIT * sizeof (size_t), BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) }; @@ -4366,12 +4367,6 @@ return 0; } -#if ((SIZE_MAX >> 31) >> 1) & 1 -# define BITS_PER_SIZE_T 64 -#else -# define BITS_PER_SIZE_T 32 -#endif - /* Round x to the next multiple of y. Does not overflow. Evaluates arguments repeatedly. */ #define ROUNDUP(x,y) ((y)*((x)/(y) + ((x)%(y)!=0))) ------------------------------------------------------------ revno: 114563 committer: Jan D. branch nick: trunk timestamp: Mon 2013-10-07 22:00:25 +0200 message: * nsterm.m (windowDidEnterFullScreen:): setPresentationOptions only on >= 10.7. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-07 15:11:17 +0000 +++ src/ChangeLog 2013-10-07 20:00:25 +0000 @@ -1,3 +1,8 @@ +2013-10-07 Jan Djärv + + * nsterm.m (windowDidEnterFullScreen:): setPresentationOptions only + on >= 10.7. + 2013-10-07 Dmitry Antipov * insdel.c (insert_from_gap): Prefer ptrdiff_t to int where needed. === modified file 'src/nsterm.m' --- src/nsterm.m 2013-10-06 15:59:11 +0000 +++ src/nsterm.m 2013-10-07 20:00:25 +0000 @@ -6129,6 +6129,7 @@ { BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (emacsframe) ? YES : NO; #ifdef NS_IMPL_COCOA +#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 unsigned val = (unsigned)[NSApp presentationOptions]; // OSX 10.7 bug fix, the menu won't appear without this. @@ -6144,6 +6145,7 @@ [NSApp setPresentationOptions: options]; } #endif +#endif [toolbar setVisible:tbar_visible]; } } ------------------------------------------------------------ revno: 114562 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 14:51:26 -0400 message: * lisp/electric.el (electric-indent-inhibit): New var. (electric-indent-post-self-insert-function): Use it. * lisp/progmodes/python.el (python-mode): Set it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 16:56:51 +0000 +++ lisp/ChangeLog 2013-10-07 18:51:26 +0000 @@ -1,5 +1,9 @@ 2013-10-07 Stefan Monnier + * electric.el (electric-indent-inhibit): New var. + (electric-indent-post-self-insert-function): Use it. + * progmodes/python.el (python-mode): Set it. + * progmodes/ruby-mode.el (ruby-smie-rules): Tweak handling of open braces. === modified file 'lisp/electric.el' --- lisp/electric.el 2013-09-23 02:58:02 +0000 +++ lisp/electric.el 2013-10-07 18:51:26 +0000 @@ -187,7 +187,7 @@ (eq (char-before) last-command-event))))) pos))) -;; Electric indentation. +;;; Electric indentation. ;; Autoloading variables is generally undesirable, but major modes ;; should usually set this variable by adding elements to the default @@ -202,6 +202,11 @@ point right after that char, and it should return t to cause indentation, `no-indent' to prevent indentation or nil to let other functions decide.") +(defvar-local electric-indent-inhibit nil + "If non-nil, reindentation is not appropriate for this buffer. +This should be set by major modes such as `python-mode' since +Python does not lend itself to fully automatic indentation.") + (defun electric-indent-post-self-insert-function () ;; FIXME: This reindents the current line, but what we really want instead is ;; to reindent the whole affected text. That's the current line for simple @@ -229,12 +234,13 @@ (unless (eq act 'do-indent) (nth 8 (syntax-ppss)))))))) ;; For newline, we want to reindent both lines and basically behave like ;; reindent-then-newline-and-indent (whose code we hence copied). - (when (< (1- pos) (line-beginning-position)) + (when (<= pos (line-beginning-position)) (let ((before (copy-marker (1- pos) t))) (save-excursion - (unless (memq indent-line-function - '(indent-relative indent-to-left-margin - indent-relative-maybe)) + (unless (or (memq indent-line-function + '(indent-relative indent-to-left-margin + indent-relative-maybe)) + electric-indent-inhibit) ;; Don't reindent the previous line if the indentation function ;; is not a real one. (goto-char before) @@ -248,7 +254,9 @@ ;; Remove the trailing whitespace after indentation because ;; indentation may (re)introduce the whitespace. (delete-horizontal-space t)))) - (unless (memq indent-line-function '(indent-to-left-margin)) + (unless (or (memq indent-line-function '(indent-to-left-margin)) + (and electric-indent-inhibit + (> pos (line-beginning-position)))) (indent-according-to-mode))))) ;;;###autoload @@ -281,7 +289,7 @@ (delq #'electric-indent-post-self-insert-function (cdr bp)))))))) -;; Electric pairing. +;;; Electric pairing. (defcustom electric-pair-pairs '((?\" . ?\")) @@ -414,7 +422,7 @@ (remove-hook 'self-insert-uses-region-functions #'electric-pair-will-use-region))) -;; Automatically add newlines after/before/around some chars. +;;; Electric newlines after/before/around some chars. (defvar electric-layout-rules '() "List of rules saying where to automatically insert newlines. === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2013-09-11 06:44:35 +0000 +++ lisp/progmodes/python.el 2013-10-07 18:51:26 +0000 @@ -3544,6 +3544,8 @@ (reverse acc)))) +(defvar electric-indent-inhibit) + ;;;###autoload (define-derived-mode python-mode prog-mode "Python" "Major mode for editing Python files. @@ -3572,7 +3574,9 @@ (set (make-local-variable 'indent-line-function) #'python-indent-line-function) (set (make-local-variable 'indent-region-function) #'python-indent-region) - + ;; Because indentation is not redundant, we cannot safely reindent code. + (setq-local electric-indent-inhibit t) + (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph) ------------------------------------------------------------ revno: 114561 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 12:56:51 -0400 message: * lisp/emacs-lisp/smie.el (smie-next-sexp): Refine last fix. * lisp/progmodes/ruby-mode.el (ruby-smie-rules): Tweak handling of open braces. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 15:40:24 +0000 +++ lisp/ChangeLog 2013-10-07 16:56:51 +0000 @@ -1,5 +1,10 @@ 2013-10-07 Stefan Monnier + * progmodes/ruby-mode.el (ruby-smie-rules): Tweak handling of + open braces. + + * emacs-lisp/smie.el (smie-next-sexp): Refine last fix. + * textmodes/css-mode.el (css-smie-rules): Fix indentation (bug#15467). (css-mode): Use electric-indent-chars. === modified file 'lisp/emacs-lisp/smie.el' --- lisp/emacs-lisp/smie.el 2013-10-05 18:37:08 +0000 +++ lisp/emacs-lisp/smie.el 2013-10-07 16:56:51 +0000 @@ -709,11 +709,13 @@ (condition-case err (progn (funcall next-sexp 1) nil) (scan-error - (let ((pos (nth 2 err))) + (let ((epos (nth 2 err))) + (goto-char pos) (throw 'return - (list t pos + (list t epos (buffer-substring-no-properties - pos (+ pos (if (< (point) pos) -1 1)))))))) + epos + (+ epos (if (< (point) epos) -1 1)))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) === modified file 'lisp/progmodes/ruby-mode.el' --- lisp/progmodes/ruby-mode.el 2013-10-07 03:38:26 +0000 +++ lisp/progmodes/ruby-mode.el 2013-10-07 16:56:51 +0000 @@ -414,7 +414,8 @@ (`(:before . ,(or `"(" `"[" `"{")) ;; Treat purely syntactic block-constructs as being part of their parent, ;; when the opening statement is hanging. - (if (smie-rule-hanging-p) (smie-rule-parent))) + (when (smie-rule-hanging-p) + (smie-backward-sexp 'halfsexp) (smie-indent-virtual))) (`(:after . "=") 2) (`(:before . "do") (when (or (smie-rule-hanging-p) ------------------------------------------------------------ revno: 114560 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15467 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 11:40:24 -0400 message: * lisp/textmodes/css-mode.el (css-smie-rules): Fix indentation. (css-mode): Use electric-indent-chars. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 13:54:48 +0000 +++ lisp/ChangeLog 2013-10-07 15:40:24 +0000 @@ -1,5 +1,8 @@ 2013-10-07 Stefan Monnier + * textmodes/css-mode.el (css-smie-rules): Fix indentation (bug#15467). + (css-mode): Use electric-indent-chars. + * nxml/nxml-mode.el: Use lexical-binding and syntax-propertize. (font-lock-beg, font-lock-end): Move before first use. (nxml-mode): Use syntax-propertize-function. === modified file 'lisp/textmodes/css-mode.el' --- lisp/textmodes/css-mode.el 2013-10-04 21:45:37 +0000 +++ lisp/textmodes/css-mode.el 2013-10-07 15:40:24 +0000 @@ -302,7 +302,7 @@ (pcase (cons kind token) (`(:elem . basic) css-indent-offset) (`(:elem . arg) 0) - (`(:list-intro . "") t) ;"" stands for BOB (bug#15467). + (`(:list-intro . ,(or `";" `"")) t) ;"" stands for BOB (bug#15467). (`(:before . "{") (if (smie-rule-hanging-p) (smie-rule-parent 0))))) @@ -321,12 +321,8 @@ (smie-setup css-smie-grammar #'css-smie-rules :forward-token #'css-smie--forward-token :backward-token #'css-smie--backward-token) - (when css-electric-keys - (let ((fc (make-char-table 'auto-fill-chars))) - (set-char-table-parent fc auto-fill-chars) - (dolist (c css-electric-keys) - (aset fc c 'indent-according-to-mode)) - (setq-local auto-fill-chars fc)))) + (setq-local electric-indent-chars + (append css-electric-keys electric-indent-chars))) (defvar comment-continue) === modified file 'test/indent/css-mode.css' --- test/indent/css-mode.css 2013-10-04 21:45:37 +0000 +++ test/indent/css-mode.css 2013-10-07 15:40:24 +0000 @@ -1,3 +1,11 @@ .xxx { } + +.x2 +{ +} + +div.x3 +{ +} ------------------------------------------------------------ revno: 114559 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2013-10-07 19:11:17 +0400 message: * xdisp.c (handle_fontified_prop): Prefer ptrdiff_t to int where needed. Use bool for boolean. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-07 15:03:33 +0000 +++ src/ChangeLog 2013-10-07 15:11:17 +0000 @@ -1,6 +1,7 @@ 2013-10-07 Dmitry Antipov * insdel.c (insert_from_gap): Prefer ptrdiff_t to int where needed. + * xdisp.c (handle_fontified_prop): Likewise. Use bool for boolean. 2013-10-07 Paul Eggert === modified file 'src/xdisp.c' --- src/xdisp.c 2013-10-04 13:41:10 +0000 +++ src/xdisp.c 2013-10-07 15:11:17 +0000 @@ -3698,8 +3698,8 @@ ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object val; struct buffer *obuf = current_buffer; - int begv = BEGV, zv = ZV; - int old_clip_changed = current_buffer->clip_changed; + ptrdiff_t begv = BEGV, zv = ZV; + bool old_clip_changed = current_buffer->clip_changed; val = Vfontification_functions; specbind (Qfontification_functions, Qnil); ------------------------------------------------------------ revno: 114558 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2013-10-07 19:03:33 +0400 message: * insdel.c (insert_from_gap): Prefer ptrdiff_t to int where needed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-07 08:05:00 +0000 +++ src/ChangeLog 2013-10-07 15:03:33 +0000 @@ -1,3 +1,7 @@ +2013-10-07 Dmitry Antipov + + * insdel.c (insert_from_gap): Prefer ptrdiff_t to int where needed. + 2013-10-07 Paul Eggert emacs_read and emacs_write now use void *, not char *. === modified file 'src/insdel.c' --- src/insdel.c 2013-09-11 12:28:01 +0000 +++ src/insdel.c 2013-10-07 15:03:33 +0000 @@ -988,8 +988,7 @@ void insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) { - int ins_charpos = GPT; - int ins_bytepos = GPT_BYTE; + ptrdiff_t ins_charpos = GPT, ins_bytepos = GPT_BYTE; if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nchars = nbytes; ------------------------------------------------------------ revno: 114557 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2013-10-07 09:54:48 -0400 message: * lisp/nxml/nxml-mode.el: Use lexical-binding and syntax-propertize. (font-lock-beg, font-lock-end): Move before first use. (nxml-mode): Use syntax-propertize-function. (nxml-after-change, nxml-after-change1): Adjust accordingly. (nxml-extend-after-change-region): Remove. * lisp/nxml/nxml-ns.el: Use lexical-binding. (nxml-ns-save): Use `declare'. (nxml-ns-prefixes-for): Avoid add-to-list. * lisp/nxml/nxml-util.el: Use lexical-binding. (nxml-with-degradation-on-error, nxml-with-invisible-motion): Use `declare'. * lisp/nxml/rng-match.el: Use lexical-binding. (rng--ipattern): Use cl-defstruct. (rng-compute-start-tag-open-deriv, rng-compute-start-attribute-deriv) (rng-cons-group-after, rng-subst-group-after) (rng-subst-interleave-after, rng-apply-after, rng-compute-data-deriv): Use closures instead of `(lambda...). * lisp/nxml/xmltok.el: Use lexical-binding. (xmltok-save): Use `declare'. (xmltok-unclosed-reparse-p, xmltok-semi-closed-reparse-p): Remove. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-07 12:45:20 +0000 +++ lisp/ChangeLog 2013-10-07 13:54:48 +0000 @@ -1,14 +1,37 @@ +2013-10-07 Stefan Monnier + + * nxml/nxml-mode.el: Use lexical-binding and syntax-propertize. + (font-lock-beg, font-lock-end): Move before first use. + (nxml-mode): Use syntax-propertize-function. + (nxml-after-change, nxml-after-change1): Adjust accordingly. + (nxml-extend-after-change-region): Remove. + * nxml/xmltok.el: Use lexical-binding. + (xmltok-save): Use `declare'. + (xmltok-unclosed-reparse-p, xmltok-semi-closed-reparse-p): Remove. + * nxml/nxml-util.el: Use lexical-binding. + (nxml-with-degradation-on-error, nxml-with-invisible-motion): + Use `declare'. + * nxml/nxml-ns.el: Use lexical-binding. + (nxml-ns-save): Use `declare'. + (nxml-ns-prefixes-for): Avoid add-to-list. + * nxml/rng-match.el: Use lexical-binding. + (rng--ipattern): Use cl-defstruct. + (rng-compute-start-tag-open-deriv, rng-compute-start-attribute-deriv) + (rng-cons-group-after, rng-subst-group-after) + (rng-subst-interleave-after, rng-apply-after, rng-compute-data-deriv): + Use closures instead of `(lambda...). + 2013-10-07 Michael Albinus * net/tramp.el (tramp-handle-insert-file-contents): Improve handling of BEG and END. - * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use - `tramp-handle-insert-file-contents'. + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + Use `tramp-handle-insert-file-contents'. (tramp-gvfs-handle-insert-file-contents): Remove function. - * net/tramp-sh.el (tramp-sh-handle-insert-directory): Use - `save-restriction' in order to keep markers. + * net/tramp-sh.el (tramp-sh-handle-insert-directory): + Use `save-restriction' in order to keep markers. * net/trampver.el: Update release number. @@ -20,7 +43,8 @@ * emacs-lisp/easymenu.el (easy-menu-create-menu): Use closures. - * emacs-lisp/lisp-mode.el (eval-defun-2): Simplify, using lexical-binding. + * emacs-lisp/lisp-mode.el (eval-defun-2): Simplify, using + lexical-binding. * emacs-lisp/tq.el (tq-create): Use a closure instead of `(lambda...). === modified file 'lisp/nxml/nxml-mode.el' --- lisp/nxml/nxml-mode.el 2013-05-15 18:31:51 +0000 +++ lisp/nxml/nxml-mode.el 2013-10-07 13:54:48 +0000 @@ -1,4 +1,4 @@ -;;; nxml-mode.el --- a new XML mode +;;; nxml-mode.el --- a new XML mode -*- lexical-binding:t -*- ;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc. @@ -540,14 +540,14 @@ (nxml-scan-prolog))))) (add-hook 'completion-at-point-functions #'nxml-completion-at-point-function nil t) - (add-hook 'after-change-functions 'nxml-after-change nil t) + (setq-local syntax-propertize-function #'nxml-after-change) (add-hook 'change-major-mode-hook 'nxml-cleanup nil t) ;; Emacs 23 handles the encoding attribute on the xml declaration ;; transparently to nxml-mode, so there is no longer a need for the below ;; hook. The hook also had the drawback of overriding explicit user ;; instruction to save as some encoding other than utf-8. -;;; (add-hook 'write-contents-hooks 'nxml-prepare-to-save) + ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save) (when (not (and (buffer-file-name) (file-exists-p (buffer-file-name)))) (when (and nxml-default-buffer-file-coding-system (not (local-variable-p 'buffer-file-coding-system))) @@ -561,8 +561,6 @@ nil ; font-lock-keywords-case-fold-search. XML is case sensitive nil ; no special syntax table nil ; no automatic syntactic fontification - (font-lock-extend-after-change-region-function - . nxml-extend-after-change-region) (font-lock-extend-region-functions . (nxml-extend-region)) (jit-lock-contextually . t) (font-lock-unfontify-region-function . nxml-unfontify-region))) @@ -597,6 +595,7 @@ ;;; Change management +(defvar font-lock-beg) (defvar font-lock-end) (defun nxml-debug-region (start end) (interactive "r") (let ((font-lock-beg start) @@ -605,22 +604,16 @@ (goto-char font-lock-beg) (set-mark font-lock-end))) -(defun nxml-after-change (start end pre-change-length) - ; In font-lock mode, nxml-after-change1 is called via - ; nxml-extend-after-change-region instead so that the updated - ; book-keeping information is available for fontification. - (unless (or font-lock-mode nxml-degraded) +(defun nxml-after-change (start end) + ;; Called via syntax-propertize-function. + (unless nxml-degraded (nxml-with-degradation-on-error 'nxml-after-change - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (with-silent-modifications - (nxml-after-change1 - start end pre-change-length))))))))) + (save-restriction + (widen) + (nxml-with-invisible-motion + (nxml-after-change1 start end)))))) -(defun nxml-after-change1 (start end pre-change-length) +(defun nxml-after-change1 (start end) "After-change bookkeeping. Returns a cons cell containing a possibly-enlarged change region. You must call `nxml-extend-region' on this expanded region to obtain @@ -628,23 +621,14 @@ For bookkeeping, call this function even when fontification is disabled." - (let ((pre-change-end (+ start pre-change-length))) - ;; If the prolog might have changed, rescan the prolog - (when (<= start - ;; Add 2 so as to include the < and following char that - ;; start the instance (document element), since changing - ;; these can change where the prolog ends. - (+ nxml-prolog-end 2)) - ;; end must be extended to at least the end of the old prolog in - ;; case the new prolog is shorter - (when (< pre-change-end nxml-prolog-end) - (setq end - ;; don't let end get out of range even if pre-change-length - ;; is bogus - (min (point-max) - (+ end (- nxml-prolog-end pre-change-end))))) - (nxml-scan-prolog) - (setq start (point-min)))) + ;; If the prolog might have changed, rescan the prolog. + (when (<= start + ;; Add 2 so as to include the < and following char that + ;; start the instance (document element), since changing + ;; these can change where the prolog ends. + (+ nxml-prolog-end 2)) + (nxml-scan-prolog) + (setq start (point-min))) (when (> end nxml-prolog-end) (goto-char start) @@ -653,8 +637,7 @@ (setq end (max (nxml-scan-after-change start end) end))) - (nxml-debug-change "nxml-after-change1" start end) - (cons start end)) + (nxml-debug-change "nxml-after-change1" start end)) ;;; Encodings @@ -845,7 +828,6 @@ (font-lock-default-unfontify-region start end) (nxml-clear-char-ref-extra-display start end)) -(defvar font-lock-beg) (defvar font-lock-end) (defun nxml-extend-region () "Extend the region to hold the minimum area we can fontify with nXML. Called with `font-lock-beg' and `font-lock-end' dynamically bound." @@ -887,19 +869,6 @@ (nxml-debug-change "nxml-extend-region" start end) t))) -(defun nxml-extend-after-change-region (start end pre-change-length) - (unless nxml-degraded - (nxml-with-degradation-on-error - 'nxml-extend-after-change-region - (save-excursion - (save-restriction - (widen) - (save-match-data - (nxml-with-invisible-motion - (with-silent-modifications - (nxml-after-change1 - start end pre-change-length))))))))) - (defun nxml-fontify-matcher (bound) "Called as font-lock keyword matcher." === modified file 'lisp/nxml/nxml-ns.el' --- lisp/nxml/nxml-ns.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/nxml-ns.el 2013-10-07 13:54:48 +0000 @@ -1,4 +1,4 @@ -;;; nxml-ns.el --- XML namespace processing +;;; nxml-ns.el --- XML namespace processing -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc. @@ -56,12 +56,10 @@ (equal nxml-ns-state state)) (defmacro nxml-ns-save (&rest body) + (declare (indent 0) (debug t)) `(let ((nxml-ns-state nxml-ns-initial-state)) ,@body)) -(put 'nxml-ns-save 'lisp-indent-function 0) -(def-edebug-spec nxml-ns-save t) - (defun nxml-ns-init () (setq nxml-ns-state nxml-ns-initial-state)) @@ -117,11 +115,12 @@ (setq current (cdr current)) (while (let ((binding (rassq ns current))) (when binding - (when (eq (nxml-ns-get-prefix (car binding)) ns) - (add-to-list 'prefixes - (car binding))) - (setq current - (cdr (member binding current)))))) + (let ((prefix (car binding))) + (when (eq (nxml-ns-get-prefix prefix) ns) + (unless (member prefix prefixes) + (push prefix prefixes)))) + (setq current + (cdr (member binding current)))))) prefixes)) (defun nxml-ns-prefix-for (ns) === modified file 'lisp/nxml/nxml-util.el' --- lisp/nxml/nxml-util.el 2013-08-29 01:20:05 +0000 +++ lisp/nxml/nxml-util.el 2013-10-07 13:54:48 +0000 @@ -1,4 +1,4 @@ -;;; nxml-util.el --- utility functions for nxml-*.el +;;; nxml-util.el --- utility functions for nxml-*.el -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc. @@ -70,6 +70,7 @@ (nxml-make-namespace "http://www.w3.org/2000/xmlns/")) (defmacro nxml-with-degradation-on-error (context &rest body) + (declare (indent 1) (debug t)) (if (not nxml-debug) (let ((error-symbol (make-symbol "err"))) `(condition-case ,error-symbol @@ -80,12 +81,10 @@ (defmacro nxml-with-invisible-motion (&rest body) "Evaluate body without calling any point motion hooks." + (declare (indent 0) (debug t)) `(let ((inhibit-point-motion-hooks t)) ,@body)) -(put 'nxml-with-invisible-motion 'lisp-indent-function 0) -(def-edebug-spec nxml-with-invisible-motion t) - (defun nxml-display-file-parse-error (err) (let* ((filename (nth 1 err)) (buffer (find-file-noselect filename)) === modified file 'lisp/nxml/rng-match.el' --- lisp/nxml/rng-match.el 2013-08-09 21:22:44 +0000 +++ lisp/nxml/rng-match.el 2013-10-07 13:54:48 +0000 @@ -1,4 +1,4 @@ -;;; rng-match.el --- matching of RELAX NG patterns against XML events +;;; rng-match.el --- matching of RELAX NG patterns against XML events -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc. @@ -34,6 +34,7 @@ (require 'rng-pttrn) (require 'rng-util) (require 'rng-dt) +(eval-when-compile (require 'cl-lib)) (defvar rng-not-allowed-ipattern nil) (defvar rng-empty-ipattern nil) @@ -63,38 +64,31 @@ ;;; Interned patterns -(eval-when-compile - (defun rng-ipattern-slot-accessor-name (slot-name) - (intern (concat "rng-ipattern-get-" - (symbol-name slot-name)))) - - (defun rng-ipattern-slot-setter-name (slot-name) - (intern (concat "rng-ipattern-set-" - (symbol-name slot-name))))) - -(defmacro rng-ipattern-defslot (slot-name index) - `(progn - (defsubst ,(rng-ipattern-slot-accessor-name slot-name) (ipattern) - (aref ipattern ,index)) - (defsubst ,(rng-ipattern-slot-setter-name slot-name) (ipattern value) - (aset ipattern ,index value)))) - -(rng-ipattern-defslot type 0) -(rng-ipattern-defslot index 1) -(rng-ipattern-defslot name-class 2) -(rng-ipattern-defslot datatype 2) -(rng-ipattern-defslot after 2) -(rng-ipattern-defslot child 3) -(rng-ipattern-defslot value-object 3) -(rng-ipattern-defslot nullable 4) -(rng-ipattern-defslot memo-text-typed 5) -(rng-ipattern-defslot memo-map-start-tag-open-deriv 6) -(rng-ipattern-defslot memo-map-start-attribute-deriv 7) -(rng-ipattern-defslot memo-start-tag-close-deriv 8) -(rng-ipattern-defslot memo-text-only-deriv 9) -(rng-ipattern-defslot memo-mixed-text-deriv 10) -(rng-ipattern-defslot memo-map-data-deriv 11) -(rng-ipattern-defslot memo-end-tag-deriv 12) +(cl-defstruct (rng--ipattern + (:constructor nil) + (:type vector) + (:copier nil) + (:constructor rng-make-ipattern + (type index name-class child nullable))) + type + index + name-class ;; Field also known as: `datatype' and `after'. + child ;; Field also known as: `value-object'. + nullable + (memo-text-typed 'unknown) + memo-map-start-tag-open-deriv + memo-map-start-attribute-deriv + memo-start-tag-close-deriv + memo-text-only-deriv + memo-mixed-text-deriv + memo-map-data-deriv + memo-end-tag-deriv) + +;; I think depending on the value of `type' the two fields after `index' +;; are used sometimes for different purposes, hence the aliases here: +(defalias 'rng--ipattern-datatype 'rng--ipattern-name-class) +(defalias 'rng--ipattern-after 'rng--ipattern-name-class) +(defalias 'rng--ipattern-value-object 'rng--ipattern-child) (defconst rng-memo-map-alist-max 10) @@ -142,25 +136,6 @@ (cons (cons key value) (cdr mm)))))))) -(defsubst rng-make-ipattern (type index name-class child nullable) - (vector type index name-class child nullable - ;; 5 memo-text-typed - 'unknown - ;; 6 memo-map-start-tag-open-deriv - nil - ;; 7 memo-map-start-attribute-deriv - nil - ;; 8 memo-start-tag-close-deriv - nil - ;; 9 memo-text-only-deriv - nil - ;; 10 memo-mixed-text-deriv - nil - ;; 11 memo-map-data-deriv - nil - ;; 12 memo-end-tag-deriv - nil)) - (defun rng-ipattern-maybe-init () (unless rng-ipattern-table (setq rng-ipattern-table (make-hash-table :test 'equal)) @@ -208,8 +183,8 @@ (if (eq child rng-not-allowed-ipattern) rng-not-allowed-ipattern (let ((key (list 'after - (rng-ipattern-get-index child) - (rng-ipattern-get-index after)))) + (rng--ipattern-index child) + (rng--ipattern-index after)))) (or (rng-get-ipattern key) (rng-put-ipattern key 'after @@ -222,7 +197,7 @@ rng-not-allowed-ipattern (let ((key (list 'attribute name-class - (rng-ipattern-get-index ipattern)))) + (rng--ipattern-index ipattern)))) (or (rng-get-ipattern key) (rng-put-ipattern key 'attribute @@ -238,8 +213,8 @@ dt nil matches-anything))) - (rng-ipattern-set-memo-text-typed ipattern - (not matches-anything)) + (setf (rng--ipattern-memo-text-typed ipattern) + (not matches-anything)) ipattern)))) (defun rng-intern-data-except (dt ipattern) @@ -263,20 +238,20 @@ (defun rng-intern-one-or-more (ipattern) (or (rng-intern-one-or-more-shortcut ipattern) (let ((key (cons 'one-or-more - (list (rng-ipattern-get-index ipattern))))) + (list (rng--ipattern-index ipattern))))) (or (rng-get-ipattern key) (rng-put-ipattern key 'one-or-more nil ipattern - (rng-ipattern-get-nullable ipattern)))))) + (rng--ipattern-nullable ipattern)))))) (defun rng-intern-one-or-more-shortcut (ipattern) (cond ((eq ipattern rng-not-allowed-ipattern) rng-not-allowed-ipattern) ((eq ipattern rng-empty-ipattern) rng-empty-ipattern) - ((eq (rng-ipattern-get-type ipattern) 'one-or-more) + ((eq (rng--ipattern-type ipattern) 'one-or-more) ipattern) (t nil))) @@ -284,7 +259,7 @@ (if (eq ipattern rng-not-allowed-ipattern) rng-not-allowed-ipattern (let ((key (cons 'list - (list (rng-ipattern-get-index ipattern))))) + (list (rng--ipattern-index ipattern))))) (or (rng-get-ipattern key) (rng-put-ipattern key 'list @@ -299,7 +274,7 @@ (normalized (cdr tem))) (or (rng-intern-group-shortcut normalized) (let ((key (cons 'group - (mapcar 'rng-ipattern-get-index normalized)))) + (mapcar #'rng--ipattern-index normalized)))) (or (rng-get-ipattern key) (rng-put-ipattern key 'group @@ -345,10 +320,10 @@ (setq member (car ipatterns)) (setq ipatterns (cdr ipatterns)) (when nullable - (setq nullable (rng-ipattern-get-nullable member))) - (cond ((eq (rng-ipattern-get-type member) 'group) + (setq nullable (rng--ipattern-nullable member))) + (cond ((eq (rng--ipattern-type member) 'group) (setq result - (nconc (reverse (rng-ipattern-get-child member)) + (nconc (reverse (rng--ipattern-child member)) result))) ((eq member rng-not-allowed-ipattern) (setq result (list rng-not-allowed-ipattern)) @@ -363,7 +338,7 @@ (normalized (cdr tem))) (or (rng-intern-group-shortcut normalized) (let ((key (cons 'interleave - (mapcar 'rng-ipattern-get-index normalized)))) + (mapcar #'rng--ipattern-index normalized)))) (or (rng-get-ipattern key) (rng-put-ipattern key 'interleave @@ -383,10 +358,10 @@ (setq member (car ipatterns)) (setq ipatterns (cdr ipatterns)) (when nullable - (setq nullable (rng-ipattern-get-nullable member))) - (cond ((eq (rng-ipattern-get-type member) 'interleave) + (setq nullable (rng--ipattern-nullable member))) + (cond ((eq (rng--ipattern-type member) 'interleave) (setq result - (append (rng-ipattern-get-child member) + (append (rng--ipattern-child member) result))) ((eq member rng-not-allowed-ipattern) (setq result (list rng-not-allowed-ipattern)) @@ -407,7 +382,7 @@ (rng-intern-choice1 normalized (car tem)))))) (defun rng-intern-optional (ipattern) - (cond ((rng-ipattern-get-nullable ipattern) ipattern) + (cond ((rng--ipattern-nullable ipattern) ipattern) ((eq ipattern rng-not-allowed-ipattern) rng-empty-ipattern) (t (rng-intern-choice1 ;; This is sorted since the empty pattern @@ -415,15 +390,15 @@ ;; It cannot have a duplicate empty pattern, ;; since it is not nullable. (cons rng-empty-ipattern - (if (eq (rng-ipattern-get-type ipattern) 'choice) - (rng-ipattern-get-child ipattern) + (if (eq (rng--ipattern-type ipattern) 'choice) + (rng--ipattern-child ipattern) (list ipattern))) t)))) (defun rng-intern-choice1 (normalized nullable) (let ((key (cons 'choice - (mapcar 'rng-ipattern-get-index normalized)))) + (mapcar #'rng--ipattern-index normalized)))) (or (rng-get-ipattern key) (rng-put-ipattern key 'choice @@ -466,10 +441,10 @@ (while cur (setq member (car cur)) (or nullable - (setq nullable (rng-ipattern-get-nullable member))) - (cond ((eq (rng-ipattern-get-type member) 'choice) + (setq nullable (rng--ipattern-nullable member))) + (cond ((eq (rng--ipattern-type member) 'choice) (setq final-tail - (append (rng-ipattern-get-child member) + (append (rng--ipattern-child member) final-tail)) (setq cur (cdr cur)) (setq sorted nil) @@ -479,7 +454,7 @@ (setcdr tail cur)) (t (if (and sorted - (let ((cur-index (rng-ipattern-get-index member))) + (let ((cur-index (rng--ipattern-index member))) (if (>= prev-index cur-index) (or (= prev-index cur-index) ; will remove it (setq sorted nil)) ; won't remove it @@ -501,8 +476,8 @@ (rng-uniquify-eq (sort head 'rng-compare-ipattern)))))) (defun rng-compare-ipattern (p1 p2) - (< (rng-ipattern-get-index p1) - (rng-ipattern-get-index p2))) + (< (rng--ipattern-index p1) + (rng--ipattern-index p2))) ;;; Name classes @@ -557,50 +532,50 @@ ;;; Debugging utilities (defun rng-ipattern-to-string (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) (concat (rng-ipattern-to-string - (rng-ipattern-get-child ipattern)) + (rng--ipattern-child ipattern)) " " (rng-ipattern-to-string - (rng-ipattern-get-after ipattern)))) + (rng--ipattern-after ipattern)))) ((eq type 'element) (concat "element " (rng-name-class-to-string - (rng-ipattern-get-name-class ipattern)) + (rng--ipattern-name-class ipattern)) ;; we can get cycles with elements so don't print it out " {...}")) ((eq type 'attribute) (concat "attribute " (rng-name-class-to-string - (rng-ipattern-get-name-class ipattern)) + (rng--ipattern-name-class ipattern)) " { " (rng-ipattern-to-string - (rng-ipattern-get-child ipattern)) + (rng--ipattern-child ipattern)) " } ")) ((eq type 'empty) "empty") ((eq type 'text) "text") ((eq type 'not-allowed) "notAllowed") ((eq type 'one-or-more) (concat (rng-ipattern-to-string - (rng-ipattern-get-child ipattern)) + (rng--ipattern-child ipattern)) "+")) ((eq type 'choice) (concat "(" (mapconcat 'rng-ipattern-to-string - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) " | ") ")")) ((eq type 'group) (concat "(" (mapconcat 'rng-ipattern-to-string - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) ", ") ")")) ((eq type 'interleave) (concat "(" (mapconcat 'rng-ipattern-to-string - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) " & ") ")")) (t (symbol-name type))))) @@ -664,10 +639,10 @@ nil)) (defun rng-element-get-child (element) - (let ((tem (rng-ipattern-get-child element))) + (let ((tem (rng--ipattern-child element))) (if (vectorp tem) tem - (rng-ipattern-set-child element (rng-compile tem))))) + (setf (rng--ipattern-child element) (rng-compile tem))))) (defun rng-compile-attribute (name-class pattern) (rng-intern-attribute (rng-compile-name-class name-class) @@ -839,17 +814,16 @@ ;;; Derivatives (defun rng-ipattern-text-typed-p (ipattern) - (let ((memo (rng-ipattern-get-memo-text-typed ipattern))) + (let ((memo (rng--ipattern-memo-text-typed ipattern))) (if (eq memo 'unknown) - (rng-ipattern-set-memo-text-typed - ipattern - (rng-ipattern-compute-text-typed-p ipattern)) + (setf (rng--ipattern-memo-text-typed ipattern) + (rng-ipattern-compute-text-typed-p ipattern)) memo))) (defun rng-ipattern-compute-text-typed-p (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'choice) - (let ((cur (rng-ipattern-get-child ipattern)) + (let ((cur (rng--ipattern-child ipattern)) (ret nil)) (while (and cur (not ret)) (if (rng-ipattern-text-typed-p (car cur)) @@ -857,7 +831,7 @@ (setq cur (cdr cur)))) ret)) ((eq type 'group) - (let ((cur (rng-ipattern-get-child ipattern)) + (let ((cur (rng--ipattern-child ipattern)) (ret nil) member) (while (and cur (not ret)) @@ -865,17 +839,17 @@ (if (rng-ipattern-text-typed-p member) (setq ret t)) (setq cur - (and (rng-ipattern-get-nullable member) + (and (rng--ipattern-nullable member) (cdr cur)))) ret)) ((eq type 'after) - (rng-ipattern-text-typed-p (rng-ipattern-get-child ipattern))) + (rng-ipattern-text-typed-p (rng--ipattern-child ipattern))) (t (and (memq type '(value list data data-except)) t))))) (defun rng-start-tag-open-deriv (ipattern nm) (or (rng-memo-map-get nm - (rng-ipattern-get-memo-map-start-tag-open-deriv ipattern)) + (rng--ipattern-memo-map-start-tag-open-deriv ipattern)) (rng-ipattern-memo-start-tag-open-deriv ipattern nm @@ -883,56 +857,54 @@ (defun rng-ipattern-memo-start-tag-open-deriv (ipattern nm deriv) (or (memq ipattern rng-const-ipatterns) - (rng-ipattern-set-memo-map-start-tag-open-deriv - ipattern - (rng-memo-map-add nm - deriv - (rng-ipattern-get-memo-map-start-tag-open-deriv - ipattern)))) + (setf (rng--ipattern-memo-map-start-tag-open-deriv ipattern) + (rng-memo-map-add nm + deriv + (rng--ipattern-memo-map-start-tag-open-deriv + ipattern)))) deriv) (defun rng-compute-start-tag-open-deriv (ipattern nm) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'choice) - (rng-transform-choice `(lambda (p) - (rng-start-tag-open-deriv p ',nm)) + (rng-transform-choice (lambda (p) + (rng-start-tag-open-deriv p nm)) ipattern)) ((eq type 'element) (if (rng-name-class-contains - (rng-ipattern-get-name-class ipattern) + (rng--ipattern-name-class ipattern) nm) (rng-intern-after (rng-element-get-child ipattern) rng-empty-ipattern) rng-not-allowed-ipattern)) ((eq type 'group) (rng-transform-group-nullable - `(lambda (p) (rng-start-tag-open-deriv p ',nm)) + (lambda (p) (rng-start-tag-open-deriv p nm)) 'rng-cons-group-after ipattern)) ((eq type 'interleave) (rng-transform-interleave-single - `(lambda (p) (rng-start-tag-open-deriv p ',nm)) + (lambda (p) (rng-start-tag-open-deriv p nm)) 'rng-subst-interleave-after ipattern)) ((eq type 'one-or-more) - (rng-apply-after - `(lambda (p) - (rng-intern-group (list p ,(rng-intern-optional ipattern)))) - (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern) - nm))) + (let ((ip (rng-intern-optional ipattern))) + (rng-apply-after + (lambda (p) (rng-intern-group (list p ip))) + (rng-start-tag-open-deriv (rng--ipattern-child ipattern) + nm)))) ((eq type 'after) - (rng-apply-after - `(lambda (p) - (rng-intern-after p - ,(rng-ipattern-get-after ipattern))) - (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern) - nm))) + (let ((nip (rng--ipattern-after ipattern))) + (rng-apply-after + (lambda (p) (rng-intern-after p nip)) + (rng-start-tag-open-deriv (rng--ipattern-child ipattern) + nm)))) (t rng-not-allowed-ipattern)))) (defun rng-start-attribute-deriv (ipattern nm) (or (rng-memo-map-get nm - (rng-ipattern-get-memo-map-start-attribute-deriv ipattern)) + (rng--ipattern-memo-map-start-attribute-deriv ipattern)) (rng-ipattern-memo-start-attribute-deriv ipattern nm @@ -940,82 +912,79 @@ (defun rng-ipattern-memo-start-attribute-deriv (ipattern nm deriv) (or (memq ipattern rng-const-ipatterns) - (rng-ipattern-set-memo-map-start-attribute-deriv - ipattern - (rng-memo-map-add - nm - deriv - (rng-ipattern-get-memo-map-start-attribute-deriv ipattern)))) + (setf (rng--ipattern-memo-map-start-attribute-deriv ipattern) + (rng-memo-map-add + nm + deriv + (rng--ipattern-memo-map-start-attribute-deriv ipattern)))) deriv) (defun rng-compute-start-attribute-deriv (ipattern nm) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'choice) - (rng-transform-choice `(lambda (p) - (rng-start-attribute-deriv p ',nm)) + (rng-transform-choice (lambda (p) + (rng-start-attribute-deriv p nm)) ipattern)) ((eq type 'attribute) (if (rng-name-class-contains - (rng-ipattern-get-name-class ipattern) + (rng--ipattern-name-class ipattern) nm) - (rng-intern-after (rng-ipattern-get-child ipattern) + (rng-intern-after (rng--ipattern-child ipattern) rng-empty-ipattern) rng-not-allowed-ipattern)) ((eq type 'group) (rng-transform-interleave-single - `(lambda (p) (rng-start-attribute-deriv p ',nm)) + (lambda (p) (rng-start-attribute-deriv p nm)) 'rng-subst-group-after ipattern)) ((eq type 'interleave) (rng-transform-interleave-single - `(lambda (p) (rng-start-attribute-deriv p ',nm)) + (lambda (p) (rng-start-attribute-deriv p nm)) 'rng-subst-interleave-after ipattern)) ((eq type 'one-or-more) - (rng-apply-after - `(lambda (p) - (rng-intern-group (list p ,(rng-intern-optional ipattern)))) - (rng-start-attribute-deriv (rng-ipattern-get-child ipattern) - nm))) + (let ((ip (rng-intern-optional ipattern))) + (rng-apply-after + (lambda (p) (rng-intern-group (list p ip))) + (rng-start-attribute-deriv (rng--ipattern-child ipattern) + nm)))) ((eq type 'after) - (rng-apply-after - `(lambda (p) - (rng-intern-after p ,(rng-ipattern-get-after ipattern))) - (rng-start-attribute-deriv (rng-ipattern-get-child ipattern) - nm))) + (let ((nip (rng--ipattern-after ipattern))) + (rng-apply-after + (lambda (p) (rng-intern-after p nip)) + (rng-start-attribute-deriv (rng--ipattern-child ipattern) + nm)))) (t rng-not-allowed-ipattern)))) (defun rng-cons-group-after (x y) - (rng-apply-after `(lambda (p) (rng-intern-group (cons p ',y))) + (rng-apply-after (lambda (p) (rng-intern-group (cons p y))) x)) (defun rng-subst-group-after (new old list) - (rng-apply-after `(lambda (p) - (rng-intern-group (rng-substq p ,old ',list))) + (rng-apply-after (lambda (p) + (rng-intern-group (rng-substq p old list))) new)) (defun rng-subst-interleave-after (new old list) - (rng-apply-after `(lambda (p) - (rng-intern-interleave (rng-substq p ,old ',list))) + (rng-apply-after (lambda (p) + (rng-intern-interleave (rng-substq p old list))) new)) (defun rng-apply-after (f ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) (rng-intern-after - (rng-ipattern-get-child ipattern) - (funcall f - (rng-ipattern-get-after ipattern)))) + (rng--ipattern-child ipattern) + (funcall f (rng--ipattern-after ipattern)))) ((eq type 'choice) - (rng-transform-choice `(lambda (x) (rng-apply-after ,f x)) + (rng-transform-choice (lambda (x) (rng-apply-after f x)) ipattern)) (t rng-not-allowed-ipattern)))) (defun rng-start-tag-close-deriv (ipattern) - (or (rng-ipattern-get-memo-start-tag-close-deriv ipattern) - (rng-ipattern-set-memo-start-tag-close-deriv - ipattern - (rng-compute-start-tag-close-deriv ipattern)))) + (or (rng--ipattern-memo-start-tag-close-deriv ipattern) + (setf (rng--ipattern-memo-start-tag-close-deriv ipattern) + (rng-compute-start-tag-close-deriv ipattern)))) (defconst rng-transform-map '((choice . rng-transform-choice) @@ -1025,7 +994,7 @@ (after . rng-transform-after-child))) (defun rng-compute-start-tag-close-deriv (ipattern) - (let* ((type (rng-ipattern-get-type ipattern))) + (let* ((type (rng--ipattern-type ipattern))) (if (eq type 'attribute) rng-not-allowed-ipattern (let ((transform (assq type rng-transform-map))) @@ -1036,7 +1005,7 @@ ipattern))))) (defun rng-ignore-attributes-deriv (ipattern) - (let* ((type (rng-ipattern-get-type ipattern))) + (let* ((type (rng--ipattern-type ipattern))) (if (eq type 'attribute) rng-empty-ipattern (let ((transform (assq type rng-transform-map))) @@ -1047,13 +1016,12 @@ ipattern))))) (defun rng-text-only-deriv (ipattern) - (or (rng-ipattern-get-memo-text-only-deriv ipattern) - (rng-ipattern-set-memo-text-only-deriv - ipattern - (rng-compute-text-only-deriv ipattern)))) + (or (rng--ipattern-memo-text-only-deriv ipattern) + (setf (rng--ipattern-memo-text-only-deriv ipattern) + (rng-compute-text-only-deriv ipattern)))) (defun rng-compute-text-only-deriv (ipattern) - (let* ((type (rng-ipattern-get-type ipattern))) + (let* ((type (rng--ipattern-type ipattern))) (if (eq type 'element) rng-not-allowed-ipattern (let ((transform (assq type @@ -1069,13 +1037,12 @@ ipattern))))) (defun rng-mixed-text-deriv (ipattern) - (or (rng-ipattern-get-memo-mixed-text-deriv ipattern) - (rng-ipattern-set-memo-mixed-text-deriv - ipattern - (rng-compute-mixed-text-deriv ipattern)))) + (or (rng--ipattern-memo-mixed-text-deriv ipattern) + (setf (rng--ipattern-memo-mixed-text-deriv ipattern) + (rng-compute-mixed-text-deriv ipattern)))) (defun rng-compute-mixed-text-deriv (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'text) ipattern) ((eq type 'after) (rng-transform-after-child 'rng-mixed-text-deriv @@ -1086,7 +1053,7 @@ ((eq type 'one-or-more) (rng-intern-group (list (rng-mixed-text-deriv - (rng-ipattern-get-child ipattern)) + (rng--ipattern-child ipattern)) (rng-intern-optional ipattern)))) ((eq type 'group) (rng-transform-group-nullable @@ -1100,39 +1067,38 @@ (rng-substq new old list))) ipattern)) ((and (eq type 'data) - (not (rng-ipattern-get-memo-text-typed ipattern))) + (not (rng--ipattern-memo-text-typed ipattern))) ipattern) (t rng-not-allowed-ipattern)))) (defun rng-end-tag-deriv (ipattern) - (or (rng-ipattern-get-memo-end-tag-deriv ipattern) - (rng-ipattern-set-memo-end-tag-deriv - ipattern - (rng-compute-end-tag-deriv ipattern)))) + (or (rng--ipattern-memo-end-tag-deriv ipattern) + (setf (rng--ipattern-memo-end-tag-deriv ipattern) + (rng-compute-end-tag-deriv ipattern)))) (defun rng-compute-end-tag-deriv (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'choice) (rng-intern-choice (mapcar 'rng-end-tag-deriv - (rng-ipattern-get-child ipattern)))) + (rng--ipattern-child ipattern)))) ((eq type 'after) - (if (rng-ipattern-get-nullable - (rng-ipattern-get-child ipattern)) - (rng-ipattern-get-after ipattern) + (if (rng--ipattern-nullable + (rng--ipattern-child ipattern)) + (rng--ipattern-after ipattern) rng-not-allowed-ipattern)) (t rng-not-allowed-ipattern)))) (defun rng-data-deriv (ipattern value) (or (rng-memo-map-get value - (rng-ipattern-get-memo-map-data-deriv ipattern)) + (rng--ipattern-memo-map-data-deriv ipattern)) (and (rng-memo-map-get (cons value (rng-namespace-context-get-no-trace)) - (rng-ipattern-get-memo-map-data-deriv ipattern)) + (rng--ipattern-memo-map-data-deriv ipattern)) (rng-memo-map-get (cons value (apply (car rng-dt-namespace-context-getter) (cdr rng-dt-namespace-context-getter))) - (rng-ipattern-get-memo-map-data-deriv ipattern))) + (rng--ipattern-memo-map-data-deriv ipattern))) (let* ((used-context (vector nil)) (rng-dt-namespace-context-getter (cons 'rng-namespace-context-tracer @@ -1161,66 +1127,65 @@ (defun rng-ipattern-memo-data-deriv (ipattern value context deriv) (or (memq ipattern rng-const-ipatterns) (> (length value) rng-memo-data-deriv-max-length) - (rng-ipattern-set-memo-map-data-deriv - ipattern - (rng-memo-map-add (if context (cons value context) value) - deriv - (rng-ipattern-get-memo-map-data-deriv ipattern) - t))) + (setf (rng--ipattern-memo-map-data-deriv ipattern) + (rng-memo-map-add (if context (cons value context) value) + deriv + (rng--ipattern-memo-map-data-deriv ipattern) + t))) deriv) (defun rng-compute-data-deriv (ipattern value) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'text) ipattern) ((eq type 'choice) - (rng-transform-choice `(lambda (p) (rng-data-deriv p ,value)) + (rng-transform-choice (lambda (p) (rng-data-deriv p value)) ipattern)) ((eq type 'group) (rng-transform-group-nullable - `(lambda (p) (rng-data-deriv p ,value)) + (lambda (p) (rng-data-deriv p value)) (lambda (x y) (rng-intern-group (cons x y))) ipattern)) ((eq type 'one-or-more) (rng-intern-group (list (rng-data-deriv - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) value) (rng-intern-optional ipattern)))) ((eq type 'after) - (let ((child (rng-ipattern-get-child ipattern))) - (if (or (rng-ipattern-get-nullable + (let ((child (rng--ipattern-child ipattern))) + (if (or (rng--ipattern-nullable (rng-data-deriv child value)) - (and (rng-ipattern-get-nullable child) + (and (rng--ipattern-nullable child) (rng-blank-p value))) - (rng-ipattern-get-after ipattern) + (rng--ipattern-after ipattern) rng-not-allowed-ipattern))) ((eq type 'data) - (if (rng-dt-make-value (rng-ipattern-get-datatype ipattern) + (if (rng-dt-make-value (rng--ipattern-datatype ipattern) value) rng-empty-ipattern rng-not-allowed-ipattern)) ((eq type 'data-except) - (if (and (rng-dt-make-value (rng-ipattern-get-datatype ipattern) + (if (and (rng-dt-make-value (rng--ipattern-datatype ipattern) value) - (not (rng-ipattern-get-nullable + (not (rng--ipattern-nullable (rng-data-deriv - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) value)))) rng-empty-ipattern rng-not-allowed-ipattern)) ((eq type 'value) - (if (equal (rng-dt-make-value (rng-ipattern-get-datatype ipattern) + (if (equal (rng-dt-make-value (rng--ipattern-datatype ipattern) value) - (rng-ipattern-get-value-object ipattern)) + (rng--ipattern-value-object ipattern)) rng-empty-ipattern rng-not-allowed-ipattern)) ((eq type 'list) (let ((tokens (split-string value)) - (state (rng-ipattern-get-child ipattern))) + (state (rng--ipattern-child ipattern))) (while (and tokens (not (eq state rng-not-allowed-ipattern))) (setq state (rng-data-deriv state (car tokens))) (setq tokens (cdr tokens))) - (if (rng-ipattern-get-nullable state) + (if (rng--ipattern-nullable state) rng-empty-ipattern rng-not-allowed-ipattern))) ;; don't think interleave can occur @@ -1228,7 +1193,7 @@ (t rng-not-allowed-ipattern)))) (defun rng-transform-multi (f ipattern interner) - (let* ((members (rng-ipattern-get-child ipattern)) + (let* ((members (rng--ipattern-child ipattern)) (transformed (mapcar f members))) (if (rng-members-eq members transformed) ipattern @@ -1244,22 +1209,22 @@ (rng-transform-multi f ipattern 'rng-intern-interleave)) (defun rng-transform-one-or-more (f ipattern) - (let* ((child (rng-ipattern-get-child ipattern)) + (let* ((child (rng--ipattern-child ipattern)) (transformed (funcall f child))) (if (eq child transformed) ipattern (rng-intern-one-or-more transformed)))) (defun rng-transform-after-child (f ipattern) - (let* ((child (rng-ipattern-get-child ipattern)) + (let* ((child (rng--ipattern-child ipattern)) (transformed (funcall f child))) (if (eq child transformed) ipattern (rng-intern-after transformed - (rng-ipattern-get-after ipattern))))) + (rng--ipattern-after ipattern))))) (defun rng-transform-interleave-single (f subster ipattern) - (let ((children (rng-ipattern-get-child ipattern)) + (let ((children (rng--ipattern-child ipattern)) found) (while (and children (not found)) (let* ((child (car children)) @@ -1270,7 +1235,7 @@ (funcall subster transformed child - (rng-ipattern-get-child ipattern)))))) + (rng--ipattern-child ipattern)))))) (or found rng-not-allowed-ipattern))) @@ -1286,14 +1251,14 @@ (rng-transform-group-nullable-gen-choices f conser - (rng-ipattern-get-child ipattern)))) + (rng--ipattern-child ipattern)))) (defun rng-transform-group-nullable-gen-choices (f conser members) (let ((head (car members)) (tail (cdr members))) (if tail (cons (funcall conser (funcall f head) tail) - (if (rng-ipattern-get-nullable head) + (if (rng--ipattern-nullable head) (rng-transform-group-nullable-gen-choices f conser tail) nil)) (list (funcall f head))))) @@ -1308,11 +1273,11 @@ (defun rng-ipattern-after (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'choice) (rng-transform-choice 'rng-ipattern-after ipattern)) ((eq type 'after) - (rng-ipattern-get-after ipattern)) + (rng--ipattern-after ipattern)) ((eq type 'not-allowed) ipattern) (t (error "Internal error in rng-ipattern-after: unexpected type %s" type))))) @@ -1321,7 +1286,7 @@ (rng-intern-after (rng-compile rng-any-content) ipattern)) (defun rng-ipattern-optionalize-elements (ipattern) - (let* ((type (rng-ipattern-get-type ipattern)) + (let* ((type (rng--ipattern-type ipattern)) (transform (assq type rng-transform-map))) (cond (transform (funcall (cdr transform) @@ -1332,11 +1297,11 @@ (t ipattern)))) (defun rng-ipattern-empty-before-p (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) - (eq (rng-ipattern-get-child ipattern) rng-empty-ipattern)) + (eq (rng--ipattern-child ipattern) rng-empty-ipattern)) ((eq type 'choice) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) (ret t)) (while (and members ret) (or (rng-ipattern-empty-before-p (car members)) @@ -1346,13 +1311,13 @@ (t nil)))) (defun rng-ipattern-possible-start-tags (ipattern accum) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) (rng-ipattern-possible-start-tags - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) accum)) ((memq type '(choice interleave)) - (let ((members (rng-ipattern-get-child ipattern))) + (let ((members (rng--ipattern-child ipattern))) (while members (setq accum (rng-ipattern-possible-start-tags (car members) @@ -1360,34 +1325,34 @@ (setq members (cdr members)))) accum) ((eq type 'group) - (let ((members (rng-ipattern-get-child ipattern))) + (let ((members (rng--ipattern-child ipattern))) (while members (setq accum (rng-ipattern-possible-start-tags (car members) accum)) (setq members - (and (rng-ipattern-get-nullable (car members)) + (and (rng--ipattern-nullable (car members)) (cdr members))))) accum) ((eq type 'element) (if (eq (rng-element-get-child ipattern) rng-not-allowed-ipattern) accum (rng-name-class-possible-names - (rng-ipattern-get-name-class ipattern) + (rng--ipattern-name-class ipattern) accum))) ((eq type 'one-or-more) (rng-ipattern-possible-start-tags - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) accum)) (t accum)))) (defun rng-ipattern-start-tag-possible-p (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((memq type '(after one-or-more)) (rng-ipattern-start-tag-possible-p - (rng-ipattern-get-child ipattern))) + (rng--ipattern-child ipattern))) ((memq type '(choice interleave)) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) (possible nil)) (while (and members (not possible)) (setq possible @@ -1395,13 +1360,13 @@ (setq members (cdr members))) possible)) ((eq type 'group) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) (possible nil)) (while (and members (not possible)) (setq possible (rng-ipattern-start-tag-possible-p (car members))) (setq members - (and (rng-ipattern-get-nullable (car members)) + (and (rng--ipattern-nullable (car members)) (cdr members)))) possible)) ((eq type 'element) @@ -1410,12 +1375,12 @@ (t nil)))) (defun rng-ipattern-possible-attributes (ipattern accum) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) - (rng-ipattern-possible-attributes (rng-ipattern-get-child ipattern) + (rng-ipattern-possible-attributes (rng--ipattern-child ipattern) accum)) ((memq type '(choice interleave group)) - (let ((members (rng-ipattern-get-child ipattern))) + (let ((members (rng--ipattern-child ipattern))) (while members (setq accum (rng-ipattern-possible-attributes (car members) @@ -1424,21 +1389,21 @@ accum) ((eq type 'attribute) (rng-name-class-possible-names - (rng-ipattern-get-name-class ipattern) + (rng--ipattern-name-class ipattern) accum)) ((eq type 'one-or-more) (rng-ipattern-possible-attributes - (rng-ipattern-get-child ipattern) + (rng--ipattern-child ipattern) accum)) (t accum)))) (defun rng-ipattern-possible-values (ipattern accum) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) - (rng-ipattern-possible-values (rng-ipattern-get-child ipattern) + (rng-ipattern-possible-values (rng--ipattern-child ipattern) accum)) ((eq type 'choice) - (let ((members (rng-ipattern-get-child ipattern))) + (let ((members (rng--ipattern-child ipattern))) (while members (setq accum (rng-ipattern-possible-values (car members) @@ -1446,18 +1411,18 @@ (setq members (cdr members)))) accum) ((eq type 'value) - (let ((value-object (rng-ipattern-get-value-object ipattern))) + (let ((value-object (rng--ipattern-value-object ipattern))) (if (stringp value-object) (cons value-object accum) accum))) (t accum)))) (defun rng-ipattern-required-element (ipattern) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((memq type '(after one-or-more)) - (rng-ipattern-required-element (rng-ipattern-get-child ipattern))) + (rng-ipattern-required-element (rng--ipattern-child ipattern))) ((eq type 'choice) - (let* ((members (rng-ipattern-get-child ipattern)) + (let* ((members (rng--ipattern-child ipattern)) (required (rng-ipattern-required-element (car members)))) (while (and required (setq members (cdr members))) @@ -1466,16 +1431,16 @@ (setq required nil))) required)) ((eq type 'group) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) required) (while (and (not (setq required (rng-ipattern-required-element (car members)))) - (rng-ipattern-get-nullable (car members)) + (rng--ipattern-nullable (car members)) (setq members (cdr members)))) required)) ((eq type 'interleave) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) required) (while members (let ((tem (rng-ipattern-required-element (car members)))) @@ -1491,19 +1456,19 @@ (setq members nil))))) required)) ((eq type 'element) - (let ((nc (rng-ipattern-get-name-class ipattern))) + (let ((nc (rng--ipattern-name-class ipattern))) (and (consp nc) (not (eq (rng-element-get-child ipattern) rng-not-allowed-ipattern)) nc)))))) (defun rng-ipattern-required-attributes (ipattern accum) - (let ((type (rng-ipattern-get-type ipattern))) + (let ((type (rng--ipattern-type ipattern))) (cond ((eq type 'after) - (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern) + (rng-ipattern-required-attributes (rng--ipattern-child ipattern) accum)) ((memq type '(interleave group)) - (let ((members (rng-ipattern-get-child ipattern))) + (let ((members (rng--ipattern-child ipattern))) (while members (setq accum (rng-ipattern-required-attributes (car members) @@ -1511,7 +1476,7 @@ (setq members (cdr members)))) accum) ((eq type 'choice) - (let ((members (rng-ipattern-get-child ipattern)) + (let ((members (rng--ipattern-child ipattern)) in-all in-this new-in-all) (setq in-all (rng-ipattern-required-attributes (car members) @@ -1528,12 +1493,12 @@ (setq in-all new-in-all)) (append in-all accum))) ((eq type 'attribute) - (let ((nc (rng-ipattern-get-name-class ipattern))) + (let ((nc (rng--ipattern-name-class ipattern))) (if (consp nc) (cons nc accum) accum))) ((eq type 'one-or-more) - (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern) + (rng-ipattern-required-attributes (rng--ipattern-child ipattern) accum)) (t accum)))) @@ -1667,7 +1632,7 @@ ns)) (defun rng-match-nullable-p () - (rng-ipattern-get-nullable rng-match-state)) + (rng--ipattern-nullable rng-match-state)) (defun rng-match-possible-start-tag-names () "Return a list of possible names that would be valid for start-tags. @@ -1704,16 +1669,15 @@ (rng-ipattern-required-attributes rng-match-state nil)) (defmacro rng-match-save (&rest body) + (declare (indent 0) (debug t)) (let ((state (make-symbol "state"))) `(let ((,state rng-match-state)) (unwind-protect (progn ,@body) (setq rng-match-state ,state))))) -(put 'rng-match-save 'lisp-indent-function 0) -(def-edebug-spec rng-match-save t) - (defmacro rng-match-with-schema (schema &rest body) + (declare (indent 1) (debug t)) `(let ((rng-current-schema ,schema) rng-match-state rng-compile-table @@ -1724,9 +1688,6 @@ (setq rng-match-state (rng-compile rng-current-schema)) ,@body)) -(put 'rng-match-with-schema 'lisp-indent-function 1) -(def-edebug-spec rng-match-with-schema t) - (provide 'rng-match) ;;; rng-match.el ends here === modified file 'lisp/nxml/xmltok.el' --- lisp/nxml/xmltok.el 2013-08-09 21:22:44 +0000 +++ lisp/nxml/xmltok.el 2013-10-07 13:54:48 +0000 @@ -1,4 +1,4 @@ -;;; xmltok.el --- XML tokenization +;;; xmltok.el --- XML tokenization -*- lexical-binding:t -*- ;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc. @@ -142,6 +142,7 @@ indicating the position of the error.") (defmacro xmltok-save (&rest body) + (declare (indent 0) (debug t)) `(let (xmltok-type xmltok-start xmltok-name-colon @@ -152,9 +153,6 @@ xmltok-errors) ,@body)) -(put 'xmltok-save 'lisp-indent-function 0) -(def-edebug-spec xmltok-save t) - (defsubst xmltok-attribute-name-start (att) (aref att 0)) @@ -411,7 +409,6 @@ (eval-when-compile (let* ((or "\\|") (open "\\(?:") - (gopen "\\(") (close "\\)") (name-start-char "[_[:alpha:]]") (name-continue-not-start-char "[-.[:digit:]]") @@ -988,33 +985,6 @@ (xmltok-valid-char-p n) n))) -(defun xmltok-unclosed-reparse-p (change-start - change-end - pre-change-length - start - end - delimiter) - (let ((len-1 (1- (length delimiter)))) - (goto-char (max start (- change-start len-1))) - (search-forward delimiter (min end (+ change-end len-1)) t))) - -;; Handles a