commit 00119c6cb6b33161bc593947aa0991caf9d7ad65 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Thu Jun 11 22:49:02 2015 -0700 Port to Solaris 10 sparc + Sun C 5.13 * configure.ac (SETUP_SLAVE_PTY) [sol2* | unixware]: Adjust to process.c change. * src/process.c (create_process): Declare volatile variables at top level of this function, so that they're less likely to be reused later in the function in the code executed by the vforked child. Do not declare locals used only in the vforked child, as they might share memory with locals still live in the parent. Instead, use the same variables in the child as in the parent. This works around a subtle bug that causes a garbage collector crash when Emacs is built with Sun C 5.13 sparc on Solaris 10. diff --git a/configure.ac b/configure.ac index 070b061..b54bd34 100644 --- a/configure.ac +++ b/configure.ac @@ -4420,7 +4420,7 @@ case $opsys in AC_DEFINE(FIRST_PTY_LETTER, ['z']) AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");]) dnl Push various streams modules onto a PTY channel. Used in process.c. - AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (xforkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (xforkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.]) + AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (forkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (forkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (forkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.]) ;; esac diff --git a/src/process.c b/src/process.c index b4f979f..3132f19 100644 --- a/src/process.c +++ b/src/process.c @@ -1845,35 +1845,29 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #ifndef WINDOWSNT /* vfork, and prevent local vars from being clobbered by the vfork. */ - { - Lisp_Object volatile current_dir_volatile = current_dir; - Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name; - char **volatile new_argv_volatile = new_argv; - int volatile forkin_volatile = forkin; - int volatile forkout_volatile = forkout; - int volatile forkerr_volatile = forkerr; - struct Lisp_Process *p_volatile = p; - - pid = vfork (); - - current_dir = current_dir_volatile; - lisp_pty_name = lisp_pty_name_volatile; - new_argv = new_argv_volatile; - forkin = forkin_volatile; - forkout = forkout_volatile; - forkerr = forkerr_volatile; - p = p_volatile; - - pty_flag = p->pty_flag; - } + Lisp_Object volatile current_dir_volatile = current_dir; + Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name; + char **volatile new_argv_volatile = new_argv; + int volatile forkin_volatile = forkin; + int volatile forkout_volatile = forkout; + int volatile forkerr_volatile = forkerr; + struct Lisp_Process *p_volatile = p; + + pid = vfork (); + + current_dir = current_dir_volatile; + lisp_pty_name = lisp_pty_name_volatile; + new_argv = new_argv_volatile; + forkin = forkin_volatile; + forkout = forkout_volatile; + forkerr = forkerr_volatile; + p = p_volatile; + + pty_flag = p->pty_flag; if (pid == 0) #endif /* not WINDOWSNT */ { - int xforkin = forkin; - int xforkout = forkout; - int xforkerr = forkerr; - /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS /* First, disconnect its current controlling terminal. */ @@ -1881,30 +1875,30 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) process_set_signal to fail on SGI when using a pipe. */ setsid (); /* Make the pty's terminal the controlling terminal. */ - if (pty_flag && xforkin >= 0) + if (pty_flag && forkin >= 0) { #ifdef TIOCSCTTY /* We ignore the return value because faith@cs.unc.edu says that is necessary on Linux. */ - ioctl (xforkin, TIOCSCTTY, 0); + ioctl (forkin, TIOCSCTTY, 0); #endif } #if defined (LDISC1) - if (pty_flag && xforkin >= 0) + if (pty_flag && forkin >= 0) { struct termios t; - tcgetattr (xforkin, &t); + tcgetattr (forkin, &t); t.c_lflag = LDISC1; - if (tcsetattr (xforkin, TCSANOW, &t) < 0) + if (tcsetattr (forkin, TCSANOW, &t) < 0) emacs_perror ("create_process/tcsetattr LDISC1"); } #else #if defined (NTTYDISC) && defined (TIOCSETD) - if (pty_flag && xforkin >= 0) + if (pty_flag && forkin >= 0) { /* Use new line discipline. */ int ldisc = NTTYDISC; - ioctl (xforkin, TIOCSETD, &ldisc); + ioctl (forkin, TIOCSETD, &ldisc); } #endif #endif @@ -1937,11 +1931,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...)) would work? */ - if (xforkin >= 0) - emacs_close (xforkin); - xforkout = xforkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0); + if (forkin >= 0) + emacs_close (forkin); + forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0); - if (xforkin < 0) + if (forkin < 0) { emacs_perror (SSDATA (lisp_pty_name)); _exit (EXIT_CANCELED); @@ -1971,14 +1965,14 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) unblock_child_signal (&oldset); if (pty_flag) - child_setup_tty (xforkout); + child_setup_tty (forkout); - if (xforkerr < 0) - xforkerr = xforkout; + if (forkerr < 0) + forkerr = forkout; #ifdef WINDOWSNT - pid = child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); + pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); #else /* not WINDOWSNT */ - child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); + child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir); #endif /* not WINDOWSNT */ } commit f7a381382b2468b1616e0649263c0c0e4bcf0748 Author: Glenn Morris Date: Thu Jun 11 21:57:47 2015 -0700 * lisp/startup.el (normal-top-level): Don't let *Messages* get a nil default-directory. diff --git a/lisp/startup.el b/lisp/startup.el index e614466..ec222b3 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -581,7 +581,7 @@ It is the default value of the variable `top-level'." (set (make-local-variable 'window-point-insertion-type) t) ;; Give *Messages* the same default-directory as *scratch*, ;; just to keep things predictable. - (setq default-directory dir))) + (setq default-directory (or dir (expand-file-name "~/"))))) ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value (list (default-value 'user-full-name))) commit b7730b299b0d421ba9789d992f4c8a7df3fde208 Author: Glenn Morris Date: Thu Jun 11 21:12:29 2015 -0400 * lisp/startup.el (normal-top-level): Use delay-warning. (Bug#20792) diff --git a/lisp/startup.el b/lisp/startup.el index 370e7ae..e614466 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -612,11 +612,7 @@ It is the default value of the variable `top-level'." charset-map-path)))) (if default-directory (setq default-directory (abbreviate-file-name default-directory)) - ;; FIXME this does not get shown. - ;; If after (command-line), it is shown, but if command-line - ;; changed the buffer (eg found a file), it applies to that - ;; buffer, not *scratch*. - (display-warning 'initialization "Error setting default-directory")) + (delay-warning 'initialization "Error setting default-directory")) (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect (command-line) commit abeb7f3c5f5139c393057467cf85ffb8457aff30 Author: Glenn Morris Date: Thu Jun 11 20:47:45 2015 -0400 ; * lisp/startup.el (normal-top-level): Fix previous change. diff --git a/lisp/startup.el b/lisp/startup.el index b638ed5..370e7ae 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -590,12 +590,12 @@ It is the default value of the variable `top-level'." (and (stringp pwd) ;; Use FOO/., so that if FOO is a symlink, file-attributes ;; describes the directory linked to, not FOO itself. - (or (equal (file-attributes + (or (and default-directory + (equal (file-attributes (concat (file-name-as-directory pwd) ".")) - (if default-directory - (file-attributes - (concat (file-name-as-directory default-directory) - ".")))) + (file-attributes + (concat (file-name-as-directory default-directory) + ".")))) (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) commit ebbc6a4782c279527c52d6b1d8b379517aeec2d5 Author: Glenn Morris Date: Thu Jun 11 20:34:54 2015 -0400 Some progress towards starting with PWD deleted. (Bug#18851) * src/buffer.c (init_buffer): Handle get_current_dir_name failures. * lisp/startup.el (normal-top-level, command-line-1): * lisp/minibuffer.el (read-file-name-default): Handle default-directory being nil. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 60b89b6..bf18adf 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2572,7 +2572,7 @@ and `read-file-name-function'." (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) "Default method for reading file names. See `read-file-name' for the meaning of the arguments." - (unless dir (setq dir default-directory)) + (unless dir (setq dir (or default-directory "~/"))) (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir))) (unless default-filename (setq default-filename (if initial (expand-file-name initial dir) diff --git a/lisp/startup.el b/lisp/startup.el index 3c9ada6..b638ed5 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -592,9 +592,10 @@ It is the default value of the variable `top-level'." ;; describes the directory linked to, not FOO itself. (or (equal (file-attributes (concat (file-name-as-directory pwd) ".")) - (file-attributes - (concat (file-name-as-directory default-directory) - "."))) + (if default-directory + (file-attributes + (concat (file-name-as-directory default-directory) + ".")))) (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) @@ -609,12 +610,19 @@ It is the default value of the variable `top-level'." (mapcar (lambda (dir) (decode-coding-string dir coding t)) charset-map-path)))) - (setq default-directory (abbreviate-file-name default-directory)) + (if default-directory + (setq default-directory (abbreviate-file-name default-directory)) + ;; FIXME this does not get shown. + ;; If after (command-line), it is shown, but if command-line + ;; changed the buffer (eg found a file), it applies to that + ;; buffer, not *scratch*. + (display-warning 'initialization "Error setting default-directory")) (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect (command-line) ;; Do this again, in case .emacs defined more abbreviations. - (setq default-directory (abbreviate-file-name default-directory)) + (if default-directory + (setq default-directory (abbreviate-file-name default-directory))) ;; Specify the file for recording all the auto save files of this session. ;; This is used by recover-session. (or auto-save-list-file-name @@ -2193,19 +2201,26 @@ A fancy display is used on graphic displays, normal otherwise." ;; to zero when `process-file-arg' returns. (process-file-arg (lambda (name) - (let* ((file (expand-file-name + ;; If a relative filename was specified and + ;; command-line-default-directory is nil, + ;; silently drop that argument. + ;; This can only happen if PWD is deleted. + ;; The warning about setting default-directory will + ;; clue you in. + (when (and (or dir (file-name-absolute-p name)) + (let* ((file (expand-file-name (command-line-normalize-file-name name) dir)) - (buf (find-file-noselect file))) - (setq displayable-buffers (cons buf displayable-buffers)) - (with-current-buffer buf - (unless (zerop line) - (goto-char (point-min)) - (forward-line (1- line))) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)))))) + (buf (find-file-noselect file))) + (setq displayable-buffers (cons buf displayable-buffers)) + (with-current-buffer buf + (unless (zerop line) + (goto-char (point-min)) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))))) ;; Add the long X options to longopts. (dolist (tem command-line-x-option-alist) diff --git a/src/buffer.c b/src/buffer.c index 0b98431..75a00f0 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5285,41 +5285,46 @@ init_buffer (int initialized) pwd = get_current_dir_name (); if (!pwd) - fatal ("get_current_dir_name: %s\n", strerror (errno)); - - /* Maybe this should really use some standard subroutine - whose definition is filename syntax dependent. */ - len = strlen (pwd); - if (!(IS_DIRECTORY_SEP (pwd[len - 1]))) { - /* Grow buffer to add directory separator and '\0'. */ - pwd = realloc (pwd, len + 2); - if (!pwd) - fatal ("get_current_dir_name: %s\n", strerror (errno)); - pwd[len] = DIRECTORY_SEP; - pwd[len + 1] = '\0'; - len++; + fprintf (stderr, "Error getting directory: %s", emacs_strerror (errno)); + bset_directory (current_buffer, Qnil); } - - /* At this moment, we still don't know how to decode the directory - name. So, we keep the bytes in unibyte form so that file I/O - routines correctly get the original bytes. */ - bset_directory (current_buffer, make_unibyte_string (pwd, len)); - - /* Add /: to the front of the name - if it would otherwise be treated as magic. */ - temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt); - if (! NILP (temp) - /* If the default dir is just /, TEMP is non-nil - because of the ange-ftp completion handler. - However, it is not necessary to turn / into /:/. - So avoid doing that. */ - && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) + else { - AUTO_STRING (slash_colon, "/:"); - bset_directory (current_buffer, - concat2 (slash_colon, - BVAR (current_buffer, directory))); + /* Maybe this should really use some standard subroutine + whose definition is filename syntax dependent. */ + len = strlen (pwd); + if (!(IS_DIRECTORY_SEP (pwd[len - 1]))) + { + /* Grow buffer to add directory separator and '\0'. */ + pwd = realloc (pwd, len + 2); + if (!pwd) + fatal ("get_current_dir_name: %s\n", strerror (errno)); + pwd[len] = DIRECTORY_SEP; + pwd[len + 1] = '\0'; + len++; + } + + /* At this moment, we still don't know how to decode the directory + name. So, we keep the bytes in unibyte form so that file I/O + routines correctly get the original bytes. */ + bset_directory (current_buffer, make_unibyte_string (pwd, len)); + + /* Add /: to the front of the name + if it would otherwise be treated as magic. */ + temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt); + if (! NILP (temp) + /* If the default dir is just /, TEMP is non-nil + because of the ange-ftp completion handler. + However, it is not necessary to turn / into /:/. + So avoid doing that. */ + && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) + { + AUTO_STRING (slash_colon, "/:"); + bset_directory (current_buffer, + concat2 (slash_colon, + BVAR (current_buffer, directory))); + } } temp = get_minibuffer (0); commit 32e53667a91ed479743175d5698a89b163c8be94 Author: Paul Eggert Date: Thu Jun 11 16:41:36 2015 -0700 Fix "not a tty" bug on Solaris 10 * configure.ac (PTY_OPEN): Define to plain 'open' on SVR4-derived hosts, so that the O_CLOEXEC flag isn't set. * src/process.c (allocate_pty): Set the O_CLOEXEC flag after calling PTY_TTY_NAME_SPRINTF, for the benefit of SVR4-derived hosts that call grantpt which does its work via a setuid subcommand (Bug#19191, Bug#19927, Bug#20555, Bug#20686). Also, set O_CLOEXEC even if PTY_OPEN is not defined, since it seems relevant in that case too. diff --git a/configure.ac b/configure.ac index 9c6a74a..070b061 100644 --- a/configure.ac +++ b/configure.ac @@ -4397,14 +4397,17 @@ case $opsys in ;; sol2* ) - dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() + dnl On SysVr4, grantpt(3) forks a subprocess, so do not use + dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler dnl from intercepting that death. If any child but grantpt's should die dnl within, it should be caught after sigrelse(2). + AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)]) AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; unixware ) dnl Comments are as per sol2*. + AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)]) AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; esac diff --git a/src/process.c b/src/process.c index 17fe708..b4f979f 100644 --- a/src/process.c +++ b/src/process.c @@ -658,22 +658,24 @@ allocate_pty (char pty_name[PTY_NAME_SIZE]) if (fd >= 0) { -#ifdef PTY_OPEN +#ifdef PTY_TTY_NAME_SPRINTF + PTY_TTY_NAME_SPRINTF +#else + sprintf (pty_name, "/dev/tty%c%x", c, i); +#endif /* no PTY_TTY_NAME_SPRINTF */ + /* Set FD's close-on-exec flag. This is needed even if PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX doesn't require support for that combination. + Do this after PTY_TTY_NAME_SPRINTF, which on some platforms + doesn't work if the close-on-exec flag is set (Bug#20555). Multithreaded platforms where posix_openpt ignores O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt) have a race condition between the PTY_OPEN and here. */ fcntl (fd, F_SETFD, FD_CLOEXEC); -#endif - /* Check to make certain that both sides are available - this avoids a nasty yet stupid bug in rlogins. */ -#ifdef PTY_TTY_NAME_SPRINTF - PTY_TTY_NAME_SPRINTF -#else - sprintf (pty_name, "/dev/tty%c%x", c, i); -#endif /* no PTY_TTY_NAME_SPRINTF */ + + /* Check to make certain that both sides are available. + This avoids a nasty yet stupid bug in rlogins. */ if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0) { emacs_close (fd); commit 8d0efee90c0ad3b44c14b77403599cba1b168044 Author: Juri Linkov Date: Fri Jun 12 02:17:23 2015 +0300 * lisp/bindings.el (debug-ignored-errors): Add mark-inactive. * lisp/simple.el (kill-region): Replace 'error' with 'user-error'. (Bug#20785) diff --git a/lisp/bindings.el b/lisp/bindings.el index b658914..3672812 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -633,7 +633,7 @@ okay. See `mode-line-format'.") ;; file-supersession should all be user-errors! `(beginning-of-line beginning-of-buffer end-of-line end-of-buffer end-of-file buffer-read-only - file-supersession + file-supersession mark-inactive user-error ;; That's the main one! )) diff --git a/lisp/simple.el b/lisp/simple.el index 1eb0643..46023a5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4017,7 +4017,7 @@ some text between BEG and END, but we're killing the region." ;; calling `kill-append'. (interactive (list (mark) (point) 'region)) (unless (and beg end) - (error "The mark is not set now, so there is no region")) + (user-error "The mark is not set now, so there is no region")) (condition-case nil (let ((string (if region (funcall region-extract-function 'delete) commit f18cadab44fa5de0698cb8297b02ab5db131e5db Author: Glenn Morris Date: Thu Jun 11 18:23:08 2015 -0400 * lisp/international/characters.el (char-script-table): Fix typo. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index f70a328..dcf2d01 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1358,7 +1358,7 @@ Setup char-width-table appropriate for non-CJK language environment." (#x11AC0 #x11AFF pau-cin-hau) (#x12000 #x123FF cuneiform) (#x12400 #x1247F cuneiform-numbers-and-punctuation) - (#x12400 #x1254F cuneiform) ; Early Dynastic Cuneiform + (#x12480 #x1254F cuneiform) ; Early Dynastic Cuneiform (#x13000 #x1342F egyptian) (#x14400 #x1457F anatolian) (#x16800 #x16A3F bamum) commit b2205626370071bc85dc07b043c833bc50c0baec Author: Paul Eggert Date: Thu Jun 11 10:23:46 2015 -0700 Fix quoting of help for functions with odd names While investigating Bug#20759, I discovered other quoting problems: C-h f mishandled characters like backslash and quote in function names. This fix changes the behavior so that 'C-h f pcase RET' now generates "... (\` QPAT) ..." instead of "... (` QPAT) ...", because '(format "%S" '(` FOO))' returns "(\\` FOO)". A comment in src/lread.c's read1 function says that the backslash will be needed starting in Emacs 25, which implies that 'format' is correct and the old pcase documention was wrong to omit the backslash. * lisp/emacs-lisp/nadvice.el (advice--make-docstring): * lisp/help-fns.el (help-fns--signature): * lisp/help.el (help-add-fundoc-usage): * lisp/progmodes/elisp-mode.el (elisp-function-argstring): Use help--make-usage-docstring rather than formatting help-make-usage. * lisp/emacs-lisp/pcase.el (pcase--make-docstring): Return raw docstring. * lisp/help-fns.el (help-fns--signature): New arg RAW, to return raw docstring. Take more care to distinguish raw from cooked dstrings. (describe-function-1): Let help-fns--signature substitute command keys. * lisp/help.el (help--docstring-quote): New function. (help-split-fundoc): Use it, to quote funny characters more systematically. (help--make-usage): Rename from help-make-usage, since this should be private. Leave an obsolete alias for the old name. (help--make-usage-docstring): New function. * test/automated/help-fns.el (help-fns-test-funny-names): New test. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index faebe26..a6db5e9 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -114,7 +114,7 @@ Each element has the form (WHERE BYTECODE STACK) where: (usage (help-split-fundoc origdoc function))) (setq usage (if (null usage) (let ((arglist (help-function-arglist flist))) - (format "%S" (help-make-usage function arglist))) + (help--make-usage-docstring function arglist)) (setq origdoc (cdr usage)) (car usage))) (help-add-fundoc-usage (concat docstring origdoc) usage)))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index ab82b7e..0d3b21b 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -163,7 +163,7 @@ Currently, the following patterns are provided this way:" expansion)))) (declare-function help-fns--signature "help-fns" - (function doc real-def real-function)) + (function doc real-def real-function raw)) ;; FIXME: Obviously, this will collide with nadvice's use of ;; function-documentation if we happen to advise `pcase'. @@ -183,7 +183,7 @@ Currently, the following patterns are provided this way:" (insert "\n\n-- ") (let* ((doc (documentation me 'raw))) (setq doc (help-fns--signature symbol doc me - (indirect-function me))) + (indirect-function me) t)) (insert "\n" (or doc "Not documented."))))))) (let ((combined-doc (buffer-string))) (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) @@ -870,7 +870,7 @@ QPAT can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match its 0..(n-1)th elements, respectively. - ,PAT matches if the pattern PAT matches. + ,PAT matches if the pattern PAT matches. STRING matches if the object is `equal' to STRING. ATOM matches if the object is `eq' to ATOM." (declare (debug (pcase-QPAT))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d59eeab..931e8af 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -353,7 +353,7 @@ suitable file is found, return nil." (help-xref-button 1 'help-function-cmacro function lib))))) (insert ".\n")))) -(defun help-fns--signature (function doc real-def real-function) +(defun help-fns--signature (function doc real-def real-function raw) "Insert usage at point and return docstring. With highlighting." (if (keymapp function) doc ; If definition is a keymap, skip arglist note. @@ -365,7 +365,7 @@ suitable file is found, return nil." (let* ((use (cond ((and usage (not (listp advertised))) (car usage)) ((listp arglist) - (format "%S" (help-make-usage function arglist))) + (help--make-usage-docstring function arglist)) ((stringp arglist) arglist) ;; Maybe the arglist is in the docstring of a symbol ;; this one is aliased to. @@ -379,16 +379,20 @@ suitable file is found, return nil." (car usage)) ((or (stringp real-def) (vectorp real-def)) - (format "\nMacro: %s" (format-kbd-macro real-def))) + (format "\nMacro: %s" + (help--docstring-quote + (format-kbd-macro real-def)))) (t "[Missing arglist. Please make a bug report.]"))) - (high (help-highlight-arguments - ;; Quote any quotes in the function name (bug#20759). - (replace-regexp-in-string "\\(\\)[`']" "\\=" use t t 1) - doc))) - (let ((fill-begin (point))) - (insert (car high) "\n") - (fill-region fill-begin (point))) - (cdr high))))) + (high (if raw + (cons use doc) + (help-highlight-arguments (substitute-command-keys use) + (substitute-command-keys doc))))) + (let ((fill-begin (point)) + (high-usage (car high)) + (high-doc (cdr high))) + (insert high-usage "\n") + (fill-region fill-begin (point)) + high-doc))))) (defun help-fns--parent-mode (function) ;; If this is a derived mode, link to the parent. @@ -579,23 +583,22 @@ FILE is the file where FUNCTION was probably defined." (point))) (terpri)(terpri) - (let* ((doc-raw (documentation function t)) - ;; If the function is autoloaded, and its docstring has - ;; key substitution constructs, load the library. - (doc (progn - (and (autoloadp real-def) doc-raw - help-enable-auto-load - (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" - doc-raw) - (autoload-do-load real-def)) - (substitute-command-keys doc-raw)))) + (let ((doc-raw (documentation function t))) + + ;; If the function is autoloaded, and its docstring has + ;; key substitution constructs, load the library. + (and (autoloadp real-def) doc-raw + help-enable-auto-load + (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) + (autoload-do-load real-def)) (help-fns--key-bindings function) (with-current-buffer standard-output - (setq doc (help-fns--signature function doc sig-key real-function)) - (run-hook-with-args 'help-fns-describe-function-functions function) - (insert "\n" - (or doc "Not documented."))))))) + (let ((doc (help-fns--signature function doc-raw sig-key + real-function nil))) + (run-hook-with-args 'help-fns-describe-function-functions function) + (insert "\n" + (or doc "Not documented.")))))))) ;; Add defaults to `help-fns-describe-function-functions'. (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) diff --git a/lisp/help.el b/lisp/help.el index fd5cbc6..b766cd0 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1349,6 +1349,11 @@ the help window if the current value of the user option (princ msg))))) +(defun help--docstring-quote (string) + "Return a doc string that represents STRING. +The result, when formatted by ‘substitute-command-keys’, should equal STRING." + (replace-regexp-in-string "['\\`]" "\\\\=\\&" string)) + ;; The following functions used to be in help-fns.el, which is not preloaded. ;; But for various reasons, they are more widely needed, so they were ;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001 @@ -1364,12 +1369,17 @@ DEF is the function whose usage we're looking for in DOCSTRING." ;; function's name in the doc string so we use `fn' as the anonymous ;; function name instead. (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)) - (cons (format "(%s%s" - ;; Replace `fn' with the actual function name. - (if (symbolp def) def "anonymous") - (match-string 1 docstring)) - (unless (zerop (match-beginning 0)) - (substring docstring 0 (match-beginning 0)))))) + (let ((doc (unless (zerop (match-beginning 0)) + (substring docstring 0 (match-beginning 0)))) + (usage-tail (match-string 1 docstring))) + (cons (format "(%s%s" + ;; Replace `fn' with the actual function name. + (if (symbolp def) + (help--docstring-quote + (substring (format "%S" (list def)) 1 -1)) + 'anonymous) + usage-tail) + doc)))) (defun help-add-fundoc-usage (docstring arglist) "Add the usage info to DOCSTRING. @@ -1387,7 +1397,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (if (and (stringp arglist) (string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) (concat "(fn" (match-string 1 arglist) ")") - (format "%S" (help-make-usage 'fn arglist)))))) + (help--make-usage-docstring 'fn arglist))))) (defun help-function-arglist (def &optional preserve-names) "Return a formal argument list for the function DEF. @@ -1442,7 +1452,7 @@ the same names as used in the original source code, when possible." "[Arg list not available until function definition is loaded.]") (t t))) -(defun help-make-usage (function arglist) +(defun help--make-usage (function arglist) (cons (if (symbolp function) function 'anonymous) (mapcar (lambda (arg) (if (not (symbolp arg)) arg @@ -1454,6 +1464,11 @@ the same names as used in the original source code, when possible." (t (intern (upcase name))))))) arglist))) +(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1") + +(defun help--make-usage-docstring (fn arglist) + (help--docstring-quote (format "%S" (help--make-usage fn arglist)))) + (provide 'help) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 5d5f258..11c9b16 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1436,7 +1436,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ARGLIST is either a string, or a list of strings or symbols." (let ((str (cond ((stringp arglist) arglist) ((not (listp arglist)) nil) - (t (format "%S" (help-make-usage 'toto arglist)))))) + (t (help--make-usage-docstring 'toto arglist))))) (if (and str (string-match "\\`([^ )]+ ?" str)) (replace-match "(" t t str) str))) diff --git a/test/automated/help-fns.el b/test/automated/help-fns.el index ba87593..4815ac6 100644 --- a/test/automated/help-fns.el +++ b/test/automated/help-fns.el @@ -34,4 +34,27 @@ (goto-char (point-min)) (should (search-forward "autoloaded Lisp macro" (line-end-position))))) +(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) + "A function with a funny name. + +\(fn XYYZZY)" + x) + +(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x) + "Another function with a funny name." + x) + +(ert-deftest help-fns-test-funny-names () + "Test for help with functions with funny names." + (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward + "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYYZZY)"))) + (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward + "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) + ;;; help-fns.el ends here commit eda386fc71419a6ec33f2f5fe73d7cb7ce51c028 Author: Stefan Monnier Date: Thu Jun 11 13:20:41 2015 -0400 * lisp/thingatpt.el (in-string-p): Revert last change, since in-string-p is not used in thingatpt.el but only from outside. Also, use lexical binding. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index ac4a3d3..c26b9be 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -1,4 +1,4 @@ -;;; thingatpt.el --- get the `thing' at point +;;; thingatpt.el --- get the `thing' at point -*- lexical-binding:t -*- ;; Copyright (C) 1991-1998, 2000-2015 Free Software Foundation, Inc. @@ -177,7 +177,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." ;; Sexps -(defun thing-at-point--in-string-p () +(defun in-string-p () "Return non-nil if point is in a string." (declare (obsolete "use (nth 3 (syntax-ppss)) instead." "25.1")) (let ((orig (point))) @@ -185,10 +185,6 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." (beginning-of-defun) (nth 3 (parse-partial-sexp (point) orig))))) -(define-obsolete-function-alias 'in-string-p - 'thing-at-point--in-string-p "25.1" - "This is an internal thingatpt function and should not be used.") - (defun thing-at-point--end-of-sexp () "Move point to the end of the current sexp." (let ((char-syntax (syntax-after (point)))) commit 35d19cc2a110b57d2aef8bf0e9ae1bf4a80d1cdb Author: Eli Zaretskii Date: Thu Jun 11 19:10:42 2015 +0300 ; * ChangeLog.2: Remove entries from a merged feature branch. diff --git a/ChangeLog.2 b/ChangeLog.2 index b3a5a85..ef261f1 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -489,22 +489,6 @@ * src/w32fns.c (syms_of_w32fns): ... to here, as these are used only on MS-Windows. -2015-05-31 Eli Zaretskii - - Attempt to fix crashes due to accesses beyond glyph matrix end - * src/xdisp.c (x_produce_glyphs): When it->ascent and it->descent - are determined from per-character metrics, don't let the - max_ascent and max_descent become smaller than values returned by - normal_char_ascent_descent, to avoid unpleasant dynamic resizing - of screen line heights when text changes. - * src/xterm.c (x_new_font) - * src/w32term.c (x_new_font): Call get_font_ascent_descent to - obtain a reasonable value for FRAME_LINE_HEIGHT, even when a font - claims very large value for its height. - * src/font.c (font_open_entity): Call get_font_ascent_descent to - obtain a reasonable value for FRAME_SMALLEST_FONT_HEIGHT, even - when a font claims very large value for its height. - 2015-05-31 Michael Albinus Use another default value for tramp-histfile-override @@ -512,97 +496,10 @@ Use ".tramp_history" as default. Fixes: debbugs:#20446 -2015-05-30 Eli Zaretskii - - Fix display of composite characters with large fonts - * src/xdisp.c (x_produce_glyphs): Call normal_char_ascent_descent - for reasonable values of font ascent and descent. - (get_font_ascent_descent): New function. - * src/composite.c (composition_gstring_width): Call - get_font_ascent_descent for reasonable values of font ascent and - descent. - * dispextern.h: Add prototype for get_font_ascent_descent. - - Fix display of cursor at end of empty lines - * src/xdisp.c (normal_char_ascent_descent): Accept additional - argument: the character to use for metrics in case the font - declares too large ascent and descent values. Add 1 pixel to - ascent and descent values. - (normal_char_height): Accept additional argument: the character to - use for metrics in case the font declares too large height value. - Call normal_char_ascent_descent instead of doing calculations for - a different default character. - (estimate_mode_line_height, handle_single_display_spec) - (calc_pixel_width_or_height, produce_stretch_glyph) - (calc_line_height_property, produce_glyphless_glyph): All callers - changed. - (append_space_for_newline): Make sure the space glyph produced at - end of line has correct ascent and descent values, and the glyph - row has correct height, even when it's empty. - -2015-05-29 Eli Zaretskii - - Fix 2 more calculations of line height - * src/xdisp.c (estimate_mode_line_height, handle_single_display_spec): - Use normal_char_height. - - Fix line dimensions from line-height property - * src/xdisp.c (normal_char_ascent_descent): New function, - extracted from produce_glyphless_glyph. - (calc_line_height_property, produce_glyphless_glyph): Use it to - compute reasonable estimates of ascent and descent for large - fonts. - - Fix display of stretch glyphs with large fonts - * src/xdisp.c (normal_char_height): New function. - (calc_pixel_width_or_height, produce_stretch_glyph): Use it to - compute more reasonable estimation of a "normal character height" - when the font claims preposterously large height values. - 2015-05-29 Nicolas Petton * doc/emacs/emacs.texi: Update the ISBN of the Emacs manual. -2015-05-28 Eli Zaretskii - - Fix display of glyphless characters with problematic fonts - * src/w32term.c (x_draw_glyph_string_background): Force redraw of - glyph string background also when the font in use claims - preposterously large global height value. Helps to remove - artifacts left from previous displays when glyphless characters - are displayed as hex code in a box. - * src/xterm.c (x_draw_glyph_string_background): Force redraw of - glyph string background also when the font in use claims - preposterously large global height value. Helps to remove - artifacts left from previous displays when glyphless characters - are displayed as hex code in a box. - * src/w32font.c (w32font_draw): Fix background drawing for - glyphless characters that display as acronyms or hex codes in a - box. - * src/xftfont.c (xftfont_draw): Fix background drawing for - glyphless characters that display as acronyms or hex codes in a - box. - * src/xdisp.c (produce_glyphless_glyph): Compute reasonable values - for it->ascent and it->descent when the font claims preposterously - large global values. - (FONT_TOO_HIGH): Move from here... - * src/dispextern.h (FONT_TOO_HIGH): ...to here. - -2015-05-27 Eli Zaretskii - - Avoid very high screen lines with some fonts - * src/xdisp.c (get_phys_cursor_geometry): Adjust the height of the - cursor to avoid weird-looking hollow cursor with fonts that have - large ascent values for some glyphs. This avoids having the - hollow cursor start too low. - (append_space_for_newline): Adjust the ascent value of the newline - glyph, so that the hollow cursor at end of line displays - correctly. - (FONT_TOO_HIGH): New macro. - (x_produce_glyphs): Use it to detect fonts that claim a - preposterously large height, in which case we use per-glyph ascent - and descent values. (Bug#20628) - 2015-05-16 Nicolas Petton * etc/NEWS: Add an entry about map.el commit fe5ba924027b46462a7f528b10dfa9890093d477 Author: Artur Malabarba Date: Thu Jun 11 15:08:32 2015 +0100 * lisp/let-alist.el (let-alist--deep-dot-search): Fix cons * test/automated/let-alist.el (let-alist-cons): Test it. diff --git a/lisp/let-alist.el b/lisp/let-alist.el index 80b72d3..ca7a904 100644 --- a/lisp/let-alist.el +++ b/lisp/let-alist.el @@ -4,7 +4,7 @@ ;; Author: Artur Malabarba ;; Maintainer: Artur Malabarba -;; Version: 1.0.3 +;; Version: 1.0.4 ;; Keywords: extensions lisp ;; Prefix: let-alist ;; Separator: - @@ -72,9 +72,9 @@ symbol, and each cdr is the same symbol without the `.'." ;; Return the cons cell inside a list, so it can be appended ;; with other results in the clause below. (list (cons data (intern (replace-match "" nil nil name))))))) - ((not (listp data)) nil) - (t (apply #'append - (mapcar #'let-alist--deep-dot-search data))))) + ((not (consp data)) nil) + (t (append (let-alist--deep-dot-search (car data)) + (let-alist--deep-dot-search (cdr data)))))) (defun let-alist--access-sexp (symbol variable) "Return a sexp used to access SYMBOL inside VARIABLE." diff --git a/test/automated/let-alist.el b/test/automated/let-alist.el index c436d89..65727dc 100644 --- a/test/automated/let-alist.el +++ b/test/automated/let-alist.el @@ -48,6 +48,19 @@ ..external ..external.too))) (list nil 0 1 2 3 "ext" "et")))) +(ert-deftest let-alist-cons () + (should + (equal + (let ((.external "ext") + (.external.too "et")) + (let-alist '((test-two . 0) + (test-three . 1) + (sublist . ((foo . 2) + (bar . 3)))) + (list `(, .test-one . , .test-two) + .sublist.bar ..external))) + (list '(nil . 0) 3 "ext")))) + (defvar let-alist--test-counter 0 "Used to count number of times a function is called.") commit ece5691fe63e2c522ba4e956c5908ac65ea27abe Author: Nicolas Richard Date: Thu Jun 11 11:46:14 2015 +0200 * src/syntax.c (Fbackward_prefix_chars): Reword docstring diff --git a/src/syntax.c b/src/syntax.c index 1695815..0d8b08c 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3013,7 +3013,8 @@ but before count is used up, nil is returned. */) DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars, 0, 0, 0, doc: /* Move point backward over any number of chars with prefix syntax. -This includes chars with "quote" or "prefix" syntax (' or p). */) +This includes chars with expression prefix syntax class (') and those with +the prefix syntax flag (p). */) (void) { ptrdiff_t beg = BEGV;