commit cfb3c61f1ffec9a6322407fdd228d5cc31c31ed0 (HEAD, refs/remotes/origin/master) Author: Alan Third Date: Wed May 4 22:22:09 2016 +0100 Enable dividers in NS (bug#22973) src/nsfns.m: Add colour settings functions to ns_frame_park_handlers. src/nsterm.m (ns_draw_window_divider): ns_focus has to go before the attempt to set the colour. src/nsterm.m (ns_draw_vertical_window_border): This had the same bug as above, although I didn't see any errors. diff --git a/src/nsfns.m b/src/nsfns.m index 820254f..051e509 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -983,8 +983,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side x_set_icon_name, x_set_icon_type, x_set_internal_border_width, /* generic OK */ - 0, /* x_set_right_divider_width */ - 0, /* x_set_bottom_divider_width */ + x_set_right_divider_width, + x_set_bottom_divider_width, x_set_menu_bar_lines, x_set_mouse_color, x_explicitly_set_name, diff --git a/src/nsterm.m b/src/nsterm.m index eba75f1..4b887ec 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2955,10 +2955,11 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. NSTRACE ("ns_draw_vertical_window_border"); face = FACE_OPT_FROM_ID (f, VERTICAL_BORDER_FACE_ID); - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; ns_focus (f, &r, 1); + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; + NSRectFill(r); ns_unfocus (f); } @@ -2977,10 +2978,11 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. NSTRACE ("ns_draw_window_divider"); face = FACE_OPT_FROM_ID (f, WINDOW_DIVIDER_FACE_ID); - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; ns_focus (f, &r, 1); + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; + NSRectFill(r); ns_unfocus (f); } commit 1f5592572887fe15e5b660bc60e66a7ab7c624cd Author: Stephen Berman Date: Mon Jun 27 16:50:03 2016 -0400 ; Fix breakage from previous commit diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 43ff9e0..58498cb 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -371,22 +371,22 @@ and the face `diff-added' for added lines.") (defvar diff-font-lock-keywords `((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$") - (1 diff-hunk-header) (6 diff-function)) + (1 'diff-hunk-header) (6 'diff-function)) ("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context - (1 diff-hunk-header) (2 diff-function)) - ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header) ;context - (,diff-context-mid-hunk-header-re . diff-hunk-header) ;context - ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header) ;normal - ("^---$" . diff-hunk-header) ;normal + (1 'diff-hunk-header) (2 'diff-function)) + ("^\\*\\*\\* .+ \\*\\*\\*\\*". 'diff-hunk-header) ;context + (,diff-context-mid-hunk-header-re . 'diff-hunk-header) ;context + ("^[0-9,]+[acd][0-9,]+$" . 'diff-hunk-header) ;normal + ("^---$" . 'diff-hunk-header) ;normal ;; For file headers, accept files with spaces, but be careful to rule ;; out false-positives when matching hunk headers. ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+?\\)\\(?:\t.*\\| \\(\\*\\*\\*\\*\\|----\\)\\)?\n" - (0 diff-header) - (2 (if (not (match-end 3)) diff-file-header) prepend)) + (0 'diff-header) + (2 (if (not (match-end 3)) 'diff-file-header) prepend)) ("^\\([-<]\\)\\(.*\n\\)" - (1 diff-indicator-removed-face) (2 diff-removed)) + (1 diff-indicator-removed-face) (2 'diff-removed)) ("^\\([+>]\\)\\(.*\n\\)" - (1 diff-indicator-added-face) (2 diff-added)) + (1 diff-indicator-added-face) (2 'diff-added)) ("^\\(!\\)\\(.*\n\\)" (1 (if diff-use-changed-face diff-indicator-changed-face @@ -399,20 +399,20 @@ and the face `diff-added' for added lines.") diff-indicator-added-face diff-indicator-removed-face))))) (2 (if diff-use-changed-face - diff-changed + 'diff-changed ;; Otherwise, use the same method as above. (save-match-data (let ((limit (save-excursion (diff-beginning-of-hunk)))) (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) - diff-added - diff-removed)))))) + 'diff-added + 'diff-removed)))))) ("^\\(?:Index\\|revno\\): \\(.+\\).*\n" - (0 diff-header) (1 diff-index prepend)) - ("^Only in .*\n" . diff-nonexistent) + (0 'diff-header) (1 'diff-index prepend)) + ("^Only in .*\n" . 'diff-nonexistent) ("^\\(#\\)\\(.*\\)" (1 font-lock-comment-delimiter-face) (2 font-lock-comment-face)) - ("^[^-=+*!<>#].*\n" (0 diff-context)))) + ("^[^-=+*!<>#].*\n" (0 'diff-context)))) (defconst diff-font-lock-defaults '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil))) commit 1bd74554970450054c874dbb69837b43f783c6bd Author: Lars Magne Ingebrigtsen Date: Mon Jun 27 22:26:02 2016 +0200 Fix the prefix action of shr-copy-url * lisp/net/shr.el (shr-copy-url): Make the command really copy the image url if given a prefix. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9d42fde..6b19983 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -296,8 +296,10 @@ image under point instead. If called twice, then try to fetch the URL and see whether it redirects somewhere else." (interactive "P") - (let ((url (or (get-text-property (point) 'shr-url) - (get-text-property (point) 'image-url)))) + (let ((url (if image-url + (get-text-property (point) 'image-url) + (or (get-text-property (point) 'shr-url) + (get-text-property (point) 'image-url))))) (cond ((not url) (message "No URL under point")) commit f7ea7aa11f6211b5142bbcfc41c580d75485ca56 Author: Lars Magne Ingebrigtsen Date: Mon Jun 27 22:25:10 2016 +0200 New functions svg-text and svg-remove * doc/lispref/display.texi (SVG Images): Document svg-remove. * doc/lispref/display.texi (SVG Images): Document svg-text. * lisp/svg.el (svg-remove): New function. (svg-text): New function. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 575cad8..b7a6b57 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5350,6 +5350,24 @@ that describe the outer circumference of the polygon. @end lisp @end defun +@defun svg-text svg text &rest args +Add a text to @var{svg}. + +@lisp +(svg-text + svg "This is a text" + :font-size "40" + :font-weight "bold" + :stroke "black" + :fill "white" + :font-family "impact" + :letter-spacing "4pt" + :x 300 + :y 400 + :stroke-width 1) +@end lisp +@end defun + @defun svg-embed svg image image-type datap &rest args Add an embedded (raster) image to @var{svg}. If @var{datap} is @code{nil}, @var{IMAGE} should be a file name; if not, it should be a @@ -5363,6 +5381,10 @@ binary string containing the image data. @var{image-type} should be a @end lisp @end defun +@defun svg-remove svg id +Remove the element with identifier @code{id} from the @code{svg}. +@end defun + Finally, the @code{svg-image} takes an SVG object as its parameter and returns an image object suitable for use in functions like @code{insert-image}. Here's a complete example that creates and diff --git a/lisp/svg.el b/lisp/svg.el index c33b092..a92c6df 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -27,6 +27,7 @@ (require 'cl-lib) (require 'xml) (require 'dom) +(require 'subr-x) (defun svg-create (width height &rest args) "Create a new, empty SVG image with dimensions WIDTHxHEIGHT. @@ -149,13 +150,22 @@ otherwise. IMAGE-TYPE should be a MIME image type, like `((xlink:href . ,(svg--image-data image image-type datap)) ,@(svg--arguments svg args))))) +(defun svg-text (svg text &rest args) + "Add TEXT to SVG." + (svg--append + svg + (dom-node + 'text + `(,@(svg--arguments svg args)) + text))) + (defun svg--append (svg node) (let ((old (and (dom-attr node 'id) (dom-by-id svg (concat "\\`" (regexp-quote (dom-attr node 'id)) "\\'"))))) (if old - (dom-set-attributes old (dom-attributes node)) + (setcdr (car old) (cdr node)) (dom-append-child svg node))) (svg-possibly-update-image svg)) @@ -237,16 +247,26 @@ If the SVG is later changed, the image will also be updated." (defun svg-print (dom) "Convert DOM into a string containing the xml representation." - (insert (format "<%s" (car dom))) - (dolist (attr (nth 1 dom)) - ;; Ignore attributes that start with a colon. - (unless (= (aref (format "%s" (car attr)) 0) ?:) - (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) - (insert ">") - (dolist (elem (nthcdr 2 dom)) - (insert " ") - (svg-print elem)) - (insert (format "" (car dom)))) + (if (stringp dom) + (insert dom) + (insert (format "<%s" (car dom))) + (dolist (attr (nth 1 dom)) + ;; Ignore attributes that start with a colon. + (unless (= (aref (format "%s" (car attr)) 0) ?:) + (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) + (insert ">") + (dolist (elem (nthcdr 2 dom)) + (insert " ") + (svg-print elem)) + (insert (format "" (car dom))))) + +(defun svg-remove (svg id) + "Remove the element identified by ID from SVG." + (when-let ((node (car (dom-by-id + svg + (concat "\\`" (regexp-quote id) + "\\'"))))) + (dom-remove-node svg node))) (provide 'svg) commit 54fe3b6ec0557941c5759523b36bfdec21003f77 Author: Lars Magne Ingebrigtsen Date: Mon Jun 27 22:20:29 2016 +0200 Add new function dom-remove-node * doc/lispref/text.texi (Document Object Model): Document dom-remove-node. * lisp/dom.el (dom-remove-node): New function. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 43d4945..4dc943f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4614,6 +4614,9 @@ to be inserted between the textual elements. @item dom-parent @var{dom} @var{node} Return the parent of @var{node} in @var{dom}. + +@item dom-remove @var{dom} @var{node} +Remove @var{node} from @var{dom}. @end table The following are functions for altering the @acronym{DOM}. diff --git a/lisp/dom.el b/lisp/dom.el index 03fe759..cf3a02a 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -139,6 +139,16 @@ ATTRIBUTE would typically be `class', `id' or the like." (cons dom matches) matches))) +(defun dom-remove-node (dom node) + "Remove NODE from DOM." + ;; If we're removing the top level node, just return nil. + (dolist (child (dom-children dom)) + (cond + ((eq node child) + (delq node dom)) + ((not (stringp child)) + (dom-remove-node child node))))) + (defun dom-parent (dom node) "Return the parent of NODE in DOM." (if (memq node (dom-children dom)) @@ -151,6 +161,7 @@ ATTRIBUTE would typically be `class', `id' or the like." result))) (defun dom-previous-sibling (dom node) + "Return the previous sibling of NODE in DOM." (when-let (parent (dom-parent dom node)) (let ((siblings (dom-children parent)) (previous nil)) commit 44caa96dc5c16cbc4ee1bb26ec880af2e2ecf9f8 Author: Lars Magne Ingebrigtsen Date: Mon Jun 27 18:20:48 2016 +0200 Add a new function `svg-embed' * doc/lispref/display.texi (SVG Images): Document `svg-embed'. * lisp/svg.el (svg-embed): New function. (svg--image-data): Ditto. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index a7c1d09..575cad8 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5350,6 +5350,19 @@ that describe the outer circumference of the polygon. @end lisp @end defun +@defun svg-embed svg image image-type datap &rest args +Add an embedded (raster) image to @var{svg}. If @var{datap} is +@code{nil}, @var{IMAGE} should be a file name; if not, it should be a +binary string containing the image data. @var{image-type} should be a +@acronym{MIME} image type, for instance @samp{"image/jpeg"}. + +@lisp +(svg-embed svg "~/rms.jpg" "image/jpeg" nil + :width "100px" :height "100px" + :x "50px" :y "75px") +@end lisp +@end defun + Finally, the @code{svg-image} takes an SVG object as its parameter and returns an image object suitable for use in functions like @code{insert-image}. Here's a complete example that creates and diff --git a/lisp/svg.el b/lisp/svg.el index c4f3270..c33b092 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -137,6 +137,18 @@ POINTS is a list of x/y pairs." ", ")) ,@(svg--arguments svg args))))) +(defun svg-embed (svg image image-type datap &rest args) + "Insert IMAGE into the SVG structure. +IMAGE should be a file name if DATAP is nil, and a binary string +otherwise. IMAGE-TYPE should be a MIME image type, like +\"image/jpeg\" or the like." + (svg--append + svg + (dom-node + 'image + `((xlink:href . ,(svg--image-data image image-type datap)) + ,@(svg--arguments svg args))))) + (defun svg--append (svg node) (let ((old (and (dom-attr node 'id) (dom-by-id svg @@ -147,6 +159,17 @@ POINTS is a list of x/y pairs." (dom-append-child svg node))) (svg-possibly-update-image svg)) +(defun svg--image-data (image image-type datap) + (with-temp-buffer + (set-buffer-multibyte nil) + (if datap + (insert image) + (insert-file-contents image)) + (base64-encode-region (point-min) (point-max) t) + (goto-char (point-min)) + (insert "data:" image-type ";base64,") + (buffer-string))) + (defun svg--arguments (svg args) (let ((stroke-width (or (plist-get args :stroke-width) (dom-attr svg 'stroke-width))) commit 058e8562775571790e48b1614e84a9617a9e1e17 Author: Eli Zaretskii Date: Mon Jun 27 19:13:48 2016 +0300 * lisp/descr-text.el (describe-char-unicode-data): Fix copy/paste errors. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 5288208..6c7983a 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -277,12 +277,12 @@ This function is semi-obsolete. Use `get-char-code-property'." 'general-category (intern val)) val))) (list "Combining class" - (let ((val (nth 1 fields))) + (let ((val (nth 2 fields))) (or (char-code-property-description 'canonical-combining-class (intern val)) val))) (list "Bidi category" - (let ((val (nth 1 fields))) + (let ((val (nth 3 fields))) (or (char-code-property-description 'bidi-class (intern val)) val))) commit defdee72c4de5e1aa4fc5c63b81983afc969769a Author: Eli Zaretskii Date: Mon Jun 27 18:27:58 2016 +0300 Fix 'move-to-window-line' when EOB is on last screen line * src/window.c (displayed_window_lines): Fix an off-by-one error when the bottom of the last display line is exactly at window's last pixel. Remove kludgey fix for TTY frames that is no longer needed. (Bug#15760) (Fmove_to_window_line): Doc fix. * doc/lispref/positions.texi (Screen Lines): Clarify and make more accurate the documentation of 'move-to-window-line'. diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 1d748b8..796a066 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -590,10 +590,12 @@ any buffer, whether or not it is currently displayed in some window. @deffn Command move-to-window-line count This function moves point with respect to the text currently displayed in the selected window. It moves point to the beginning of the screen -line @var{count} screen lines from the top of the window. If -@var{count} is negative, that specifies a position -@w{@minus{}@var{count}} lines from the bottom (or the last line of the -buffer, if the buffer ends above the specified screen position). +line @var{count} screen lines from the top of the window; zero means +the topmost line. If @var{count} is negative, that specifies a +position @w{@minus{}@var{count}} lines from the bottom (or the last +line of the buffer, if the buffer ends above the specified screen +position); thus, @var{count} of -1 specifies the last fully visible +screen line of the window. If @var{count} is @code{nil}, then point moves to the beginning of the line in the middle of the window. If the absolute value of @var{count} @@ -604,8 +606,8 @@ location onto the screen. In an interactive call, @var{count} is the numeric prefix argument. -The value returned is the window line number point has moved to, with -the top line in the window numbered 0. +The value returned is the screen line number point has moved to, +relative to the top line of the window. @end deffn @vindex move-to-window-group-line-function diff --git a/src/window.c b/src/window.c index fe10241..e123b89 100644 --- a/src/window.c +++ b/src/window.c @@ -5651,21 +5651,14 @@ displayed_window_lines (struct window *w) bottom_y = line_bottom_y (&it); bidi_unshelve_cache (itdata, false); - /* rms: On a non-window display, - the value of it.vpos at the bottom of the screen - seems to be 1 larger than window_box_height (w). - This kludge fixes a bug whereby (move-to-window-line -1) - when ZV is on the last screen line - moves to the previous screen line instead of the last one. */ - if (! FRAME_WINDOW_P (XFRAME (w->frame))) - height++; - /* Add in empty lines at the bottom of the window. */ if (bottom_y < height) { int uy = FRAME_LINE_HEIGHT (it.f); it.vpos += (height - bottom_y + uy - 1) / uy; } + else if (bottom_y == height) + it.vpos++; if (old_buffer) set_buffer_internal (old_buffer); @@ -5940,7 +5933,12 @@ DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, doc: /* Position point relative to window. ARG nil means position point at center of window. Else, ARG specifies vertical position within the window; -zero means top of window, negative means relative to bottom of window. */) +zero means top of window, negative means relative to bottom +of window, -1 meaning the last fully visible display line +of the window. + +Value is the screen line of the window point moved to, counting +from the top of the window. */) (Lisp_Object arg) { struct window *w = XWINDOW (selected_window); commit 8040d99b6294ad798d4ab677ba20082b45fd2e7d Author: Alan Mackenzie Date: Mon Jun 27 11:34:02 2016 +0000 Amend a cache so that typing into C++ raw strings has no undue delay. Also amend the code so that low-level searches to the end of literals are done only when these positions get used. * lisp/progmodes/cc-engine.el (c-crosses-statement-barrier-p): Use the new c-literal-start instead of c-literal-limit. (c-state-semi-nonlit-pos-cache): Change the structure of this cache, such that it stores details of the literal at a point, rather than merely points outside of literals. (c-state-semi-pp-to-literal, c-state-full-pp-to-literal) (c-cache-to-parse-ps-state, c-parse-ps-state-to-cache, c-ps-state-cache-pos) (c-parse-ps-state-below, c-literal-start): New functions. (c-state-semi-safe-place): Removed. (c-in-literal): Use c-state-semi-pp-to-literal, so as not to scan to its end. (c-literal-limits, c-determine-limit-get-base): consequential amendments. (c-find-decl-spots, c-before-change-check-<>-operators, c-raw-string-pos) (c-guess-basic-syntax (CASE 2)): Avoid needless scans to end of literals. * lisp/progmodes/cc-fonts.el (c-font-lock-doc-comments): Avoid needless scans to end of literals. * lisp/progmodes/cc-mode.el (c-fl-decl-start): Avoid needless scans to end of literals. * lisp/progmodes/cc-cmds.el (c-beginning-of-defun, c-end-of-defun) (c-defun-name, c-declaration-limits): Avoid needless scans to end of literals. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 59f2729..f0ad294 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1610,8 +1610,8 @@ defun." ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1734,8 +1734,8 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1793,8 +1793,8 @@ with a brace block." (save-excursion ;; Move back out of any macro/comment/string we happen to be in. (c-beginning-of-macro) - (setq pos (c-literal-limits)) - (if pos (goto-char (car pos))) + (setq pos (c-literal-start)) + (if pos (goto-char pos)) (setq where (c-where-wrt-brace-construct)) @@ -1880,103 +1880,103 @@ with a brace block." (or (save-restriction (c-narrow-to-most-enclosing-decl-block nil) - ;; Note: Some code duplication in `c-beginning-of-defun' and - ;; `c-end-of-defun'. - (catch 'exit - (let ((start (point)) - (paren-state (c-parse-state)) - lim pos end-pos) - (unless (c-safe - (goto-char (c-least-enclosing-brace paren-state)) + ;; Note: Some code duplication in `c-beginning-of-defun' and + ;; `c-end-of-defun'. + (catch 'exit + (let ((start (point)) + (paren-state (c-parse-state)) + lim pos end-pos) + (unless (c-safe + (goto-char (c-least-enclosing-brace paren-state)) ;; If we moved to the outermost enclosing paren ;; then we can use c-safe-position to set the ;; limit. Can't do that otherwise since the ;; earlier paren pair on paren-state might very ;; well be part of the declaration we should go ;; to. - (setq lim (c-safe-position (point) paren-state)) - t) - ;; At top level. Make sure we aren't inside a literal. - (setq pos (c-literal-limits - (c-safe-position (point) paren-state))) - (if pos (goto-char (car pos)))) - - (when (c-beginning-of-macro) - (throw 'exit - (cons (point) - (save-excursion - (c-end-of-macro) - (forward-line 1) - (point))))) + (setq lim (c-safe-position (point) paren-state)) + t) + ;; At top level. Make sure we aren't inside a literal. + (setq pos (c-literal-start + (c-safe-position (point) paren-state))) + (if pos (goto-char pos))) + + (when (c-beginning-of-macro) + (throw 'exit + (cons (point) + (save-excursion + (c-end-of-macro) + (forward-line 1) + (point))))) - (setq pos (point)) - (when (or (eq (car (c-beginning-of-decl-1 lim)) 'previous) - (= pos (point))) - ;; We moved back over the previous defun. Skip to the next - ;; one. Not using c-forward-syntactic-ws here since we - ;; should not skip a macro. We can also be directly after - ;; the block in a `c-opt-block-decls-with-vars-key' - ;; declaration, but then we won't move significantly far - ;; here. - (goto-char pos) - (c-forward-comments) - - (when (and near (c-beginning-of-macro)) - (throw 'exit - (cons (point) - (save-excursion - (c-end-of-macro) - (forward-line 1) - (point)))))) - - (if (eobp) (throw 'exit nil)) - - ;; Check if `c-beginning-of-decl-1' put us after the block in a - ;; declaration that doesn't end there. We're searching back and - ;; forth over the block here, which can be expensive. - (setq pos (point)) - (if (and c-opt-block-decls-with-vars-key - (progn - (c-backward-syntactic-ws) - (eq (char-before) ?})) - (eq (car (c-beginning-of-decl-1)) - 'previous) - (save-excursion - (c-end-of-decl-1) - (and (> (point) pos) - (setq end-pos (point))))) - nil - (goto-char pos)) - - (if (and (not near) (> (point) start)) - nil - - ;; Try to be line oriented; position the limits at the - ;; closest preceding boi, and after the next newline, that - ;; isn't inside a comment, but if we hit a neighboring - ;; declaration then we instead use the exact declaration - ;; limit in that direction. - (cons (progn (setq pos (point)) - (while (and (/= (point) (c-point 'boi)) - (c-backward-single-comment))) - (if (/= (point) (c-point 'boi)) - pos - (point))) - (progn - (if end-pos - (goto-char end-pos) - (c-end-of-decl-1)) + (when (or (eq (car (c-beginning-of-decl-1 lim)) 'previous) + (= pos (point))) + ;; We moved back over the previous defun. Skip to the next + ;; one. Not using c-forward-syntactic-ws here since we + ;; should not skip a macro. We can also be directly after + ;; the block in a `c-opt-block-decls-with-vars-key' + ;; declaration, but then we won't move significantly far + ;; here. + (goto-char pos) + (c-forward-comments) + + (when (and near (c-beginning-of-macro)) + (throw 'exit + (cons (point) + (save-excursion + (c-end-of-macro) + (forward-line 1) + (point)))))) + + (if (eobp) (throw 'exit nil)) + + ;; Check if `c-beginning-of-decl-1' put us after the block in a + ;; declaration that doesn't end there. We're searching back and + ;; forth over the block here, which can be expensive. (setq pos (point)) - (while (and (not (bolp)) - (not (looking-at "\\s *$")) - (c-forward-single-comment))) - (cond ((bolp) - (point)) - ((looking-at "\\s *$") - (forward-line 1) - (point)) - (t + (if (and c-opt-block-decls-with-vars-key + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?})) + (eq (car (c-beginning-of-decl-1)) + 'previous) + (save-excursion + (c-end-of-decl-1) + (and (> (point) pos) + (setq end-pos (point))))) + nil + (goto-char pos)) + + (if (and (not near) (> (point) start)) + nil + + ;; Try to be line oriented; position the limits at the + ;; closest preceding boi, and after the next newline, that + ;; isn't inside a comment, but if we hit a neighboring + ;; declaration then we instead use the exact declaration + ;; limit in that direction. + (cons (progn + (setq pos (point)) + (while (and (/= (point) (c-point 'boi)) + (c-backward-single-comment))) + (if (/= (point) (c-point 'boi)) + pos + (point))) + (progn + (if end-pos + (goto-char end-pos) + (c-end-of-decl-1)) + (setq pos (point)) + (while (and (not (bolp)) + (not (looking-at "\\s *$")) + (c-forward-single-comment))) + (cond ((bolp) + (point)) + ((looking-at "\\s *$") + (forward-line 1) + (point)) + (t pos)))))))) (and (not near) (goto-char (point-min)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 17415a2..4bc4056 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1300,7 +1300,7 @@ comment at the start of cc-engine.el for more info." c-stmt-delim-chars)) (non-skip-list (append (substring skip-chars 1) nil)) ; e.g. (?# ?\; ?{ ?} ?? ?:) - lit-range vsemi-pos) + lit-range lit-start vsemi-pos) (save-restriction (widen) (save-excursion @@ -1315,8 +1315,8 @@ comment at the start of cc-engine.el for more info." ((and (bolp) (save-excursion (progn - (if (setq lit-range (c-literal-limits from)) ; Have we landed in a string/comment? - (goto-char (car lit-range))) + (if (setq lit-start (c-literal-start from)) ; Have we landed in a string/comment? + (goto-char lit-start)) (c-backward-syntactic-ws) ; ? put a limit here, maybe? (setq vsemi-pos (point)) (c-at-vsemi-p)))) @@ -2279,15 +2279,110 @@ comment at the start of cc-engine.el for more info." (defvar c-state-semi-nonlit-pos-cache nil) (make-variable-buffer-local 'c-state-semi-nonlit-pos-cache) -;; A list of buffer positions which are known not to be in a literal. This is -;; ordered with higher positions at the front of the list. Only those which -;; are less than `c-state-semi-nonlit-pos-cache-limit' are valid. +;; A list of elements which are either buffer positions (when such positions +;; are not in literals) or lists of the form (POS TYPE START), where POS is +;; a buffer position inside a literal, TYPE is the type of the literal +;; ('string, 'c, or 'c++) and START is the start of the literal. (defvar c-state-semi-nonlit-pos-cache-limit 1) (make-variable-buffer-local 'c-state-semi-nonlit-pos-cache-limit) -;; An upper limit on valid entries in `c-state-semi-nonlit-pos-cache'. This is -;; reduced by buffer changes, and increased by invocations of -;; `c-state-literal-at'. FIXME!!! +;; An upper limit on valid entries in `c-state-semi-nonlit-pos-cache'. This +;; is reduced by buffer changes, and increased by invocations of +;; `c-parse-ps-state-below'. + +(defun c-state-semi-pp-to-literal (here &optional not-in-delimiter) + ;; Do a parse-partial-sexp from a position in the buffer before HERE which + ;; isn't in a literal, and return information about HERE, either: + ;; (STATE TYPE BEG) if HERE is in a literal; or + ;; (STATE) otherwise, + ;; where STATE is the parsing state at HERE, TYPE is the type of the literal + ;; enclosing HERE, (one of 'string, 'c, 'c++) and BEG is the starting + ;; position of that literal (including the delimiter). + ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; + ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), 7 + ;; (comment type), and 8 (start of comment/string), and possibly 10 (in + ;; newer Emacsen only, the syntax of a position after a potential first char + ;; of a two char construct) of STATE are valid. + (save-excursion + (save-match-data + (let* ((base-and-state (c-parse-ps-state-below here)) + (base (car base-and-state)) + (s (cdr base-and-state)) + (s (parse-partial-sexp base here nil nil s)) + ty) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((nth 7 s) 'c++) + (t 'c))) + (list s ty (nth 8 s))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++)) + (list s ty (point))) + + (t (list s))))))) + +(defun c-state-full-pp-to-literal (here &optional not-in-delimiter) + ;; This function will supersede c-state-pp-to-literal. + ;; + ;; Do a parse-partial-sexp from a position in the buffer before HERE which + ;; isn't in a literal, and return information about HERE, either: + ;; (STATE TYPE (BEG . END)) if HERE is in a literal; or + ;; (STATE) otherwise, + ;; where STATE is the parsing state at HERE, TYPE is the type of the literal + ;; enclosing HERE, (one of 'string, 'c, 'c++) and (BEG . END) is the + ;; boundaries of that literal (including the delimiters). + ;; + ;; Unless NOT-IN-DELIMITER is non-nil, when TO is inside a two-character + ;; comment opener, this is recognized as being in a comment literal. + ;; + ;; Only elements 3 (in a string), 4 (in a comment), 5 (following a quote), 7 + ;; (comment type), and 8 (start of comment/string), and possibly 10 (in + ;; newer Emacsen only, the syntax of a position after a potential first char + ;; of a two char construct) of STATE are valid. + (save-excursion + (save-match-data + (let* ((base-and-state (c-parse-ps-state-below here)) + (base (car base-and-state)) + (s (cdr base-and-state)) + (s (parse-partial-sexp base here nil nil s)) + ty start) + (cond + ((or (nth 3 s) (nth 4 s)) ; in a string or comment + (setq ty (cond + ((nth 3 s) 'string) + ((nth 7 s) 'c++) + (t 'c))) + (setq start (nth 8 s)) + (parse-partial-sexp here (point-max) + nil ; TARGETDEPTH + nil ; STOPBEFORE + s ; OLDSTATE + 'syntax-table) ; stop at end of literal + (list s ty (cons start (point)))) + + ((and (not not-in-delimiter) ; inside a comment starter + (not (bobp)) + (progn (backward-char) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) + (looking-at c-comment-start-regexp)))) + (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) + start (point)) + (forward-comment 1) + (list s ty (cons start (point)))) + + (t (list s))))))) (defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either @@ -2332,6 +2427,103 @@ comment at the start of cc-engine.el for more info." (t `(,s))))))) +(defun c-cache-to-parse-ps-state (elt) + ;; Create a list suitable to use as the old-state parameter to + ;; `parse-partial-sexp', out of ELT. ELT is either just a number, a buffer + ;; position, or it is a list (POS TYPE STARTING-POS). Here POS is the + ;; buffer position the other elements are pertinent for, TYPE is either 'c + ;; or 'c++ (for a comment) or a character (for a string delimiter) or t + ;; (meaning a string fence opened the string), STARTING-POS is the starting + ;; position of the comment or string. + (if (consp elt) + (let ((depth 0) (containing nil) (last nil) + in-string in-comment (after-quote nil) + (min-depth 0) com-style com-str-start (intermediate nil) + (between-syntax nil) + (type (cadr elt))) + (setq com-str-start (car (cddr elt))) + (cond + ((or (numberp type) (eq type t)) ; A string + (setq in-string type)) + ((memq type '(c c++)) ; A comment + (setq in-comment t + com-style (if (eq type 'c++) 1 nil))) + (t (c-benign-error "Invalid type %s in c-cache-to-parse-ps-state" + elt))) + (list depth containing last + in-string in-comment after-quote + min-depth com-style com-str-start + intermediate nil)) + (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + +(defun c-parse-ps-state-to-cache (state) + ;; Convert STATE, a `parse-partial-sexp' state valid at POINT, to an element + ;; for the `c-state-semi-nonlit-pos-cache' cache. This is either POINT + ;; (when point is not in a literal) or a list (POINT TYPE STARTING-POS), + ;; where TYPE is the type of the literal, either 'string, 'c, or 'c++, and + ;; STARTING-POS is the starting position of the comment or string. + (cond + ((nth 3 state) ; A string + (list (point) (nth 3 state) (nth 8 state))) + ((nth 4 state) ; A comment + (list (point) + (if (eq (nth 7 state) 1) 'c++ 'c) + (nth 8 state))) + (t ; Neither string nor comment. + (point)))) + +(defsubst c-ps-state-cache-pos (elt) + ;; Get the buffer position from ELT, an element from the cache + ;; `c-state-semi-nonlit-pos-cache'. + (if (atom elt) + elt + (car elt))) + +(defun c-parse-ps-state-below (here) + ;; Given a buffer position HERE, Return a cons (CACHE-POS . STATE), where + ;; CACHE-POS is a position not very far before HERE for which the + ;; parse-partial-sexp STATE is valid. Note that the only valid elements of + ;; STATE are those concerning comments and strings; STATE is the state of a + ;; null `parse-partial-sexp' scan when CACHE-POS is not in a comment or + ;; string. + (save-restriction + (widen) + (save-excursion + (let ((c c-state-semi-nonlit-pos-cache) + elt state pos npos high-elt) + ;; Trim the cache to take account of buffer changes. + (while (and c (> (c-ps-state-cache-pos (c-ps-state-cache-pos (car c))) + c-state-semi-nonlit-pos-cache-limit)) + (setq c (cdr c))) + (setq c-state-semi-nonlit-pos-cache c) + + (while (and c (> (c-ps-state-cache-pos (car c)) here)) + (setq high-elt (car c)) + (setq c (cdr c))) + (setq pos (or (and c (c-ps-state-cache-pos (car c))) + (point-min))) + + (if high-elt + (setq state (c-cache-to-parse-ps-state (car c))) + (setq elt (if c (car c) (point-min))) + (setq state + (if c + (c-cache-to-parse-ps-state (car c)) + (copy-tree '(0 nil nil nil nil nil 0 nil nil nil nil)))) + (while + ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. + (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) + (setq state (parse-partial-sexp pos npos nil nil state)) + (setq elt (c-parse-ps-state-to-cache state)) + (setq c-state-semi-nonlit-pos-cache + (cons elt c-state-semi-nonlit-pos-cache)) + (setq pos npos))) + + (if (> pos c-state-semi-nonlit-pos-cache-limit) + (setq c-state-semi-nonlit-pos-cache-limit pos)) + + (cons pos state))))) + (defun c-state-safe-place (here) ;; Return a buffer position before HERE which is "safe", i.e. outside any ;; string, comment, or macro. @@ -2397,45 +2589,6 @@ comment at the start of cc-engine.el for more info." (setq c-state-nonlit-pos-cache-limit pos)) pos)))) -(defun c-state-semi-safe-place (here) - ;; Return a buffer position before HERE which is "safe", i.e. outside any - ;; string or comment. It may be in a macro. - (save-restriction - (widen) - (save-excursion - (let ((c c-state-semi-nonlit-pos-cache) - pos npos high-pos lit macro-beg macro-end) - ;; Trim the cache to take account of buffer changes. - (while (and c (> (car c) c-state-semi-nonlit-pos-cache-limit)) - (setq c (cdr c))) - (setq c-state-semi-nonlit-pos-cache c) - - (while (and c (> (car c) here)) - (setq high-pos (car c)) - (setq c (cdr c))) - (setq pos (or (car c) (point-min))) - - (unless high-pos - (while - ;; Add an element to `c-state-semi-nonlit-pos-cache' each iteration. - (and - (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here) - - ;; Test for being in a literal. If so, go to after it. - (progn - (setq lit (car (cddr (c-state-pp-to-literal pos npos)))) - (or (null lit) - (prog1 (<= (cdr lit) here) - (setq npos (cdr lit)))))) - - (setq pos npos) - (setq c-state-semi-nonlit-pos-cache - (cons pos c-state-semi-nonlit-pos-cache)))) - - (if (> pos c-state-semi-nonlit-pos-cache-limit) - (setq c-state-semi-nonlit-pos-cache-limit pos)) - pos)))) - (defun c-state-literal-at (here) ;; If position HERE is inside a literal, return (START . END), the ;; boundaries of the literal (which may be outside the accessible bit of the @@ -4633,8 +4786,7 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-restriction (widen) - (let* ((safe-place (c-state-semi-safe-place (point))) - (lit (c-state-pp-to-literal safe-place (point)))) + (let ((lit (c-state-semi-pp-to-literal (point)))) (or (cadr lit) (and detect-cpp (save-excursion (c-beginning-of-macro)) @@ -4656,14 +4808,19 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion - (let* ((pos (point)) - (lim (or lim (c-state-semi-safe-place pos))) - (pp-to-lit (save-restriction - (widen) - (c-state-pp-to-literal lim pos not-in-delimiter))) - (state (car pp-to-lit)) - (lit-limits (car (cddr pp-to-lit)))) - + (let* + ((pos (point)) + (lit-limits + (if lim + (let ((s (parse-partial-sexp lim (point)))) + (when (or (nth 3 s) (nth 4 s)) + (cons (nth 8 s) + (progn (parse-partial-sexp (point) (point-max) + nil 'syntax-table + s) + (point))))) + (let ((pp-to-lit (c-state-full-pp-to-literal pos not-in-delimiter))) + (car (cddr pp-to-lit)))))) (cond (lit-limits) @@ -4702,6 +4859,16 @@ comment at the start of cc-engine.el for more info." (if beg (cons beg end)))))) )))) +(defun c-literal-start (&optional safe-pos) + "Return the start of the string or comment surrounding point, or nil if +point isn't in one. SAFE-POS, if non-nil, is a position before point which is +a known \"safe position\", i.e. outside of any string or comment." + (if safe-pos + (let ((s (parse-partial-sexp safe-pos (point)))) + (and (or (nth 3 s) (nth 4 s)) + (nth 8 s))) + (car (cddr (c-state-semi-pp-to-literal (point)))))) + ;; In case external callers use this; it did have a docstring. (defalias 'c-literal-limits-fast 'c-literal-limits) @@ -4766,13 +4933,10 @@ comment at the start of cc-engine.el for more info." (defsubst c-determine-limit-get-base (start try-size) ;; Get a "safe place" approximately TRY-SIZE characters before START. - ;; This doesn't preserve point. + ;; This defsubst doesn't preserve point. (let* ((pos (max (- start try-size) (point-min))) - (base (c-state-semi-safe-place pos)) - (s (parse-partial-sexp base pos))) - (if (or (nth 4 s) (nth 3 s)) ; comment or string - (nth 8 s) - (point)))) + (s (c-state-semi-pp-to-literal pos))) + (or (car (cddr s)) pos))) (defun c-determine-limit (how-far-back &optional start try-size) ;; Return a buffer position HOW-FAR-BACK non-literal characters from START @@ -5152,8 +5316,9 @@ comment at the start of cc-engine.el for more info." ;; arrived at something that looks like a start or else ;; resort to `c-literal-limits'. (unless (looking-at c-literal-start-regexp) - (let ((range (c-literal-limits))) - (if range (goto-char (car range))))) + (let ((lit-start (c-literal-start))) + (if lit-start (goto-char lit-start))) + ) (setq start-in-literal (point))) ; end of `and' arm. @@ -5690,12 +5855,12 @@ comment at the start of cc-engine.el for more info." ;; 2010-01-29. (save-excursion (c-save-buffer-state - ((beg-lit-limits (progn (goto-char beg) (c-literal-limits))) + ((beg-lit-start (progn (goto-char beg) (c-literal-start))) (end-lit-limits (progn (goto-char end) (c-literal-limits))) new-beg new-end beg-limit end-limit) ;; Locate the earliest < after the barrier before the changed region, ;; which isn't already marked as a paren. - (goto-char (if beg-lit-limits (car beg-lit-limits) beg)) + (goto-char (or beg-lit-start beg)) (setq beg-limit (c-determine-limit 512)) ;; Remove the syntax-table/category properties from each pertinent <...> @@ -5854,9 +6019,8 @@ comment at the start of cc-engine.el for more info." ;; ;; Note: this routine is dependant upon the correct syntax-table text ;; properties being set. - (let* ((safe (c-state-semi-safe-place (point))) - (state (c-state-pp-to-literal safe (point))) - open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) + (let ((state (c-state-semi-pp-to-literal (point))) + open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) (save-excursion (when (and @@ -5865,7 +6029,7 @@ comment at the start of cc-engine.el for more info." (or (eq (char-after) ?\") (search-backward "\"" (max (- (point) 17) (point-min)) t))) ((and (eq (cadr state) 'string) - (goto-char (car (nth 2 state))) + (goto-char (nth 2 state)) (or (eq (char-after) ?\") (search-backward "\"" (max (- (point) 17) (point-min)) t)) (not (bobp))))) @@ -10551,8 +10715,8 @@ comment at the start of cc-engine.el for more info." ;; versions, which results in that we get nil from ;; `c-literal-limits' even when `c-in-literal' claims ;; we're inside a comment. - (setq placeholder (c-literal-limits lim))) - (c-add-syntax literal (car placeholder))) + (setq placeholder (c-literal-start lim))) + (c-add-syntax literal placeholder)) ;; CASE 3: in a cpp preprocessor macro continuation. ((and (save-excursion diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 3a8c9ec..52f0b0d 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2480,10 +2480,10 @@ need for `pike-font-lock-extra-types'.") 'font-lock-comment-face) ;; Handle the case when the fontified region starts inside a ;; comment. - (let ((range (c-literal-limits))) + (let ((start (c-literal-start))) (setq region-beg (point)) - (when range - (goto-char (car range))) + (when start + (goto-char start)) (when (looking-at prefix) (setq comment-beg (point))))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 80ac08f..5ad7a01 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1299,12 +1299,12 @@ Note that the style variables are always made local to the buffer." ;; This function is called indirectly from font locking stuff - either from ;; c-after-change (to prepare for after-change font-locking) or from font ;; lock context (etc.) fontification. - (let ((lit-limits (c-literal-limits)) + (let ((lit-start (c-literal-start)) (new-pos pos) bod-lim bo-decl) (goto-char (c-point 'bol new-pos)) - (when lit-limits ; Comment or string. - (goto-char (car lit-limits))) + (when lit-start ; Comment or string. + (goto-char lit-start)) (setq bod-lim (c-determine-limit 500)) (while