procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from origin/emacs-26

Browse source 
9226cf3254 Fix bug in recent styled_format change
fa92f0c447 Cleanup emacs-lisp-mode's use of Flymake
0d0265bf50 Fix @include directive in Flymake doc
295457ae52 Move read-multiple-choice to its own library
560dd9b573 * src/process.c (syms_of_process): Remove duplicated call ...
This commit is contained in:
Paul Eggert 2017-10-06 10:35:07 -07:00
commit 53da55b8cc
8 changed files with 267 additions and 243 deletions
Download patch file Download diff file Expand all files Collapse all files

2
doc/misc/flymake.texi
View file

@ -4,7 +4,7 @@
@set VERSION 0.3
@set UPDATED April 2004
@settitle GNU Flymake @value{VERSION}
@include ../emacs/docstyle.texi
@include docstyle.texi
@syncodeindex pg cp
@comment %**end of header

199
lisp/emacs-lisp/rmc.el Normal file
View file

@ -0,0 +1,199 @@
;;; rmc.el --- read from a multiple choice question -*- lexical-binding: t -*-
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
;;;###autoload
(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.
When `use-dialog-box' is t (the default), this function can pop
up a dialog window to collect the user input. That functionality
requires `display-popup-menus-p' to return t. Otherwise, a text
dialog will be used.
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 'rmc)
;;; rmc.el ends here

170
lisp/emacs-lisp/subr-x.el
View file

@ -245,176 +245,6 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(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.
When `use-dialog-box' is t (the default), this function can pop
up a dialog window to collect the user input. That functionality
requires `display-popup-menus-p' to return t. Otherwise, a text
dialog will be used.
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

2
lisp/gnus/message.el
View file

@ -49,7 +49,7 @@
(require 'mm-util)
(require 'rfc2047)
(require 'puny)
(require 'subr-x) ; read-multiple-choice
(require 'rmc) ; read-multiple-choice
(autoload 'mailclient-send-it "mailclient")

2
lisp/net/nsm.el
View file

@ -25,7 +25,7 @@
;;; Code:
(require 'cl-lib)
(require 'subr-x) ; read-multiple-choice
(require 'rmc) ; read-multiple-choice
(defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil)

60
lisp/progmodes/elisp-mode.el
View file

@ -1599,8 +1599,11 @@ ARGLIST is either a string, or a list of strings or symbols."
(defvar checkdoc-autofix-flag)
(defvar checkdoc-generate-compile-warnings-flag)
(defvar checkdoc-diagnostic-buffer)
(defun elisp-flymake--checkdoc-1 ()
"Do actual work for `elisp-flymake-checkdoc'."
;;;###autoload
(defun elisp-flymake-checkdoc (report-fn &rest _args)
"A Flymake backend for `checkdoc'.
Calls REPORT-FN directly."
(let (collected)
(let* ((checkdoc-create-error-function
(lambda (text start end &optional unfixable)
@ -1608,35 +1611,26 @@ ARGLIST is either a string, or a list of strings or symbols."
nil))
(checkdoc-autofix-flag nil)
(checkdoc-generate-compile-warnings-flag nil)
(buf (generate-new-buffer " *checkdoc-temp*"))
(checkdoc-diagnostic-buffer buf))
(checkdoc-diagnostic-buffer
(generate-new-buffer " *checkdoc-temp*")))
(unwind-protect
(save-excursion
(checkdoc-current-buffer t))
(kill-buffer buf)))
collected))
;;;###autoload
(defun elisp-flymake-checkdoc (report-fn &rest _args)
"A Flymake backend for `checkdoc'.
Calls REPORT-FN directly."
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(kill-buffer checkdoc-diagnostic-buffer)))
(funcall report-fn
(cl-loop for (text start end _unfixable) in
(elisp-flymake--checkdoc-1)
collected
collect
(flymake-make-diagnostic
(current-buffer)
start end :note text))))
start end :note text)))
collected))
(defun elisp-flymake--byte-compile-done (report-fn
origin-buffer
output-buffer
temp-file)
(unwind-protect
source-buffer
output-buffer)
(with-current-buffer
origin-buffer
source-buffer
(save-excursion
(save-restriction
(widen)
@ -1662,9 +1656,7 @@ Calls REPORT-FN directly."
(if (= beg end) (1- beg) beg)
end
level
string))))))
(kill-buffer output-buffer)
(ignore-errors (delete-file temp-file))))
string)))))))
(defvar-local elisp-flymake--byte-compile-process nil
"Buffer-local process started for byte-compiling the buffer.")
@ -1674,16 +1666,11 @@ Calls REPORT-FN directly."
"A Flymake backend for elisp byte compilation.
Spawn an Emacs process that byte-compiles a file representing the
current buffer state and calls REPORT-FN when done."
(interactive (list (lambda (stuff)
(message "aha %s" stuff))))
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(when elisp-flymake--byte-compile-process
(process-put elisp-flymake--byte-compile-process 'elisp-flymake--obsolete t)
(when (process-live-p elisp-flymake--byte-compile-process)
(kill-process elisp-flymake--byte-compile-process)))
(let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
(origin-buffer (current-buffer)))
(source-buffer (current-buffer)))
(save-restriction
(widen)
(write-region (point-min) (point-max) temp-file nil 'nomessage))
@ -1703,21 +1690,22 @@ current buffer state and calls REPORT-FN when done."
:connection-type 'pipe
:sentinel
(lambda (proc _event)
(unless (process-live-p proc)
(when (eq (process-status proc) 'exit)
(unwind-protect
(cond
((not (eq proc elisp-flymake--byte-compile-process))
(flymake-log :warning "byte-compile process %s obsolete" proc))
((zerop (process-exit-status proc))
(elisp-flymake--byte-compile-done report-fn
origin-buffer
output-buffer
temp-file))
((process-get proc 'elisp-flymake--obsolete)
(flymake-log :warning "byte-compile process %s obsolete" proc))
source-buffer
output-buffer))
(t
(funcall report-fn
:panic
:explanation
(format "byte-compile process %s died" proc)))))))))
(format "byte-compile process %s died" proc))))
(ignore-errors (delete-file temp-file))
(kill-buffer output-buffer))))))
:stderr null-device
:noquery t)))

14
src/editfns.c
View file

@ -4179,6 +4179,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
bool maybe_combine_byte;
Lisp_Object val;
bool arg_intervals = false;
USE_SAFE_ALLOCA;
sa_avail -= sizeof initial_buffer;
@ -4417,7 +4418,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
{
if (format == end && format - format_start == 2
&& ! string_intervals (args[0]))
return arg;
{
val = arg;
goto return_val;
}
/* handle case (precision[n] >= 0) */
@ -4862,11 +4866,14 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
emacs_abort ();
if (! new_result)
return args[0];
{
val = args[0];
goto return_val;
}
if (maybe_combine_byte)
nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte);
val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If the format string has text properties, or any of the string
arguments has text properties, set up text properties of the
@ -4964,6 +4971,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
}
return_val:
/* If we allocated BUF or INFO with malloc, free it too. */
SAFE_FREE ();

1
src/process.c
View file

@ -8097,7 +8097,6 @@ syms_of_process (void)
DEFSYM (Qreal, "real");
DEFSYM (Qnetwork, "network");
DEFSYM (Qserial, "serial");
DEFSYM (Qpipe, "pipe");
DEFSYM (QCbuffer, ":buffer");
DEFSYM (QChost, ":host");
DEFSYM (QCservice, ":service");