commit 03f32876210f3dd68c71baa210e523c3b7581758 (HEAD, refs/remotes/origin/master) Author: Kaushal Modi Date: Fri Jul 22 14:48:12 2016 -0400 Avoid repeated warnings while restoring desktop * lisp/desktop.el (desktop-restore-file-buffer): Do not print warnings when files are being opened during desktop restore. diff --git a/lisp/desktop.el b/lisp/desktop.el index 1f460b7..df4ff55 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1402,7 +1402,7 @@ after that many seconds of idle time." (or coding-system-for-read (cdr (assq 'buffer-file-coding-system desktop-buffer-locals)))) - (buf (find-file-noselect buffer-filename))) + (buf (find-file-noselect buffer-filename :nowarn))) (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf))) commit d0e1774a5850b924915bde5abefe791ce18d84a2 Author: Eli Zaretskii Date: Fri Jul 22 20:38:22 2016 +0300 Fix compilation warning in the MinGW build * nt/inc/ms-w32.h: Include stdint.h. (_execvp, execve): Provide prototypes. * lib-src/emacsclient.c [WINDOWSNT]: Remove prototype for execvp, it is now in nt/inc/ms-w32.h. * lib-src/ntlib.c (getppid): Avoid compiler warnings due to format mismatch. (sys_ctime): Remove, not used. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 7792d0a..1991aaa 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -388,7 +388,6 @@ w32_window_app (void) directly into the argv array of the child process. */ int w32_execvp (const char *, char **); -extern int execvp (const char*, char **); int w32_execvp (const char *path, char **argv) diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index 2ace218..2ac0219 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -98,7 +98,7 @@ getppid (void) getppid_parent = OpenProcess (SYNCHRONIZE, FALSE, atoi (ppid)); if (!getppid_parent) { - printf ("Failed to open handle to parent process: %d\n", + printf ("Failed to open handle to parent process: %lu\n", GetLastError ()); exit (1); } @@ -115,7 +115,7 @@ getppid (void) return 1; case WAIT_FAILED: default: - printf ("Checking parent status failed: %d\n", GetLastError ()); + printf ("Checking parent status failed: %lu\n", GetLastError ()); exit (1); } } @@ -258,16 +258,6 @@ fchown (int fd, unsigned uid, unsigned gid) return 0; } -/* Place a wrapper around the MSVC version of ctime. It returns NULL - on network directories, so we handle that case here. - (Ulrich Leodolter, 1/11/95). */ -char * -sys_ctime (const time_t *t) -{ - char *str = (char *) ctime (t); - return (str ? str : "Sun Jan 01 00:00:00 1970"); -} - FILE * sys_fopen (const char * path, const char * mode) { diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 5fd54e2..bb8ae6a 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -291,6 +291,9 @@ extern int sys_umask (int); /* Map to MSVC names. */ #define execlp _execlp #define execvp _execvp +#include /* for intptr_t */ +extern intptr_t _execvp (const char *, char **); +extern intptr_t execve (const char *, char * const *, char * const *); #define fdatasync _commit #define fdopen _fdopen #define fsync _commit commit ad90397c599034a5f2a977baf9d04802f986eee2 Author: Lars Ingebrigtsen Date: Fri Jul 22 11:08:13 2016 +0200 Move read-multiple-choice to subr-x.el * lisp/faces.el (read-multiple-choice-face): Fix doc string. * lisp/emacs-lisp/subr-x.el (read-multiple-choice): Move here from subr.el. * lisp/gnus/message.el (subr-x): Ditto. * lisp/net/nsm.el: Require subr-x for read-multiple-choice. read-multiple-choice doesn't need to be in the dumped Emacs, so move it to a less central file. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index e8d1939..173cd11 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -198,6 +198,171 @@ to bind a single value, BINDINGS can just be a plain tuple." (substring string 0 (- (length string) (length suffix))) string)) +(defun read-multiple-choice (prompt choices) + "Ask user a multiple choice question. +PROMPT should be a string that will be displayed as the prompt. + +CHOICES is an alist where the first element in each entry is a +character to be entered, the second element is a short name for +the entry to be displayed while prompting (if there's room, it +might be shortened), and the third, optional entry is a longer +explanation that will be displayed in a help buffer if the user +requests more help. + +This function translates user input into responses by consulting +the bindings in `query-replace-map'; see the documentation of +that variable for more information. In this case, the useful +bindings are `recenter', `scroll-up', and `scroll-down'. If the +user enters `recenter', `scroll-up', or `scroll-down' responses, +perform the requested window recentering or scrolling and ask +again. + +The return value is the matching entry from the CHOICES list. + +Usage example: + +\(read-multiple-choice \"Continue connecting?\" + '((?a \"always\") + (?s \"session only\") + (?n \"no\")))" + (let* ((altered-names nil) + (full-prompt + (format + "%s (%s): " + prompt + (mapconcat + (lambda (elem) + (let* ((name (cadr elem)) + (pos (seq-position name (car elem))) + (altered-name + (cond + ;; Not in the name string. + ((not pos) + (format "[%c] %s" (car elem) name)) + ;; The prompt character is in the name, so highlight + ;; it on graphical terminals... + ((display-supports-face-attributes-p + '(:underline t) (window-frame)) + (setq name (copy-sequence name)) + (put-text-property pos (1+ pos) + 'face 'read-multiple-choice-face + name) + name) + ;; And put it in [bracket] on non-graphical terminals. + (t + (concat + (substring name 0 pos) + "[" + (upcase (substring name pos (1+ pos))) + "]" + (substring name (1+ pos))))))) + (push (cons (car elem) altered-name) + altered-names) + altered-name)) + (append choices '((?? "?"))) + ", "))) + tchar buf wrong-char answer) + (save-window-excursion + (save-excursion + (while (not tchar) + (message "%s%s" + (if wrong-char + "Invalid choice. " + "") + full-prompt) + (setq tchar + (if (and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (x-popup-dialog + t + (cons prompt + (mapcar + (lambda (elem) + (cons (capitalize (cadr elem)) + (car elem))) + choices))) + (condition-case nil + (let ((cursor-in-echo-area t)) + (read-char)) + (error nil)))) + (setq answer (lookup-key query-replace-map (vector tchar) t)) + (setq tchar + (cond + ((eq answer 'recenter) + (recenter) t) + ((eq answer 'scroll-up) + (ignore-errors (scroll-up-command)) t) + ((eq answer 'scroll-down) + (ignore-errors (scroll-down-command)) t) + ((eq answer 'scroll-other-window) + (ignore-errors (scroll-other-window)) t) + ((eq answer 'scroll-other-window-down) + (ignore-errors (scroll-other-window-down)) t) + (t tchar))) + (when (eq tchar t) + (setq wrong-char nil + tchar nil)) + ;; The user has entered an invalid choice, so display the + ;; help messages. + (when (and (not (eq tchar nil)) + (not (assq tchar choices))) + (setq wrong-char (not (memq tchar '(?? ?\C-h))) + tchar nil) + (when wrong-char + (ding)) + (with-help-window (setq buf (get-buffer-create + "*Multiple Choice Help*")) + (with-current-buffer buf + (erase-buffer) + (pop-to-buffer buf) + (insert prompt "\n\n") + (let* ((columns (/ (window-width) 25)) + (fill-column 21) + (times 0) + (start (point))) + (dolist (elem choices) + (goto-char start) + (unless (zerop times) + (if (zerop (mod times columns)) + ;; Go to the next "line". + (goto-char (setq start (point-max))) + ;; Add padding. + (while (not (eobp)) + (end-of-line) + (insert (make-string (max (- (* (mod times columns) + (+ fill-column 4)) + (current-column)) + 0) + ?\s)) + (forward-line 1)))) + (setq times (1+ times)) + (let ((text + (with-temp-buffer + (insert (format + "%c: %s\n" + (car elem) + (cdr (assq (car elem) altered-names)))) + (fill-region (point-min) (point-max)) + (when (nth 2 elem) + (let ((start (point))) + (insert (nth 2 elem)) + (unless (bolp) + (insert "\n")) + (fill-region start (point-max)))) + (buffer-string)))) + (goto-char start) + (dolist (line (split-string text "\n")) + (end-of-line) + (if (bolp) + (insert line "\n") + (insert line)) + (forward-line 1))))))))))) + (when (buffer-live-p buf) + (kill-buffer buf)) + (assq tchar choices))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/faces.el b/lisp/faces.el index 426de3b..a7c4cce 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2749,7 +2749,7 @@ It is used for characters of no fonts too." (defface read-multiple-choice-face '((t (:inherit underline :weight bold))) - "Face for the symbol name in Apropos output." + "Face for the symbol name in `read-multiple-choice' output." :group 'basic-faces :version "25.2") diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index c052cdf..85968c8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -49,6 +49,7 @@ (require 'mm-util) (require 'rfc2047) (require 'puny) +(require 'subr-x) (autoload 'mailclient-send-it "mailclient") diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 72bff66..5928ab3 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -25,6 +25,7 @@ ;;; Code: (require 'cl-lib) +(require 'subr-x) (defvar nsm-permanent-host-settings nil) (defvar nsm-temporary-host-settings nil) diff --git a/lisp/subr.el b/lisp/subr.el index cf84d8b..937a050 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2286,171 +2286,6 @@ keyboard-quit events while waiting for a valid input." (message "%s%s" prompt (char-to-string char)) char)) -(defun read-multiple-choice (prompt choices) - "Ask user a multiple choice question. -PROMPT should be a string that will be displayed as the prompt. - -CHOICES is an alist where the first element in each entry is a -character to be entered, the second element is a short name for -the entry to be displayed while prompting (if there's room, it -might be shortened), and the third, optional entry is a longer -explanation that will be displayed in a help buffer if the user -requests more help. - -This function translates user input into responses by consulting -the bindings in `query-replace-map'; see the documentation of -that variable for more information. In this case, the useful -bindings are `recenter', `scroll-up', and `scroll-down'. If the -user enters `recenter', `scroll-up', or `scroll-down' responses, -perform the requested window recentering or scrolling and ask -again. - -The return value is the matching entry from the CHOICES list. - -Usage example: - -\(read-multiple-choice \"Continue connecting?\" - '((?a \"always\") - (?s \"session only\") - (?n \"no\")))" - (let* ((altered-names nil) - (full-prompt - (format - "%s (%s): " - prompt - (mapconcat - (lambda (elem) - (let* ((name (cadr elem)) - (pos (seq-position name (car elem))) - (altered-name - (cond - ;; Not in the name string. - ((not pos) - (format "[%c] %s" (car elem) name)) - ;; The prompt character is in the name, so highlight - ;; it on graphical terminals... - ((display-supports-face-attributes-p - '(:underline t) (window-frame)) - (setq name (copy-sequence name)) - (put-text-property pos (1+ pos) - 'face 'read-multiple-choice-face - name) - name) - ;; And put it in [bracket] on non-graphical terminals. - (t - (concat - (substring name 0 pos) - "[" - (upcase (substring name pos (1+ pos))) - "]" - (substring name (1+ pos))))))) - (push (cons (car elem) altered-name) - altered-names) - altered-name)) - (append choices '((?? "?"))) - ", "))) - tchar buf wrong-char answer) - (save-window-excursion - (save-excursion - (while (not tchar) - (message "%s%s" - (if wrong-char - "Invalid choice. " - "") - full-prompt) - (setq tchar - (if (and (display-popup-menus-p) - last-input-event ; not during startup - (listp last-nonmenu-event) - use-dialog-box) - (x-popup-dialog - t - (cons prompt - (mapcar - (lambda (elem) - (cons (capitalize (cadr elem)) - (car elem))) - choices))) - (condition-case nil - (let ((cursor-in-echo-area t)) - (read-char)) - (error nil)))) - (setq answer (lookup-key query-replace-map (vector tchar) t)) - (setq tchar - (cond - ((eq answer 'recenter) - (recenter) t) - ((eq answer 'scroll-up) - (ignore-errors (scroll-up-command)) t) - ((eq answer 'scroll-down) - (ignore-errors (scroll-down-command)) t) - ((eq answer 'scroll-other-window) - (ignore-errors (scroll-other-window)) t) - ((eq answer 'scroll-other-window-down) - (ignore-errors (scroll-other-window-down)) t) - (t tchar))) - (when (eq tchar t) - (setq wrong-char nil - tchar nil)) - ;; The user has entered an invalid choice, so display the - ;; help messages. - (when (and (not (eq tchar nil)) - (not (assq tchar choices))) - (setq wrong-char (not (memq tchar '(?? ?\C-h))) - tchar nil) - (when wrong-char - (ding)) - (with-help-window (setq buf (get-buffer-create - "*Multiple Choice Help*")) - (with-current-buffer buf - (erase-buffer) - (pop-to-buffer buf) - (insert prompt "\n\n") - (let* ((columns (/ (window-width) 25)) - (fill-column 21) - (times 0) - (start (point))) - (dolist (elem choices) - (goto-char start) - (unless (zerop times) - (if (zerop (mod times columns)) - ;; Go to the next "line". - (goto-char (setq start (point-max))) - ;; Add padding. - (while (not (eobp)) - (end-of-line) - (insert (make-string (max (- (* (mod times columns) - (+ fill-column 4)) - (current-column)) - 0) - ?\s)) - (forward-line 1)))) - (setq times (1+ times)) - (let ((text - (with-temp-buffer - (insert (format - "%c: %s\n" - (car elem) - (cdr (assq (car elem) altered-names)))) - (fill-region (point-min) (point-max)) - (when (nth 2 elem) - (let ((start (point))) - (insert (nth 2 elem)) - (unless (bolp) - (insert "\n")) - (fill-region start (point-max)))) - (buffer-string)))) - (goto-char start) - (dolist (line (split-string text "\n")) - (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) - (forward-line 1))))))))))) - (when (buffer-live-p buf) - (kill-buffer buf)) - (assq tchar choices))) - (defun sit-for (seconds &optional nodisp obsolete) "Redisplay, then wait for SECONDS seconds. Stop when input is available. SECONDS may be a floating-point value. commit 431641a2ecbd787a692957bcc5e59b600f63e832 Author: Tino Calancha Date: Fri Jul 22 18:01:43 2016 +0900 Update define-ibuffer-op doc string * lisp/ibuf-macs.el (define-ibuffer-op): Mention that BODY is evaluated with 'buf' bound to the actual marked buffer being processed. diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 2411f05..27e7af9 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -203,7 +203,8 @@ evaluates once for each marked buffer, MBUF, with MBUF current and saving the point. If COMPLEX is non-nil, BODY evaluates without requiring MBUF current. BODY define the operation; they are forms to evaluate per each -marked buffer. +marked buffer. BODY is evaluated with `buf' bound to the +buffer object. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" (declare (indent 2) (doc-string 3))