commit 3f90aa7eec8909d6e4501dcd551665981b6b09af (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Apr 20 23:10:37 2019 -0700 Port make-fingerprint to LeakSanitizer * lib-src/make-fingerprint.c (buf): Now static, to pacify LeakSanitizer. diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index 38a3357614..79bd007a5f 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c @@ -57,6 +57,9 @@ along with GNU Emacs. If not, see . */ #endif #endif /* WINDOWSNT */ +/* Static (instead of being local to 'main') to pacify LeakSanitizer. */ +static char *buf; + int main (int argc, char **argv) { @@ -111,7 +114,7 @@ main (int argc, char **argv) return EXIT_FAILURE; } - char *buf = malloc (st.st_size + 1); + buf = malloc (st.st_size + 1); if (!buf) { perror ("malloc"); commit 515f57826f5cc2d85232f0d897d0e02a069667db Author: Michael R. Mauger Date: Sun Apr 21 00:40:00 2019 -0400 * lisp/progmodes/sql.el Bug#35307 (sql-product-alist): Added :prompt-cont-regexp for ms. Looking for experience with Microsofts SQLCMD interpreter and adjustments needed for Emacs to support it. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 7d29d0011c..28261ef74b 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -443,6 +443,7 @@ file. Since that is a plaintext file, this could be dangerous." :sqli-login sql-ms-login-params :sqli-comint-func sql-comint-ms :prompt-regexp "^[0-9]*>" + :prompt-cont-regexp "^[0-9]*>" :prompt-length 5 :syntax-alist ((?@ . "_")) :terminator ("^go" . "go")) @@ -1219,6 +1220,11 @@ Starts `sql-interactive-mode' after doing some setup." ;; Customization for Microsoft +;; Microsoft documentation seems to indicate that ISQL and OSQL are +;; going away and being replaced by SQLCMD. If anyone has experience +;; using SQLCMD, modified product configuration and feedback on its +;; use would be greatly appreciated. + (defcustom sql-ms-program "osql" "Command to start osql by Microsoft. commit d76fea29d8cdfcd715c8c1da592adf1b615e12f4 Author: Michael R. Mauger Date: Sun Apr 21 00:19:56 2019 -0400 * lisp/progmodes/sql.el Bug#24483 (sql-interactive-remove-continuation-prompt): Properly protect `sql-prompt-cont-regexp'. (sql-interactive-mode): Same. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index fa9354e012..7d29d0011c 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3746,7 +3746,8 @@ to avoid deleting non-prompt output." (or (> (length (or sql-preoutput-hold "")) 0) (> (or sql-output-newline-count 0) 0) (not (or (string-match sql-prompt-regexp oline) - (string-match sql-prompt-cont-regexp oline))))) + (and sql-prompt-cont-regexp + (string-match sql-prompt-cont-regexp oline)))))) (save-match-data (let (prompt-found last-nl) @@ -4394,12 +4395,12 @@ you entered, right above the output it created. ;; Set comint based on user overrides. (setq comint-prompt-regexp (if sql-prompt-cont-regexp - (concat "\\(" sql-prompt-regexp - "\\|" sql-prompt-cont-regexp "\\)") + (concat "\\(?:\\(?:" sql-prompt-regexp "\\)" + "\\|\\(?:" sql-prompt-cont-regexp "\\)\\)") sql-prompt-regexp)) (setq left-margin (or sql-prompt-length 0)) ;; Install input sender - (set (make-local-variable 'comint-input-sender) 'sql-input-sender) + (set (make-local-variable 'comint-input-sender) #'sql-input-sender) ;; People wanting a different history file for each ;; buffer/process/client/whatever can change separator and file-name ;; on the sql-interactive-mode-hook. commit 23d8cfb9ce950f12b80314a9840a637177178e29 Author: Michael R. Mauger Date: Sat Apr 20 20:13:56 2019 -0400 * lisp/progmodes.sql.el (sql-product-alist): Corrected :terminator defns. (sql-debug-send): New variable. (sql-send-string): Use it and correct buffer context. (sql-send-magic-terminator): Use `sql-input-sender'. (sql-placeholders-filter): Bug#11481 Don't recursively replace placeholders * test/lisp/progmodes/sql-tests.el (sql-test-placeholder-filter): Test placeholder functionality. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 4ab174d92b..fa9354e012 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -223,6 +223,7 @@ ;; Simen Heggestøyl -- Postgres database completion ;; Robert Cochran -- MariaDB support ;; Alex Harsanyi -- sql-indent package and support +;; Roy Mathew -- bug in `sql-send-string' ;; @@ -477,7 +478,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}" :statement sql-oracle-statement-starters :syntax-alist ((?$ . "_") (?# . "_")) - :terminator ("\\(^/\\|;\\)$" . "/") + :terminator ("\\(^/\\|;\\)" . "/") :input-filter sql-placeholders-filter) (postgres @@ -495,7 +496,7 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-length 5 :prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] " :input-filter sql-remove-tabs-filter - :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g")) + :terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g")) (solid :name "Solid" @@ -520,8 +521,7 @@ file. Since that is a plaintext file, this could be dangerous." :completion-object sql-sqlite-completion-object :prompt-regexp "^sqlite> " :prompt-length 8 - :prompt-cont-regexp "^ \\.\\.\\.> " - :terminator ";") + :prompt-cont-regexp "^ \\.\\.\\.> ") (sybase :name "Sybase" @@ -3640,12 +3640,16 @@ Inserts SELECT or commas if appropriate." Placeholders are words starting with an ampersand like &this." (when sql-oracle-scan-on - (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string) - (setq string (replace-match - (read-from-minibuffer - (format "Enter value for %s: " (match-string 1 string)) - nil nil nil 'sql-placeholder-history) - t t string)))) + (let ((start 0) + (replacement "")) + (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string start) + (setq replacement (read-from-minibuffer + (format "Enter value for %s: " + (propertize (match-string 1 string) + 'face 'font-lock-variable-name-face)) + nil nil nil 'sql-placeholder-history) + string (replace-match replacement t t string) + start (+ (match-beginning 1) (length replacement)))))) string) ;; Using DB2 interactively, newlines must be escaped with " \". @@ -3794,6 +3798,8 @@ to avoid deleting non-prompt output." oline) ;;; Sending the region to the SQLi buffer. +(defvar sql-debug-send nil + "Display text sent to SQL process pragmatically.") (defun sql-send-string (str) "Send the string STR to the SQL process." @@ -3807,12 +3813,14 @@ to avoid deleting non-prompt output." (save-excursion ;; Set product context (with-current-buffer sql-buffer + (when sql-debug-send + (message ">>SQL> %S" s)) + ;; Send the string (trim the trailing whitespace) - (sql-input-sender (get-buffer-process sql-buffer) s) + (sql-input-sender (get-buffer-process (current-buffer)) s) ;; Send a command terminator if we must - (when sql-send-terminator - (sql-send-magic-terminator sql-buffer s sql-send-terminator)) + (sql-send-magic-terminator sql-buffer s sql-send-terminator) (when sql-pop-to-buffer-after-send-region (message "Sent string to buffer %s" sql-buffer)))) @@ -3874,12 +3882,8 @@ to avoid deleting non-prompt output." ;; Check to see if the pattern is present in the str already sent (unless (and pat term - (string-match (concat pat "\\'") str)) - (comint-simple-send (get-buffer-process buf) term) - (setq sql-output-newline-count - (if sql-output-newline-count - (1+ sql-output-newline-count) - 1))))) + (string-match-p (concat pat "\\'") str)) + (sql-input-sender (get-buffer-process buf) term)))) (defun sql-remove-tabs-filter (str) "Replace tab characters with spaces." diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 7a11f762eb..5ac34907c2 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -270,5 +270,39 @@ Perform ACTION and validate results" (sql-test-product-feature-harness (should-not (sql-get-product-feature 'd :Z)))) +;;; SQL Oracle SCAN/DEFINE +(ert-deftest sql-tests-placeholder-filter () + "Test that placeholder relacement is as expected." + (let ((syntab (syntax-table)) + (sql-oracle-scan-on t) + (placeholder-value "")) + (set-syntax-table sql-mode-syntax-table) + + (cl-letf + (((symbol-function 'read-from-minibuffer) + (lambda (&rest _) placeholder-value))) + + (setq placeholder-value "XX") + (should (equal + (sql-placeholders-filter "select '&x' from dual;") + "select 'XX' from dual;")) + + (setq placeholder-value "&Y") + (should (equal + (sql-placeholders-filter "select '&x' from dual;") + "select '&Y' from dual;")) + (should (equal + (sql-placeholders-filter "select '&x' from dual;") + "select '&Y' from dual;")) + (should (equal + (sql-placeholders-filter "select '&x.' from dual;") + "select '&Y' from dual;")) + (should (equal + (sql-placeholders-filter "select '&x.y' from dual;") + "select '&Yy' from dual;"))) + + (set-syntax-table syntab))) + + (provide 'sql-tests) ;;; sql-tests.el ends here commit 21db386ac0df26f0b1a549e0bd4f83c5bbce6361 Author: YAMAMOTO Mitsuharu Date: Sun Apr 21 11:39:06 2019 +0900 Fix text metrics calculation in Xft support for lwlib * lwlib/lwlib-Xaw.c (get_text_width_and_height) [HAVE_XFT]: * lwlib/xlwmenu.c (string_width) [HAVE_XFT]: Use xOff member instead of width. diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index 8e3a07f202..9655076da9 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -154,7 +154,7 @@ get_text_width_and_height (Widget widget, char *text, &gi); bp = cp ? cp + 1 : NULL; h += xft_font->height; - if (w < gi.width) w = gi.width; + if (w < gi.xOff) w = gi.xOff; } *height = h; diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 07ad29e107..a5704cbfb5 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -332,7 +332,7 @@ string_width (XlwMenuWidget mw, char *s) XftTextExtentsUtf8 (XtDisplay (mw), mw->menu.xft_font, (FcChar8 *) s, strlen (s), &gi); - return gi.width; + return gi.xOff; } #endif #ifdef HAVE_X_I18N commit 6a373e4742386777fe901f040bdcaf0c9056fa70 Author: Alexander Gramiak Date: Sat Apr 20 20:16:20 2019 -0600 * src/configure.ac: Check for GTK 2 features only on GTK 2 diff --git a/configure.ac b/configure.ac index 9d39bdd76b..b4a9b30691 100644 --- a/configure.ac +++ b/configure.ac @@ -2795,22 +2795,25 @@ if test "${HAVE_GTK}" = "yes"; then with_toolkit_scroll_bars=yes fi - dnl Check if we have the old file selection dialog declared and - dnl in the link library. In 2.x it may be in the library, - dnl but not declared if deprecated featured has been selected out. - dnl AC_CHECK_DECL checks for a macro, so check for GTK_TYPE_FILE_SELECTION. - HAVE_GTK_FILE_SELECTION=no - AC_CHECK_DECL(GTK_TYPE_FILE_SELECTION, HAVE_GTK_FILE_SELECTION=yes, - HAVE_GTK_FILE_SELECTION=no, [AC_INCLUDES_DEFAULT -#include ]) - if test "$HAVE_GTK_FILE_SELECTION" = yes; then - AC_CHECK_FUNCS(gtk_file_selection_new) - fi + term_header=gtkutil.h + + if test "${USE_GTK_TOOLKIT}" = GTK2; then - dnl This procedure causes a bug on certain Ubuntu GTK+2 builds - AC_CHECK_FUNCS(gtk_window_set_has_resize_grip) + dnl Check if we have the old file selection dialog declared and + dnl in the link library. In 2.x it may be in the library, + dnl but not declared if deprecated featured has been selected out. + dnl AC_CHECK_DECL checks for a macro, so check for GTK_TYPE_FILE_SELECTION. + HAVE_GTK_FILE_SELECTION=no + AC_CHECK_DECL(GTK_TYPE_FILE_SELECTION, HAVE_GTK_FILE_SELECTION=yes, + HAVE_GTK_FILE_SELECTION=no, [AC_INCLUDES_DEFAULT +#include ]) + if test "$HAVE_GTK_FILE_SELECTION" = yes; then + AC_CHECK_FUNCS(gtk_file_selection_new) + fi - term_header=gtkutil.h + dnl This procedure causes a bug on certain Ubuntu GTK+2 builds + AC_CHECK_FUNCS(gtk_window_set_has_resize_grip) + fi fi commit 75e68b87778d0f0a803980d59793b78834443972 Author: YAMAMOTO Mitsuharu Date: Sun Apr 21 09:53:39 2019 +0900 * lwlib/lwlib-Xaw.c (draw_text) [HAVE_XFT]: Fix memory leak. diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index 24b31fc295..8e3a07f202 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -170,11 +170,12 @@ draw_text (struct widget_xft_data *data, char *lbl, int inverse) int x = inverse ? 0 : 2; char *bp = lbl; - data->xft_draw = XftDrawCreate (XtDisplay (data->widget), - data->p, - DefaultVisual (XtDisplay (data->widget), - screen), - DefaultColormapOfScreen (sc)); + if (!data->xft_draw) + data->xft_draw = XftDrawCreate (XtDisplay (data->widget), + data->p, + DefaultVisual (XtDisplay (data->widget), + screen), + DefaultColormapOfScreen (sc)); XftDrawRect (data->xft_draw, inverse ? &data->xft_fg : &data->xft_bg, 0, 0, data->p_width, data->p_height); commit 70f3175738225252acc5041b210c5b39376af1a1 Author: Dmitry Gutov Date: Sun Apr 21 00:39:36 2019 +0300 Support amending the last commit using VC-Hg * lisp/vc/log-edit.el (log-edit--toggle-amend): Extract from vc-git-log-edit-toggle-amend (bug#34944). * lisp/vc/vc-hg.el (vc-hg-log-edit-toggle-amend): New function. Use the aforementioned. (vc-hg-log-edit-mode-map): New variable. (vc-hg-log-edit-mode): New major mode. diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index ba5a1a3d57..91e18c1ec5 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1087,6 +1087,22 @@ line of MSG." (if summary (insert summary "\n\n")) (cons (buffer-string) res)))) +(defun log-edit--toggle-amend (last-msg-fn) + (when (log-edit-toggle-header "Amend" "yes") + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (funcall last-msg-fn)) + (save-excursion + (rfc822-goto-eoh) + (forward-line 1) + (let ((pt (point))) + (and (zerop (forward-line 1)) + (looking-at "\n\\|\\'") + (let ((summary (buffer-substring-no-properties pt (1- (point))))) + (skip-chars-forward " \n") + (delete-region pt (point)) + (log-edit-set-header "Summary" summary))))))) + (provide 'log-edit) ;;; log-edit.el ends here diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index a921ff1bb8..192e6cf68f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -750,7 +750,7 @@ The car of the list is the current branch." (declare-function log-edit-mode "log-edit" ()) (declare-function log-edit-toggle-header "log-edit" (header value)) (declare-function log-edit-extract-headers "log-edit" (headers string)) -(declare-function log-edit-set-header "log-edit" (header value &optional toggle)) +(declare-function log-edit--toggle-amend "log-edit" (last-msg-fn)) (defun vc-git-log-edit-toggle-signoff () "Toggle whether to add the \"Signed-off-by\" line at the end of @@ -767,23 +767,12 @@ the commit message." "Toggle whether this will amend the previous commit. If toggling on, also insert its message into the buffer." (interactive) - (when (log-edit-toggle-header "Amend" "yes") - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (insert (with-output-to-string - (vc-git-command - standard-output 1 nil - "log" "--max-count=1" "--pretty=format:%B" "HEAD"))) - (save-excursion - (rfc822-goto-eoh) - (forward-line 1) - (let ((pt (point))) - (and (zerop (forward-line 1)) - (looking-at "\n\\|\\'") - (let ((summary (buffer-substring-no-properties pt (1- (point))))) - (skip-chars-forward " \n") - (delete-region pt (point)) - (log-edit-set-header "Summary" summary))))))) + (log-edit--toggle-amend + (lambda () + (with-output-to-string + (vc-git-command + standard-output 1 nil + "log" "--max-count=1" "--pretty=format:%B" "HEAD"))))) (defvar vc-git-log-edit-mode-map (let ((map (make-sparse-keymap "Git-Log-Edit"))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 6b17e861dd..d3f132dae7 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1104,15 +1104,42 @@ hg binary." (vc-hg-command nil 0 file "forget")) (declare-function log-edit-extract-headers "log-edit" (headers string)) +(declare-function log-edit-mode "log-edit" ()) +(declare-function log-edit--toggle-amend "log-edit" (last-msg-fn)) + +(defun vc-hg-log-edit-toggle-amend () + "Toggle whether this will amend the previous commit. +If toggling on, also insert its message into the buffer." + (interactive) + (log-edit--toggle-amend + (lambda () + (with-output-to-string + (vc-hg-command + standard-output 1 nil + "log" "--limit=1" "--template" "{desc}"))))) + +(defvar vc-hg-log-edit-mode-map + (let ((map (make-sparse-keymap "Hg-Log-Edit"))) + (define-key map "\C-c\C-e" 'vc-hg-log-edit-toggle-amend) + map)) + +(define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg" + "Major mode for editing Hg log messages. +It is based on `log-edit-mode', and has Hg-specific extensions.") (defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (apply 'vc-hg-command nil 0 files - (nconc (list "commit" "-m") - (log-edit-extract-headers '(("Author" . "--user") - ("Date" . "--date")) - comment)))) + (let ((amend-extract-fn + (lambda (value) + (when (equal value "yes") + (list "--amend"))))) + (apply 'vc-hg-command nil 0 files + (nconc (list "commit" "-m") + (log-edit-extract-headers `(("Author" . "--user") + ("Date" . "--date") + ("Amend" . ,amend-extract-fn)) + comment))))) (defun vc-hg-find-revision (file rev buffer) (let ((coding-system-for-read 'binary) commit 6d1025f944128391a27b388d4cb34d187a0a26b9 Author: Michael Albinus Date: Sat Apr 20 21:16:05 2019 +0200 Mark different-diagnostic-types as failed on emba. * test/lisp/progmodes/flymake-tests.el (different-diagnostic-types): Expect also failure on emba.gnu.org. diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 732193476d..c116862432 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -143,7 +143,8 @@ SEVERITY-PREDICATE is used to setup (ert-deftest different-diagnostic-types () "Test GCC warning via function predicate." ;; http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01043.html - :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) + :expected-result (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) + :failed :passed) (skip-unless (and (executable-find "gcc") (version<= "5" (string-trim commit b3a12c62c9085171866256f00dada4326a4a3084 Author: Paul Eggert Date: Sat Apr 20 09:31:47 2019 -0700 Improve XDG_RUNTIME_DIR diagnostic * lib-src/emacsclient.c (set_local_socket): If there appears to be an XDG runtime directory for the user but XDG_RUNTIME_DIR is unset, suggest setting it while warning about potential security issues (Bug#35300). diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index f476840898..5871a18ce6 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1357,6 +1357,7 @@ set_local_socket (char const *server_name) int tmpdirlen = -1; int socknamelen = -1; uid_t uid = geteuid (); + bool tmpdir_used = false; if (strchr (server_name, '/') || (ISSLASH ('\\') && strchr (server_name, '\\'))) @@ -1389,6 +1390,7 @@ set_local_socket (char const *server_name) } socknamelen = local_sockname (sockname, socknamesize, tmpdirlen, uid, server_name); + tmpdir_used = true; } } @@ -1462,11 +1464,27 @@ set_local_socket (char const *server_name) if (sock_status < 0) message (true, "%s: Invalid socket owner\n", progname); else if (sock_status == ENOENT) - message (true, - ("%s: can't find socket; have you started the server?\n" - "%s: To start the server in Emacs," - " type \"M-x server-start\".\n"), - progname, progname); + { + if (tmpdir_used) + { + uintmax_t id = uid; + char sockdirname[socknamesize]; + int sockdirnamelen = snprintf (sockdirname, sizeof sockdirname, + "/run/user/%"PRIuMAX, id); + if (0 <= sockdirnamelen && sockdirnamelen < sizeof sockdirname + && euidaccess (sockdirname, X_OK) == 0) + message + (true, + ("%s: Should XDG_RUNTIME_DIR='%s' be in the environment?\n" + "%s: (Be careful: XDG_RUNTIME_DIR is security-related.)\n"), + progname, sockdirname, progname); + } + message (true, + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); + } else message (true, "%s: can't stat %s: %s\n", progname, sockname, strerror (sock_status)); commit a85befa4aa52033bd6d9927144b358529ec2b360 Author: Alan Mackenzie Date: Sat Apr 20 11:30:55 2019 +0000 Fix Pike Mode's autodoc doc comments style's continued lines. * lisp/progmodes/cc-engine.el (c-forward-sws, c-backward-sws): Recognize matches of c-doc-line-join-re as syntactic whitespace. (c-find-decl-prefix-search): Recognize and move over matches of c-doc-line-join-re as whitespace. (c-find-decl-spots): Before moving backward a char, check (bobp). Before moving forward over a comment, check it isn't possibly a "bright" comment. * lisp/progmodes/cc-fonts.el (c-get-doc-comment-style): New function, extracted from c-compose-keywords-list. (c-compose-keywords-list): Call the above new function. (pike-font-lock-keywords, pike-font-lock-keywords-2) (pike-font-lock-keywords-3): Call c-set-doc-comment-res. (c-doc-line-join-re, c-doc-bright-comment-start-re, c-doc-line-join-end-ch): New variables. (c-set-doc-comment-re-element, c-set-doc-comment-char-list): New macros. (c-set-doc-comment-res): New function. (c-font-lock-doc-comments): For consistency and repeatability, in a sequence of C++ style doc comments, don't fontify the region between BOL and the comment marker. (autodoc-line-join-re, autodoc-bright-comment-start-re) (autodoc-line-join-end-ch): New variables. * lisp/progmodes/cc-mode.el (c-doc-fl-decl-start, c-doc-fl-decl-end): New functions. (c-change-expand-fl-region, c-context-expand-fl-region): Call the above two new functions for extra possibilities for the start and end of a construct. * doc/misc/cc-mode.texi (Doc Comments): Add a sentence drawing attention to the possibility of fontifying constructs within a doc comment. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index f73a7fb57c..6db2c96f2d 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -2140,7 +2140,10 @@ with @code{c-doc-comment-style}: Supply a variable or function in @code{c-doc-comment-style}. If it's a variable, it's prepended to @code{font-lock-keywords}. If it's a function, it's called at mode initialization and the result is prepended. For an example, see -@code{javadoc-font-lock-keywords} in @file{cc-fonts.el}. +@code{javadoc-font-lock-keywords} in @file{cc-fonts.el}. It is even +possible, to a limited extent, to fontify constructs inside a doc +comment with other faces. For an example, see pike autodoc comment +style towards the end of @file{cc-fonts-el}. If you add support for another doc comment style, please consider contributing it: send a note to @email{bug-cc-mode@@gnu.org}. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f0b44d2183..80115fb3a3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -152,6 +152,10 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) +(defvar c-doc-line-join-re) +(defvar c-doc-bright-comment-start-re) +(defvar c-doc-line-join-end-ch) + ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -1930,7 +1934,8 @@ comment at the start of cc-engine.el for more info." (skip-chars-forward " \t\n\r\f\v") (when (or (looking-at c-syntactic-ws-start) (and c-opt-cpp-prefix - (looking-at c-noise-macro-name-re))) + (looking-at c-noise-macro-name-re)) + (looking-at c-doc-line-join-re)) (setq rung-end-pos (min (1+ (point)) (point-max))) (if (setq rung-is-marked (text-property-any rung-pos rung-end-pos @@ -2060,6 +2065,13 @@ comment at the start of cc-engine.el for more info." (looking-at c-noise-macro-name-re)) ;; Skip over a noise macro. (goto-char (match-end 1)) + (not (eobp))) + + ((looking-at c-doc-line-join-re) + ;; Skip over a line join in (e.g.) Pike autodoc. + (goto-char (match-end 0)) + (setq safe-start nil) ; Never cache this; the doc style could be + ; changed at any time. (not (eobp))))) ;; We've searched over a piece of non-white syntactic ws. See if this @@ -2154,7 +2166,8 @@ comment at the start of cc-engine.el for more info." (let (;; `rung-pos' is set to a position as late as possible in the unmarked ;; part of the simple ws region. (rung-pos (point)) next-rung-pos last-put-in-sws-pos - rung-is-marked simple-ws-beg cmt-skip-pos) + rung-is-marked simple-ws-beg cmt-skip-pos + (doc-line-join-here (concat c-doc-line-join-re "\\="))) ;; Skip simple horizontal ws and do a quick check on the preceding ;; character to see if it's anything that can't end syntactic ws, so we can @@ -2164,12 +2177,17 @@ comment at the start of cc-engine.el for more info." (skip-chars-backward " \t\f") (when (and (not (bobp)) (save-excursion - (backward-char) - (or (looking-at c-syntactic-ws-end) - (and c-opt-cpp-prefix - (looking-at c-symbol-char-key) - (progn (c-beginning-of-current-token) - (looking-at c-noise-macro-name-re)))))) + (or (and + (memq (char-before) c-doc-line-join-end-ch) ; For speed. + (re-search-backward doc-line-join-here + (c-point 'bopl) t)) + (progn + (backward-char) + (or (looking-at c-syntactic-ws-end) + (and c-opt-cpp-prefix + (looking-at c-symbol-char-key) + (progn (c-beginning-of-current-token) + (looking-at c-noise-macro-name-re)))))))) ;; Try to find a rung position in the simple ws preceding point, so that ;; we can get a cache hit even if the last bit of the simple ws has ;; changed recently. @@ -2309,7 +2327,11 @@ comment at the start of cc-engine.el for more info." (looking-at c-noise-macro-name-re))))) ;; Skipped over a noise macro (goto-char next-rung-pos) - t))) + t) + + ((and + (memq (char-before) c-doc-line-join-end-ch) ; For speed. + (re-search-backward doc-line-join-here (c-point 'bopl) t))))) ;; We've searched over a piece of non-white syntactic ws. See if this ;; can be cached. @@ -5691,7 +5713,16 @@ comment at the start of cc-engine.el for more info." (when (< cfd-match-pos cfd-limit) ;; Skip forward past comments only so we don't skip macros. - (c-forward-comments) + (while + (progn + (c-forward-comments) + ;; The following is of use within a doc comment when a doc + ;; comment style has removed face properties from a construct, + ;; and is relying on `c-font-lock-declarations' to add them + ;; again. + (and (< (point) cfd-limit) + (looking-at c-doc-line-join-re) + (goto-char (match-end 0))))) ;; Set the position to continue at. We can avoid going over ;; the comments skipped above a second time, but it's possible ;; that the comment skipping has taken us past `cfd-prop-match' @@ -5950,7 +5981,7 @@ comment at the start of cc-engine.el for more info." (goto-char (or start-in-literal cfd-start-pos)) ;; The only syntactic ws in macros are comments. (c-backward-comments) - (backward-char) + (or (bobp) (backward-char)) (c-beginning-of-current-token)) (start-in-literal @@ -5975,7 +6006,8 @@ comment at the start of cc-engine.el for more info." (not (eq (c-get-char-property (point) 'c-type) 'c-decl-end)))))) - (when (= (point) start-in-literal) + (when (and (= (point) start-in-literal) + (not (looking-at c-doc-bright-comment-start-re))) ;; Didn't find any property inside the comment, so we can ;; skip it entirely. (This won't skip past a string, but ;; that'll be handled quickly by the next diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index e7a3748af4..5832f1f451 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2089,6 +2089,14 @@ higher." (c-lang-const c-complex-decl-matchers) (c-lang-const c-basic-matchers-after))) +(defun c-get-doc-comment-style () + ;; Get the symbol (or list of symbols) constituting the document style. + ;; Return nil if there is no such, otherwise something like `autodoc'. + (if (consp (car-safe c-doc-comment-style)) + (cdr-safe (or (assq c-buffer-is-cc-mode c-doc-comment-style) + (assq 'other c-doc-comment-style))) + c-doc-comment-style)) + (defun c-compose-keywords-list (base-list) ;; Incorporate the font lock keyword lists according to ;; `c-doc-comment-style' on the given keyword list and return it. @@ -2099,11 +2107,7 @@ higher." (unless (memq c-doc-face-name c-literal-faces) (setq c-literal-faces (cons c-doc-face-name c-literal-faces))) - (let* ((doc-keywords - (if (consp (car-safe c-doc-comment-style)) - (cdr-safe (or (assq c-buffer-is-cc-mode c-doc-comment-style) - (assq 'other c-doc-comment-style))) - c-doc-comment-style)) + (let* ((doc-keywords (c-get-doc-comment-style)) (list (nconc (c--mapcan (lambda (doc-style) (let ((sym (intern @@ -2552,15 +2556,88 @@ need for `pike-font-lock-extra-types'.") "Default expressions to highlight in Pike mode.") (defun pike-font-lock-keywords-2 () + (c-set-doc-comment-res) (c-compose-keywords-list pike-font-lock-keywords-2)) (defun pike-font-lock-keywords-3 () + (c-set-doc-comment-res) (c-compose-keywords-list pike-font-lock-keywords-3)) (defun pike-font-lock-keywords () + (c-set-doc-comment-res) (c-compose-keywords-list pike-font-lock-keywords)) ;;; Doc comments. +(defvar c-doc-line-join-re "a\\`") +;; Matches a join of two lines in a doc comment. +;; This should not be changed directly, but instead set by +;; `c-setup-doc-comment-style'. This variable is used in `c-find-decl-spots' +;; in (e.g.) autodoc style comments to bridge the gap between a "@\n" at an +;; EOL and the token following "//!" on the next line. + +(defvar c-doc-bright-comment-start-re "a\\`") +;; Matches the start of a "bright" comment, one whose contents may be +;; fontified by, e.g., `c-font-lock-declarations'. + +(defvar c-doc-line-join-end-ch nil) +;; A list of characters, each being a last character of a doc comment marker, +;; e.g. the ! from pike autodoc's "//!". + +(defmacro c-set-doc-comment-re-element (suffix) + ;; Set the variable `c-doc-line-join-re' to a buffer local value suitable + ;; for the current doc comment style, or kill the local value. + (let ((var (intern (concat "c-doc" suffix)))) + `(let* ((styles (c-get-doc-comment-style)) + elts) + (when (atom styles) + (setq styles (list styles))) + (setq elts + (mapcar (lambda (style) + (let ((sym + (intern-soft + (concat (symbol-name style) ,suffix)))) + (and sym + (boundp sym) + (symbol-value sym)))) + styles)) + (setq elts (delq nil elts)) + (setq elts (and elts + (concat "\\(" + (mapconcat #'identity elts "\\|") + "\\)"))) + (if elts + (set (make-local-variable ',var) elts) + (kill-local-variable ',var))))) + +(defmacro c-set-doc-comment-char-list (suffix) + ;; Set the variable 'c-doc-' to the list of *-, which must + ;; be characters, and * represents the doc comment style. + (let ((var (intern (concat "c-doc" suffix)))) + `(let* ((styles (c-get-doc-comment-style)) + elts) + (when (atom styles) + (setq styles (list styles))) + (setq elts + (mapcar (lambda (style) + (let ((sym + (intern-soft + (concat (symbol-name style) ,suffix)))) + (and sym + (boundp sym) + (symbol-value sym)))) + styles)) + (setq elts (delq nil elts)) + (if elts + (set (make-local-variable ',var) elts) + (kill-local-variable ',var))))) + +(defun c-set-doc-comment-res () + ;; Set the variables `c-doc-line-join-re' and + ;; `c-doc-bright-comment-start-re' from the current doc comment style(s). + (c-set-doc-comment-re-element "-line-join-re") + (c-set-doc-comment-re-element "-bright-comment-start-re") + (c-set-doc-comment-char-list "-line-join-end-ch")) + (defun c-font-lock-doc-comments (prefix limit keywords) ;; Fontify the comments between the point and LIMIT whose start ;; matches PREFIX with `c-doc-face-name'. Assumes comments have been @@ -2621,17 +2698,20 @@ need for `pike-font-lock-extra-types'.") (goto-char comment-beg) (while (and (progn (c-forward-single-comment) + (c-put-font-lock-face comment-beg (point) + c-doc-face-name) (skip-syntax-forward " ") + (setq comment-beg (point)) (< (point) limit)) (looking-at prefix)))) (goto-char comment-beg) - (c-forward-single-comment)) + (c-forward-single-comment) + (c-put-font-lock-face comment-beg (point) c-doc-face-name)) (if (> (point) limit) (goto-char limit)) (setq comment-beg nil) (let ((region-end (point)) (keylist keywords) keyword matcher highlights) - (c-put-font-lock-face region-beg region-end c-doc-face-name) (save-restriction ;; Narrow to the doc comment. Among other things, this ;; helps by making "^" match at the start of the comment. @@ -2838,6 +2918,13 @@ need for `pike-font-lock-extra-types'.") 0 'font-lock-warning-face prepend nil) )) +(defconst autodoc-line-join-re "@[\n\r][ \t]*/[/*]!") +;; Matches a line continuation in autodoc comment style. +(defconst autodoc-bright-comment-start-re "/[/*]!") +;; Matches an autodoc comment opener. +(defconst autodoc-line-join-end-ch ?!) +;; The final character of `autodoc-line-join-re'. + (defun autodoc-font-lock-keywords () ;; Note that we depend on that `c-current-comment-prefix' has got ;; its proper value here. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index fc4ba8f589..aea9c7f3ed 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1797,6 +1797,34 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (funcall fn beg end old-len)) c-before-font-lock-functions))))))) +(defun c-doc-fl-decl-start (pos) + ;; If the line containing POS is in a doc comment continued line (as defined + ;; by `c-doc-line-join-re'), return the position of the first line of the + ;; sequence. Otherwise, return nil. Point has no significance at entry to + ;; and exit from this function. + (goto-char pos) + (back-to-indentation) + (and (or (looking-at c-comment-start-regexp) + (memq (c-literal-type (c-literal-limits)) '(c c++))) + (progn + (end-of-line) + (let ((here (point))) + (while (re-search-backward c-doc-line-join-re (c-point 'bopl) t)) + (and (not (eq (point) here)) + (c-point 'bol)))))) + +(defun c-doc-fl-decl-end (pos) + ;; If the line containing POS is continued by a doc comment continuation + ;; marker (as defined by `c-doc-line-join-re), return the position of + ;; the BOL at the end of the sequence. Otherwise, return nil. Point has no + ;; significance at entry to and exit from this function. + (goto-char pos) + (back-to-indentation) + (let ((here (point))) + (while (re-search-forward c-doc-line-join-re (c-point 'eonl) t)) + (and (not (eq (point) here)) + (c-point 'bonl)))) + (defun c-fl-decl-start (pos) ;; If the beginning of the line containing POS is in the middle of a "local" ;; declaration, return the beginning of that declaration. Otherwise return @@ -1912,9 +1940,10 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; and OLD-LEN are not used. (if font-lock-mode (setq c-new-BEG - (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) + (or (c-fl-decl-start c-new-BEG) (c-doc-fl-decl-start c-new-BEG) + (c-point 'bol c-new-BEG)) c-new-END - (or (c-fl-decl-end c-new-END) + (or (c-fl-decl-end c-new-END) (c-doc-fl-decl-end c-new-END) (c-point 'bonl c-new-END))))) (defun c-context-expand-fl-region (beg end) @@ -1922,8 +1951,10 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is ;; in. NEW-END is beginning of the line after the one END is in. (c-save-buffer-state () - (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) - (or (c-fl-decl-end end) (c-point 'bonl (1- end)))))) + (cons (or (c-fl-decl-start beg) (c-doc-fl-decl-start beg) + (c-point 'bol beg)) + (or (c-fl-decl-end end) (c-doc-fl-decl-end end) + (c-point 'bonl (1- end)))))) (defun c-before-context-fl-expand-region (beg end) ;; Expand the region (BEG END) as specified by