commit 10ea719abcde4f2ee40e717eb846fe93f51d5d79 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Sun Oct 25 01:40:27 2020 +0200 Add shortdoc group for alist * lisp/emacs-lisp/shortdoc.el (alist): New shortdoc group. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index af17a7bf97..acc7d13195 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -78,6 +78,45 @@ There can be any number of :example/:result elements." shortdoc--groups)) (push (cons ',group ',functions) shortdoc--groups))) +(define-short-documentation-group alist + "Alist Basics" + (assoc + :eval (assoc 'foo '((foo . bar) (zot . baz)))) + (rassoc + :eval (rassoc 'bar '((foo . bar) (zot . baz)))) + (assq + :eval (assq 'foo '((foo . bar) (zot . baz)))) + (rassq + :eval (rassq 'bar '((foo . bar) (zot . baz)))) + (assoc-string + :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz")))) + "Manipulating Alists" + (assoc-delete-all + :eval (assoc-delete-all "foo" '(("foo" . "bar") ("zot" . "baz")) #'equal)) + (assq-delete-all + :eval (assq-delete-all 'foo '((foo . bar) (zot . baz)))) + (rassq-delete-all + :eval (rassq-delete-all 'bar '((foo . bar) (zot . baz)))) + (alist-get + :eval (let ((foo '((bar . baz)))) + (setf (alist-get 'bar foo) 'zot) + foo)) + "Misc" + (assoc-default + :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match)) + (copy-alist + :eval (let* ((old '((foo . bar))) + (new (copy-alist old))) + (eq old new))) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. + ;; (let-alist + ;; :eval (let ((colors '((rose . red) + ;; (lily . white)))) + ;; (let-alist colors + ;; (if (eq .rose 'red) + ;; .lily)))) + ) + (define-short-documentation-group string "Making Strings" (make-string commit b6a41c76a5a4b95a1cf62d708e33e8b7472302aa Author: Stefan Kangas Date: Sun Oct 25 00:51:23 2020 +0200 Add shortdoc group for hash-table * lisp/emacs-lisp/shortdoc.el (hash-table): New shortdoc group. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 7ae6d53a21..af17a7bf97 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -380,6 +380,37 @@ There can be any number of :example/:result elements." :no-eval (set-file-acl "/tmp/foo" "group::rxx") :eg-result t)) +(define-short-documentation-group hash-table + "Hash Table Basics" + (make-hash-table + :no-eval (make-hash-table) + :result-string "#s(hash-table ...)") + (puthash + :no-eval (puthash 'key "value" table)) + (gethash + :no-eval (gethash 'key table) + :eg-result "value") + (remhash + :no-eval (remhash 'key table) + :result nil) + (clrhash + :no-eval (clrhash table) + :result-string "#s(hash-table ...)") + (maphash + :no-eval (maphash (lambda (key value) (message value)) table) + :result nil) + "Other Hash Table Functions" + (hash-table-p + :eval (hash-table-p 123)) + (copy-hash-table + :no-eval (copy-hash-table table) + :result-string "#s(hash-table ...)") + (hash-table-count + :no-eval (hash-table-count table) + :eg-result 15) + (hash-table-size + :no-eval (hash-table-size table) + :eg-result 65)) (define-short-documentation-group list "Making Lists" commit 32e427cca112f5471356c1fa95ba1ed256d200b6 Author: Paul Eggert Date: Sat Oct 24 13:50:29 2020 -0700 Minor doprnt cleanup: remove memchr call * src/doprnt.c (doprnt): Remove unnecessary call to memchr. diff --git a/src/doprnt.c b/src/doprnt.c index be256f4497..ce259d07cf 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -144,10 +144,10 @@ parse_format_integer (char const *fmt, int *value) return fmt; } -/* Like doprnt, except FORMAT must not contain NUL bytes and - FORMAT_END must be non-null. Although this function is never - exercised in current Emacs, it is retained in case some future - Emacs version contains doprnt callers that need such formats. +/* Like doprnt, except FORMAT_END must be non-null. + Although this function is never exercised in current Emacs, + it is retained in case some future Emacs version + contains doprnt callers that need such formats. Having a separate function helps GCC optimize doprnt better. */ static ptrdiff_t doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format, @@ -181,7 +181,7 @@ ptrdiff_t doprnt (char *buffer, ptrdiff_t bufsize, const char *format, const char *format_end, va_list ap) { - if (format_end && !memchr (format, 0, format_end - format)) + if (format_end) return doprnt_non_null_end (buffer, bufsize, format, format_end, ap); const char *fmt = format; /* Pointer into format string. */ commit 28d2931b4bc934d06f449c01e067258d76a16738 Author: Paul Eggert Date: Sat Oct 24 13:46:46 2020 -0700 Rename doprnt_nul to doprnt_non_null_end * src/doprnt.c (doprnt_non_null_end): Rename from doprnt_nul, as the old name was misleading (left over from a previous proposal). Caller changed. diff --git a/src/doprnt.c b/src/doprnt.c index 07c4d8d797..be256f4497 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -150,8 +150,8 @@ parse_format_integer (char const *fmt, int *value) Emacs version contains doprnt callers that need such formats. Having a separate function helps GCC optimize doprnt better. */ static ptrdiff_t -doprnt_nul (char *buffer, ptrdiff_t bufsize, char const *format, - char const *format_end, va_list ap) +doprnt_non_null_end (char *buffer, ptrdiff_t bufsize, char const *format, + char const *format_end, va_list ap) { USE_SAFE_ALLOCA; ptrdiff_t fmtlen = format_end - format; @@ -182,7 +182,7 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, const char *format_end, va_list ap) { if (format_end && !memchr (format, 0, format_end - format)) - return doprnt_nul (buffer, bufsize, format, format_end, ap); + return doprnt_non_null_end (buffer, bufsize, format, format_end, ap); const char *fmt = format; /* Pointer into format string. */ char *bufptr = buffer; /* Pointer into output buffer. */ commit d35d5c7ecde9b5003c3b21f773570800542664fa Author: Paul Eggert Date: Sat Oct 24 13:41:01 2020 -0700 Improve doprnt performance This patch implements some of my suggestions in Bug#8545, with further changes suggested by Eli Zaretskii (Bug#43439). * src/doprnt.c: Improve comments. (SIZE_BOUND_EXTRA): Now at top level, for parse_format_integer. (parse_format_integer): New static function, containing some of the old doprnt. Fix a bug that caused doprnt to infloop on formats like "%10s" that Emacs does not use. We could simplify doprnt further if we dropped support for these never-used formats. (doprnt_nul): New function. (doprnt): Use it. Change doprnt API to exit when either it finds NUL or reaches the character specified by FORMAT_END. In the typical case where FORMAT_END is null, take just one pass over FORMAT, not two. Assume C99 to make code clearer. Do not use malloc or alloca to allocate a copy of the format FMTCPY; instead, use a small fixed-size array FMTSTAR, and use '*' in that array to represent width and precision, passing them as separate int arguments. Use eassume to pacify GCC in switch statements. diff --git a/src/doprnt.c b/src/doprnt.c index ceadf3bdfa..07c4d8d797 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see . */ . For %s and %c, when field width is specified (e.g., %25s), it accounts for the display width of each character, according to char-width-table. That is, it does not assume that each character takes one column on display. + Nor does it assume that each character is a single byte. . If the size of the buffer is not enough to produce the formatted string in its entirety, it makes sure that truncation does not chop the last @@ -42,12 +43,14 @@ along with GNU Emacs. If not, see . */ Emacs can handle. OTOH, this function supports only a small subset of the standard C formatted - output facilities. E.g., %u and %ll are not supported, and precision is - ignored %s and %c conversions. (See below for the detailed documentation of - what is supported.) However, this is okay, as this function is supposed to - be called from `error' and similar functions, and thus does not need to - support features beyond those in `Fformat_message', which is used - by `error' on the Lisp level. */ + output facilities. E.g., %u is not supported, precision is ignored + in %s and %c conversions, and %lld does not necessarily work and + code should use something like %"pM"d with intmax_t instead. + (See below for the detailed documentation of what is supported.) + However, this is okay, as this function is supposed to be called + from 'error' and similar C functions, and thus does not need to + support all the features of 'Fformat_message', which is used by the + Lisp 'error' function. */ /* In the FORMAT argument this function supports ` and ' as directives that output left and right quotes as per ‘text-quoting style’. It @@ -61,19 +64,21 @@ along with GNU Emacs. If not, see . */ %e means print a `double' argument in exponential notation. %f means print a `double' argument in decimal-point notation. %g means print a `double' argument in exponential notation - or in decimal-point notation, whichever uses fewer characters. + or in decimal-point notation, depending on the value; + this is often (though not always) the shorter of the two notations. %c means print a `signed int' argument as a single character. %% means produce a literal % character. - A %-sequence may contain optional flag, width, and precision specifiers, and - a length modifier, as follows: + A %-sequence other than %% may contain optional flags, width, precision, + and length, as follows: %character where flags is [+ -0], width is [0-9]+, precision is .[0-9]+, and length is empty or l or the value of the pD or pI or PRIdMAX (sans "d") macros. - Also, %% in a format stands for a single % in the output. A % that - does not introduce a valid %-sequence causes undefined behavior. + A % that does not introduce a valid %-sequence causes undefined behavior. + ASCII bytes in FORMAT other than % are copied through as-is; + non-ASCII bytes should not appear in FORMAT. The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only affect %d, %o, @@ -99,7 +104,9 @@ along with GNU Emacs. If not, see . */ For %e, %f, and %g sequences, the number after the "." in the precision specifier says how many decimal places to show; if zero, the decimal point - itself is omitted. For %s and %S, the precision specifier is ignored. */ + itself is omitted. For %d, %o, and %x sequences, the precision specifies + the minimum number of digits to appear. Precision specifiers are + not supported for other %-sequences. */ #include #include @@ -115,7 +122,50 @@ along with GNU Emacs. If not, see . */ another macro. */ #include "character.h" +/* Enough to handle floating point formats with large numbers. */ +enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; + +/* Parse FMT as an unsigned decimal integer, putting its value into *VALUE. + Return the address of the first byte after the integer. + If FMT is not an integer, return FMT and store zero into *VALUE. */ +static char const * +parse_format_integer (char const *fmt, int *value) +{ + int n = 0; + bool overflow = false; + for (; '0' <= *fmt && *fmt <= '9'; fmt++) + { + overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); + overflow |= INT_ADD_WRAPV (n, *fmt - '0', &n); + } + if (overflow || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) + error ("Format width or precision too large"); + *value = n; + return fmt; +} + +/* Like doprnt, except FORMAT must not contain NUL bytes and + FORMAT_END must be non-null. Although this function is never + exercised in current Emacs, it is retained in case some future + Emacs version contains doprnt callers that need such formats. + Having a separate function helps GCC optimize doprnt better. */ +static ptrdiff_t +doprnt_nul (char *buffer, ptrdiff_t bufsize, char const *format, + char const *format_end, va_list ap) +{ + USE_SAFE_ALLOCA; + ptrdiff_t fmtlen = format_end - format; + char *fmt = SAFE_ALLOCA (fmtlen + 1); + memcpy (fmt, format, fmtlen); + fmt[fmtlen] = 0; + ptrdiff_t nbytes = doprnt (buffer, bufsize, fmt, NULL, ap); + SAFE_FREE (); + return nbytes; +} + /* Generate output from a format-spec FORMAT, + terminated at either the first NUL or (if FORMAT_END is non-null + and there are no NUL bytes between FORMAT and FORMAT_END) terminated at position FORMAT_END. (*FORMAT_END is not part of the format, but must exist and be readable.) Output goes in BUFFER, which has room for BUFSIZE chars. @@ -131,12 +181,12 @@ ptrdiff_t doprnt (char *buffer, ptrdiff_t bufsize, const char *format, const char *format_end, va_list ap) { + if (format_end && !memchr (format, 0, format_end - format)) + return doprnt_nul (buffer, bufsize, format, format_end, ap); + const char *fmt = format; /* Pointer into format string. */ char *bufptr = buffer; /* Pointer into output buffer. */ - /* Enough to handle floating point formats with large numbers. */ - enum { SIZE_BOUND_EXTRA = DBL_MAX_10_EXP + 50 }; - /* Use this for sprintf unless we need something really big. */ char tembuf[SIZE_BOUND_EXTRA + 50]; @@ -150,103 +200,91 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, char *big_buffer = NULL; enum text_quoting_style quoting_style = text_quoting_style (); - ptrdiff_t tem = -1; - char *string; - char fixed_buffer[20]; /* Default buffer for small formatting. */ - char *fmtcpy; - int minlen; - char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - USE_SAFE_ALLOCA; - - if (format_end == 0) - format_end = format + strlen (format); - - fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1 - ? fixed_buffer - : SAFE_ALLOCA (format_end - format + 1)); bufsize--; /* Loop until end of format string or buffer full. */ - while (fmt < format_end && bufsize > 0) + while (*fmt && bufsize > 0) { char const *fmt0 = fmt; char fmtchar = *fmt++; if (fmtchar == '%') { - ptrdiff_t size_bound = 0; ptrdiff_t width; /* Columns occupied by STRING on display. */ enum { pDlen = sizeof pD - 1, pIlen = sizeof pI - 1, - pMlen = sizeof PRIdMAX - 2 + pMlen = sizeof PRIdMAX - 2, + maxmlen = max (max (1, pDlen), max (pIlen, pMlen)) }; enum { no_modifier, long_modifier, pD_modifier, pI_modifier, pM_modifier } length_modifier = no_modifier; static char const modifier_len[] = { 0, 1, pDlen, pIlen, pMlen }; - int maxmlen = max (max (1, pDlen), max (pIlen, pMlen)); int mlen; + char charbuf[MAX_MULTIBYTE_LENGTH + 1]; /* Used for %c. */ - /* Copy this one %-spec into fmtcpy. */ - string = fmtcpy; + /* Width and precision specified by this %-sequence. */ + int wid = 0, prec = -1; + + /* FMTSTAR will be a "%*.*X"-like version of this %-sequence. + Start by putting '%' into FMTSTAR. */ + char fmtstar[sizeof "%-+ 0*.*d" + maxmlen]; + char *string = fmtstar; *string++ = '%'; - while (fmt < format_end) + + /* Copy at most one instance of each flag into FMTSTAR. */ + bool minusflag = false, plusflag = false, zeroflag = false, + spaceflag = false; + for (;; fmt++) { - *string++ = *fmt; - if ('0' <= *fmt && *fmt <= '9') + *string = *fmt; + switch (*fmt) { - /* Get an idea of how much space we might need. - This might be a field width or a precision; e.g. - %1.1000f and %1000.1f both might need 1000+ bytes. - Parse the width or precision, checking for overflow. */ - int n = *fmt - '0'; - bool overflow = false; - while (fmt + 1 < format_end - && '0' <= fmt[1] && fmt[1] <= '9') - { - overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); - overflow |= INT_ADD_WRAPV (n, fmt[1] - '0', &n); - *string++ = *++fmt; - } - - if (overflow - || min (PTRDIFF_MAX, SIZE_MAX) - SIZE_BOUND_EXTRA < n) - error ("Format width or precision too large"); - if (size_bound < n) - size_bound = n; + case '-': string += !minusflag; minusflag = true; continue; + case '+': string += !plusflag; plusflag = true; continue; + case ' ': string += !spaceflag; spaceflag = true; continue; + case '0': string += !zeroflag; zeroflag = true; continue; } - else if (! (*fmt == '-' || *fmt == ' ' || *fmt == '.' - || *fmt == '+')) - break; - fmt++; + break; } + /* Parse width and precision, putting "*.*" into FMTSTAR. */ + if ('1' <= *fmt && *fmt <= '9') + fmt = parse_format_integer (fmt, &wid); + if (*fmt == '.') + fmt = parse_format_integer (fmt + 1, &prec); + *string++ = '*'; + *string++ = '.'; + *string++ = '*'; + /* Check for the length modifiers in textual length order, so that longer modifiers override shorter ones. */ for (mlen = 1; mlen <= maxmlen; mlen++) { - if (format_end - fmt < mlen) - break; if (mlen == 1 && *fmt == 'l') length_modifier = long_modifier; - if (mlen == pDlen && memcmp (fmt, pD, pDlen) == 0) + if (mlen == pDlen && strncmp (fmt, pD, pDlen) == 0) length_modifier = pD_modifier; - if (mlen == pIlen && memcmp (fmt, pI, pIlen) == 0) + if (mlen == pIlen && strncmp (fmt, pI, pIlen) == 0) length_modifier = pI_modifier; - if (mlen == pMlen && memcmp (fmt, PRIdMAX, pMlen) == 0) + if (mlen == pMlen && strncmp (fmt, PRIdMAX, pMlen) == 0) length_modifier = pM_modifier; } + /* Copy optional length modifier and conversion specifier + character into FMTSTAR, and append a NUL. */ mlen = modifier_len[length_modifier]; - memcpy (string, fmt + 1, mlen); - string += mlen; + string = mempcpy (string, fmt, mlen + 1); fmt += mlen; *string = 0; - /* Make the size bound large enough to handle floating point formats + /* An idea of how much space we might need. + This might be a field width or a precision; e.g. + %1.1000f and %1000.1f both might need 1000+ bytes. + Make it large enough to handle floating point formats with large numbers. */ - size_bound += SIZE_BOUND_EXTRA; + ptrdiff_t size_bound = max (wid, prec) + SIZE_BOUND_EXTRA; /* Make sure we have that much. */ if (size_bound > size_allocated) @@ -257,48 +295,49 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, sprintf_buffer = big_buffer; size_allocated = size_bound; } - minlen = 0; + int minlen = 0; + ptrdiff_t tem; switch (*fmt++) { default: - error ("Invalid format operation %s", fmtcpy); + error ("Invalid format operation %s", fmt0); -/* case 'b': */ - case 'l': case 'd': switch (length_modifier) { case no_modifier: { int v = va_arg (ap, int); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { long v = va_arg (ap, long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: signed_pD_modifier: { ptrdiff_t v = va_arg (ap, ptrdiff_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pI_modifier: { EMACS_INT v = va_arg (ap, EMACS_INT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { intmax_t v = va_arg (ap, intmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -311,13 +350,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case no_modifier: { unsigned v = va_arg (ap, unsigned); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case long_modifier: { unsigned long v = va_arg (ap, unsigned long); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pD_modifier: @@ -325,15 +364,17 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case pI_modifier: { EMACS_UINT v = va_arg (ap, EMACS_UINT); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; case pM_modifier: { uintmax_t v = va_arg (ap, uintmax_t); - tem = sprintf (sprintf_buffer, fmtcpy, v); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, v); } break; + default: + eassume (false); } /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; @@ -344,18 +385,15 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, case 'g': { double d = va_arg (ap, double); - tem = sprintf (sprintf_buffer, fmtcpy, d); + tem = sprintf (sprintf_buffer, fmtstar, wid, prec, d); /* Now copy into final output, truncating as necessary. */ string = sprintf_buffer; goto doit; } case 'S': - string[-1] = 's'; - FALLTHROUGH; case 's': - if (fmtcpy[1] != 's') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; string = va_arg (ap, char *); tem = strnlen (string, STRING_BYTES_BOUND + 1); if (tem == STRING_BYTES_BOUND + 1) @@ -432,14 +470,12 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, string = charbuf; string[tem] = 0; width = strwidth (string, tem); - if (fmtcpy[1] != 'c') - minlen = atoi (&fmtcpy[1]); + minlen = minusflag ? -wid : wid; goto doit1; } case '%': /* Treat this '%' as normal. */ - fmt0 = fmt - 1; break; } } @@ -450,13 +486,13 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, src = uLSQM, srclen = sizeof uLSQM - 1; else if (quoting_style == CURVE_QUOTING_STYLE && fmtchar == '\'') src = uRSQM, srclen = sizeof uRSQM - 1; - else if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') - src = "'", srclen = 1; else { - while (fmt < format_end && !CHAR_HEAD_P (*fmt)) - fmt++; - src = fmt0, srclen = fmt - fmt0; + if (quoting_style == STRAIGHT_QUOTING_STYLE && fmtchar == '`') + fmtchar = '\''; + eassert (ASCII_CHAR_P (fmtchar)); + *bufptr++ = fmtchar; + continue; } if (bufsize < srclen) @@ -479,8 +515,6 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, xfree (big_buffer); *bufptr = 0; /* Make sure our string ends with a '\0' */ - - SAFE_FREE (); return bufptr - buffer; } commit c3835bd3803e5f395c4ebf0b2585cc9272173548 Author: Mauro Aranda Date: Sat Oct 24 21:40:42 2020 +0200 Warn about a bad default value in restricted-sexp widget * lisp/wid-edit.el (restricted-sexp widget): New :value-to-external function. If value is not in the internal format, then we might be dealing with a bad default value for the widget, so display a warning about that (bug#25152). diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 009c6b4faf..4e2cf7416d 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3585,7 +3585,30 @@ To use this type, you must define :match or :match-alternatives." :value-to-internal (lambda (widget value) (if (widget-apply widget :match value) (widget-sexp-value-to-internal widget value) - value))) + value)) + :value-to-external (lambda (widget value) + ;; We expect VALUE to be a string, so we can convert it + ;; into the external format just by `read'ing it. + ;; But for a restricted-sexp widget with a bad default + ;; value, we might end up calling read with a nil + ;; argument, resulting in an undesired prompt to the + ;; user. A bad default value is not always a big + ;; problem, but might end up in a messed up buffer, + ;; so display a warning here. (Bug#25152) + (unless (stringp value) + (display-warning + 'widget-bad-default-value + (format-message + "\nA widget of type %S has a bad default value. +value: %S +match function: %S +match-alternatives: %S" + (widget-type widget) + value + (widget-get widget :match) + (widget-get widget :match-alternatives)) + :warning)) + (read value))) (defun widget-restricted-sexp-match (widget value) (let ((alternatives (widget-get widget :match-alternatives)) commit dd16e46bb9d0099baea06d780ad8f62728addc2e Author: Stefan Kangas Date: Sat Oct 24 20:22:33 2020 +0200 ; Prefer https to http in more URLs These were all tested and confirmed working. diff --git a/ChangeLog.2 b/ChangeLog.2 index ebaf3846dc..5e9b8b901e 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -9269,7 +9269,7 @@ This is related to the autogen.sh changes made by Paul Eggert in commit d766ca8f (2016-02-01) and commit cedd7cad (2016-02-01), and to - my edits today to http://www.emacswiki.org/emacs/GitForEmacsDevs and + my edits today to https://www.emacswiki.org/emacs/GitForEmacsDevs and to emacswiki.org/emacs/GitQuickStartForEmacsDevs. See also the thread "Recommend these .gitconfig settings for git integrity." at https://lists.gnu.org/r/emacs-devel/2016-01/threads.html#01802. @@ -13444,7 +13444,7 @@ (gdb-send): Recognize various ways of exiting from Python and Guile interpreters and returning to GDB. For details, see https://lists.gnu.org/r/emacs-devel/2015-12/msg00693.html - and http://stackoverflow.com/questions/31514741. + and https://stackoverflow.com/questions/31514741. 2015-12-16 Paul Eggert @@ -23731,7 +23731,7 @@ * lisp/progmodes/etags.el (etags-tags-completion-table): Allow even one non-regular character before the implicit tag name. - Reported at http://emacs.stackexchange.com/questions/15269/. + Reported at https://emacs.stackexchange.com/questions/15269/. 2015-09-06 Thomas Fitzsimmons diff --git a/ChangeLog.3 b/ChangeLog.3 index ec2d3f8d46..0f36310079 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -44031,8 +44031,8 @@ * src/marker.c (buf_bytepos_to_charpos): Remove the assertion regarding bytepos always at the head byte of a multibyte sequence. For the reasons, see - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html - http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00100.html + https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00102.html 2019-03-05 Wilson Snyder @@ -45541,7 +45541,7 @@ * lisp/startup.el (command-line): Pass 'early-init.el', with an explicit .el extension, to load-user-init-file. Reported by Radon Rosborough in - http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. + https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00314.html. 2019-02-15 Stefan Monnier @@ -50624,7 +50624,7 @@ the correct directory in emacs_wd, which is now initialized way earlier in the startup process, when init_environment was not yet called. For details, see the problems reported in - http://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-12/msg00068.html. Reported by Angelo Graziosi . 2018-12-06 Juri Linkov @@ -52313,7 +52313,7 @@ * lib-src/emacsclient.c (set_local_socket): Don't ignore socket ownership when run by root. - Ref: http://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html + Ref: https://lists.gnu.org/r/emacs-devel/2018-11/msg00019.html 2018-11-13 Eli Zaretskii @@ -57139,7 +57139,7 @@ alias for thai-iso8859-11. Instead, reinstate the original definition of tis620-2533, but without eight-bit-control in the :superset attribute. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00117.html and the surrounding discussions. * lisp/international/fontset.el (font-encoding-alist) (font-encoding-charset-alist): Reinstate tis620-2533 charset. @@ -60017,7 +60017,7 @@ * src/w32proc.c (syms_of_ntproc) : Set to zero. For the details, see this discussion: - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00711.html. * src/w32.c (_sys_read_ahead): Update the commentary for w32-pipe-read-delay usage. @@ -62471,7 +62471,7 @@ * lisp/subr.el (string-to-unibyte): No longer obsolete. See the emacs-devel discussion around this message: - http://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-05/msg00656.html. * etc/NEWS: Announce the change. @@ -63512,7 +63512,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. 2018-05-04 Noam Postavsky @@ -65267,7 +65267,7 @@ (eww-display-html): ... and don't get it here, because it's gone by now. - Test URL: http://www.gnu.org/s/hyperbole/#summary + Test URL: https://www.gnu.org/s/hyperbole/#summary 2018-04-13 Robert Pluim @@ -70827,7 +70827,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. 2018-01-19 Reuben Thomas @@ -80561,7 +80561,7 @@ * configure.ac: Add -Wabi to the list of disabled warning options. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00123.html. 2018-08-10 Filipp Gunbin @@ -80935,7 +80935,7 @@ * lisp/emacs-lisp/rx.el (rx): Clarify and improve the doc string. For the details, see the discussion starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-06/msg00399.html. 2018-07-19 Eli Zaretskii @@ -81072,7 +81072,7 @@ Improve documentation of Flyspell For the background, see - http://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. + https://lists.gnu.org/archive/html/help-gnu-emacs/2018-07/msg00099.html. * doc/emacs/fixit.texi (Spelling): Add a couple of caveats. * lisp/textmodes/flyspell.el: Update commentary. @@ -81781,7 +81781,7 @@ * lisp/info.el: Explain in commentary why some commands start with "info-" and others with "Info-". See also - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00482.html. 2018-06-13 Michael Albinus @@ -82336,7 +82336,7 @@ * lisp/international/fontset.el (font-encoding-alist): Fix the GB18030 entry to encode characters correctly when passing them to the xfont back-end. (Bug#31315) See also - http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. + https://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00754.html. (cherry picked from commit bbe2cadc544e63e9378350621887f8fb9bbcc236) @@ -82460,7 +82460,7 @@ TO_CHARPOS, but didn't yet produce glyphs for that buffer position, because the last call to PRODUCE_GLYPHS at this position was for an object other than the buffer. For further details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00537.html. (cherry picked from commit c0154ac7c3423f68d8f3a2e85a756c9759219039) @@ -83153,7 +83153,7 @@ (Note for Novices): * doc/lispref/tips.texi (Key Binding Conventions): Fix use of @key. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00390.html. 2018-04-19 Eli Zaretskii @@ -83239,7 +83239,7 @@ * src/process.c (Fmake_pipe_process): Set up the decoding and encoding buffers. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-04/msg00295.html. 2018-04-13 Robert Pluim @@ -84015,7 +84015,7 @@ * doc/lispref/variables.texi (Local Variables): Make more clear that local bindings of 'let' are in effect only within the body. Suggested by Marcin Borkowski , see - http://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html + https://lists.gnu.org/archive/html/emacs-devel/2018-03/msg00217.html for the details. * doc/emacs/programs.texi (Matching): Fix a typo. Reported by @@ -85790,7 +85790,7 @@ * doc/emacs/text.texi (Words): Improve wording. Reported by Marcin Borkowski in - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00784.html. 2018-01-28 Martin Rudalics @@ -86006,7 +86006,7 @@ This is part two of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/gtkutil.c (xg_set_geometry): Scale down the coordinates that we @@ -86019,7 +86019,7 @@ This is part one of a two part fix for the GTK scaling problems. See the thread starting at - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00372.html for an explanation of why it has been added to Emacs 26. * src/xfns.c (Fx_display_monitor_attributes_list): Take scaling factor @@ -86163,7 +86163,7 @@ being compiled is specified by an absolute file name. This avoids problems with ACL copying from temporary-file-directory on FreeBSD. For the details, see - http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. + https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00513.html. 2018-01-19 Eli Zaretskii @@ -86356,7 +86356,7 @@ * doc/lispref/variables.texi (File Local Variables): Mention the autoload cookie as a means of defining safe values for variables. - See http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html + See https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html for the details. * doc/lispref/compile.texi (Compiler Errors): Document 'byte-compile-error-on-warn'. @@ -86750,7 +86750,7 @@ scroll-margin when scrolling down, i.e. moving window-start towards the beginning of the buffer. Reported by zhang cc in - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00894.html. 2017-12-29 Eli Zaretskii @@ -86991,7 +86991,7 @@ Clarify what selecting a window means for keyboard input, and that input focus may need to be considered when selecting windows on other frames. See - http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html + https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00372.html for more details. 2017-12-22 Eli Zaretskii @@ -87530,7 +87530,7 @@ * lisp/progmodes/prog-mode.el (prog-indentation-context): Un-document all elements but the first. (prog-widen): Remove. - (http://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) + (https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00321.html) * doc/lispref/text.texi (Mode-Specific Indent): Update. @@ -87675,7 +87675,7 @@ Import the latest IVD_Sequences.txt * admin/unidata/IVD_Sequences.txt: New version from - http://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode + https://www.unicode.org/ivd/, the 2017-12-12 version of the Unicode Ideographic Variation Database. * src/macuvs.h: Regenerated. @@ -87989,7 +87989,7 @@ * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Pass basename of target-file to make-temp-file, in case target-file includes a leading directory that might not exist under TMPDIR. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00680.html for the details. 2017-12-02 Michael Albinus @@ -88670,7 +88670,7 @@ * lisp/calc/calc-aent.el (math-read-token): Make sure the match against "0[xX][0-9a-fA-F]+" is found at math-exp-pos. See - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00174.html for the details. 2017-11-18 Eli Zaretskii @@ -88984,7 +88984,7 @@ * lisp/files.el (find-file, find-file-other-window) (find-file-other-frame): Mention file-name-at-point-functions in the doc string. Reported by Florian Weimer in - http://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. + https://lists.gnu.org/archive/html/emacs-devel/2017-11/msg00224.html. * doc/emacs/mini.texi (Minibuffer History): Document file-name-at-point-functions and its effect on M-n when typing @@ -97350,7 +97350,7 @@ Improve make-temp-file performance on local files For the motivation behind this patch, please see Bug#28023 and: - http://emacshorrors.com/posts/make-temp-name.html + https://emacshorrors.com/posts/make-temp-name.html Although, given the recent changes to Tramp, the related security problem in make-temp-file is already fixed, make-temp-file still has several unnecessary system calls. In the typical case on GNU/Linux, @@ -104823,7 +104823,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html @@ -107262,7 +107262,7 @@ Remove s_client usage from tls.el * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client. - Ref http://bugs.debian.org/766397 + Ref https://bugs.debian.org/766397 https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html 2017-04-25 Glenn Morris @@ -107708,7 +107708,7 @@ * lisp/emacs-lisp/ert.el (ert--expand-should-1): Avoid errors related to undefined byte-compile-macro-environment. Somehow masked until very recently because loading seq (eg) - loads bytecomp. http://hydra.nixos.org/build/51730765 + loads bytecomp. https://hydra.nixos.org/build/51730765 2017-04-18 Eli Zaretskii @@ -108380,7 +108380,7 @@ * test/lisp/emacs-lisp/package-tests.el (with-package-test): Also bind package-gnupghome-dir, see eg - http://hydra.nixos.org/build/51462182 . + https://hydra.nixos.org/build/51462182 . 2017-04-11 Martin Rudalics @@ -113197,7 +113197,7 @@ The [5ec3a584: Generate upcase and downcase tables from Unicode data] commit broke bootstrap from a truly clean tree (e.g. a fresh clone or one created with ‘make extraclean’), see - . + . The failure was caused by characters.el trying to read Unicode property tables which aren’t available so early in the build process. @@ -122075,7 +122075,7 @@ Support zstd compressed files * lisp/jka-cmpr-hook.el (jka-compr-compression-info-list): Add - zstd compression info: . + zstd compression info: . (jka-compr-mode-alist-additions): Handle .tzst suffix for zstd compressed tar archives. (Bug#24853) diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1 index 7a576a0312..64c65bdd12 100644 --- a/admin/ChangeLog.1 +++ b/admin/ChangeLog.1 @@ -1629,10 +1629,10 @@ 2010-09-05 Juanma Barranquero * unidata/BidiMirroring.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt 2010-08-09 Andreas Schwab @@ -1668,7 +1668,7 @@ * unidata/bidimirror.awk: New file. * unidata/BidiMirroring.txt: New file from - http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. + https://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d1.txt. * unidata/Makefile.in (../../src/bidimirror.h): New target. (all): Depend on ../../src/biditype.h and ../../src/bidimirror.h. @@ -1685,7 +1685,7 @@ 2010-06-09 Juanma Barranquero * unidata/UnicodeData.txt: Update from - http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt + https://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d5.txt 2010-05-27 Glenn Morris @@ -2031,7 +2031,7 @@ * unidata/unidata-gen.el: New file. * unidata/UnicodeData.txt: New file. Copied from - http://www.unicode.org on 2006-05-23. + https://www.unicode.org on 2006-05-23. * unidata/.cvsignore: New file. diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index fe1d07f4f9..c3205672d1 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -20,7 +20,7 @@ Available at: * PTCP154 Available at: - + * Uni2JIS @@ -50,8 +50,8 @@ Available at: * CP720.map and CP858.map Created manually by looking at these pages: - . - . + . + . The text in that page is under the terms of the GNU Free Documentation License. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c304342303..6fc8587fe5 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -8037,7 +8037,7 @@ positions do not increase monotonically with string or buffer position. In performing this @dfn{bidirectional reordering}, Emacs follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}), which is described in Annex #9 of the Unicode standard -(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full +(@url{https://www.unicode.org/reports/tr9/}). Emacs provides a ``Full Bidirectionality'' class implementation of the @acronym{UBA}, consistent with the requirements of the Unicode Standard v9.0. Note, however, that the way Emacs displays continuation lines when text diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index bbfc86b111..c875d58ef1 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -1188,9 +1188,9 @@ MS Windows, but this has still been insufficient to keep up with changes in printing technology from text and postscript based printers connected via ports that can be accessed directly, to graphical printers that are only accessible via USB@. For details, see -@uref{http://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs -Wiki}, @uref{http://www.emacswiki.org/emacs/PrintWithWebBrowser}, and -@uref{http://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. +@uref{https://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs +Wiki}, @uref{https://www.emacswiki.org/emacs/PrintWithWebBrowser}, and +@uref{https://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. @c ------------------------------------------------------------ @node Sub-processes @@ -1414,7 +1414,7 @@ continue to use bash as your subshell: @cindex cygwin mount points, using within Emacs The package -@uref{http://www.emacswiki.org/emacs/cygwin-mount.el, +@uref{https://www.emacswiki.org/emacs/cygwin-mount.el, cygwin-mount.el} teaches Emacs about Cygwin mount points. @node Dired ls @@ -1793,7 +1793,7 @@ do not need to add its installation directory to the @env{PATH}. @cindex Emacs distribution, checking digital signatures GNU Privacy Guard is a Free replacement for PGP, with Windows binaries -available. See @uref{http://www.gnupg.org/}. +available. See @uref{https://www.gnupg.org/}. @node Mouse wheel @section Why doesn't my wheel mouse work in Emacs? @@ -2131,7 +2131,7 @@ suggestions} for improving the interaction of perldb and Emacs. @cindex subprocesses, cygwin tools @vindex exec-path -@uref{http://www.cygwin.com/}. +@uref{https://www.cygwin.com/}. Cygwin is a popular complete POSIX emulation environment for Windows. Most of its tools can be used with Emacs, and it covers a wide range @@ -2281,7 +2281,7 @@ and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include: @itemize @item @uref{https://www.gnu.org/software/emacs/, The Emacs homepage} @item @uref{https://www.gnu.org/software/emacs/manual/, Other Emacs manuals} -@item @uref{http://www.emacswiki.org/, Emacs Wiki} +@item @uref{https://www.emacswiki.org/, Emacs Wiki} @end itemize @node Mailing lists diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index e1b099edaa..1bc9d41f9b 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -400,7 +400,7 @@ archive can be browsed over the web at @uref{https://lists.gnu.org/r/, the GNU mail archive}. Web-based Usenet search services, such as -@uref{http://groups.google.com/groups/dir?q=gnu&, Google}, also +@uref{https://groups.google.com/groups/dir?q=gnu&, Google}, also archive the @code{gnu.*} groups. @node Reporting bugs @@ -865,7 +865,7 @@ Bulletin}, are at @uref{https://www.gnu.org/bulletins/bulletins.html} and -@uref{http://www.cs.pdx.edu/~trent/gnu/gnu.html} +@uref{https://www.cs.pdx.edu/~trent/gnu/gnu.html} @node Help installing Emacs @section Where can I get help in installing Emacs? @@ -3613,7 +3613,7 @@ For a list of other MS-DOS implementations of Emacs (and Emacs look-alikes), consult the list of ``Emacs implementations and literature,'' available at -@uref{http://www.finseth.com/emacs.html} +@uref{https://www.finseth.com/emacs.html} Note that while many of these programs look similar to Emacs, they often lack certain features, such as the Emacs Lisp extension language. diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 5cb6b19181..538c088282 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -247,15 +247,15 @@ Here are a number of screenshots showing IDLWAVE in action: @itemize @bullet @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_nav.gif,An IDLWAVE buffer} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_keys.gif,A keyword being completed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_help.gif,Online help text.} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_ri.gif,Routine information displayed} @item -@uref{http://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code +@uref{https://github.com/jdtsmith/idlwave/screenshots/emacs_21_bp.gif,Debugging code stopped at a breakpoint} @end itemize @end ifnottex diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 495d562f50..b7e05feb0f 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -3753,7 +3753,7 @@ A link should be enclosed in double brackets and may contain descriptive text to be displayed instead of the URL (see @ref{Link Format}), for example: @example -[[http://www.gnu.org/software/emacs/][GNU Emacs]] +[[https://www.gnu.org/software/emacs/][GNU Emacs]] @end example @@ -22361,7 +22361,7 @@ Marco Wahl wrote @samp{ol-eww.el}. @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{http://fsf.org/} +@uref{https://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -22786,7 +22786,7 @@ The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See -@uref{http://www.gnu.org/copyleft/}. +@uref{https://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index c3df33eb9a..d1951f581c 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -1389,7 +1389,7 @@ bugs, please report them separately. If you have problems using PCL-CVS or other questions, send them to the @url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, help-gnu-emacs mailing list}. This is a good place to get help, as is -the @url{http://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. +the @url{https://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. If you have ideas for improvements, or if you have written some extensions to this package, we would like to hear from you. We hope that diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 5daa16fb27..261897b735 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -94,7 +94,7 @@ and that you are familiar with its basic functions. By default, PGG uses GnuPG@. If you are new to such a system, I recommend that you should look over the GNU Privacy Handbook (GPH) -which is available at @uref{http://www.gnupg.org/documentation/}. +which is available at @uref{https://www.gnupg.org/documentation/}. When using GnuPG, we recommend the use of the @code{gpg-agent} program, which is distributed with versions 2.0 and later of GnuPG@. diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index 77a1752a4a..5ac3b6b174 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -27,7 +27,7 @@ the absence of any other determinant, we are using the term created these APIs, and because all of the classes and functions still begin with the letters "NS". -(See http://en.wikipedia.org/wiki/Nextstep) +(See https://en.wikipedia.org/wiki/Nextstep) This Emacs port was first released in the early 1990's on the NeXT computer, and was successively updated to OpenStep, Rhapsody, Mac OS diff --git a/etc/TODO b/etc/TODO index 4f9ea7e5d4..8e93e7fb10 100644 --- a/etc/TODO +++ b/etc/TODO @@ -402,7 +402,7 @@ built-in. See the discussion of bug#39799 for more details about this task. Another relevant resource is the Unicode Technical Standard #51 -"Unicode Emoji" (http://www.unicode.org/reports/tr51/). +"Unicode Emoji" (https://www.unicode.org/reports/tr51/). ** Extend text-properties and overlays @@ -497,7 +497,7 @@ https://savannah.nongnu.org/projects/emacs-rtf/, which is still in very early stages. Another place to look is the Wikipedia article at -http://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to +https://en.wikipedia.org/wiki/Rich_Text_Format. It currently points to the latest spec of RTF v1.9.1 at https://web.archive.org/web/20190708132914/http://www.kleinlercher.at/tools/Windows_Protocols/Word2007RTFSpec9.pdf diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index ac395f993c..195d40d7af 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -62,7 +62,7 @@ ;; org-mode, CUA-mode, apt-utils, bbdb, compilation buffers, changelog ;; mode, diff and ediff, eshell, and more. You need emacs-goodies ;; package on Debian to use this. See the wiki page at -;; http://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The +;; https://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The ;; project home page is at https://gna.org/projects/color-theme. ;;; Code: diff --git a/leim/MISC-DIC/CTLau-b5.html b/leim/MISC-DIC/CTLau-b5.html index e718edeb12..117a6ee374 100644 --- a/leim/MISC-DIC/CTLau-b5.html +++ b/leim/MISC-DIC/CTLau-b5.html @@ -23,7 +23,7 @@ # 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 . +# along with this program. If not, see . # # # File Format: diff --git a/leim/MISC-DIC/CTLau.html b/leim/MISC-DIC/CTLau.html index 18a48c125d..e775911732 100644 --- a/leim/MISC-DIC/CTLau.html +++ b/leim/MISC-DIC/CTLau.html @@ -23,7 +23,7 @@ # 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 . +# along with this program. If not, see . # # # File Format: diff --git a/leim/MISC-DIC/pinyin.map b/leim/MISC-DIC/pinyin.map index 6c2117713b..4809769d1a 100644 --- a/leim/MISC-DIC/pinyin.map +++ b/leim/MISC-DIC/pinyin.map @@ -23,7 +23,7 @@ % details. % % You should have received a copy of the GNU General Public License along with -% CCE. If not, see . +% CCE. If not, see . % % End of header added for Emacs a °¢°¡ºÇëçàÄï¹ß¹ diff --git a/leim/MISC-DIC/ziranma.cin b/leim/MISC-DIC/ziranma.cin index 13a63fd733..b61aea2b6f 100644 --- a/leim/MISC-DIC/ziranma.cin +++ b/leim/MISC-DIC/ziranma.cin @@ -23,7 +23,7 @@ % details. % % You should have received a copy of the GNU General Public License along with -% CCE. If not, see . +% CCE. If not, see . % % End of header added for Emacs %ename ZiranMa diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11 index 52b85950be..374a566893 100644 --- a/lisp/ChangeLog.11 +++ b/lisp/ChangeLog.11 @@ -13392,7 +13392,7 @@ * progmodes/compile.el (compilation-error-regexp-alist): Add Java ANt error detection as described in document - http://ant.apache.org/faq.html + https://ant.apache.org/faq.html 2003-08-12 Juri Linkov (tiny change) diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 6c093790d3..bb7389c5b7 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -379,7 +379,7 @@ 2013-02-28 Sam Steingold * vc/diff-mode.el (diff-hunk-file-names): Handle filenames with spaces. - See . + See . 2013-02-28 Thierry Volpiatto @@ -1326,7 +1326,7 @@ * net/soap-client.el (soap-invoke): Encode the string for `url-request-data' as UTF-8. - Fixes . + Fixes . 2013-02-01 Glenn Morris @@ -2462,7 +2462,7 @@ 2012-12-27 Sam Steingold * progmodes/cperl-mode.el (cperl-calculate-indent): Do not stagger - continuations, see . + continuations, see . 2012-12-27 Dmitry Gutov @@ -11473,7 +11473,7 @@ (sh-set-shell): Use smie-setup if requested. * term.el (term-set-escape-char): Properly set term-escape-char. - See http://stackoverflow.com/questions/10524656. + See https://stackoverflow.com/questions/10524656. 2012-05-10 Chong Yidong @@ -16476,7 +16476,7 @@ (python-pdbtrack-track-stack-file): Adjust to recognize ipdb as well as regular python pdb prompts. Adjustments shamelessly taken exactly as suggested in EmacsWiki page (tiny change): - http://www.emacswiki.org/PythonProgrammingInEmacs#toc14 + https://www.emacswiki.org/PythonProgrammingInEmacs#toc14 2011-11-16 Juanma Barranquero diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 8039e3f28a..5789445fcd 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -23951,7 +23951,7 @@ * simple.el (shell-command-on-region): Pass the `replace' argument down to `call-process-region' to comply with the doc as reported on - + 2013-05-23 Stefan Monnier diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index c3b2d98c14..d20260b185 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -39,7 +39,7 @@ ;; ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 ;; standard (identical to ISO/IEC 6429), which is freely available as a -;; PDF file . +;; PDF file . ;; The "Graphic Rendition Combination Mode (GRCM)" implemented is ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode ;; means that whenever possible, SGR control sequences are combined @@ -84,7 +84,7 @@ This translation effectively colorizes strings and regions based upon SGR control sequences embedded in the text. SGR (Select Graphic Rendition) control sequences are defined in section 8.3.117 of the ECMA-48 standard (identical to ISO/IEC 6429), which is freely available -at +at as a PDF file." :version "21.1" :group 'processes) diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index 49b0fd1b3b..0ff9cde80e 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -427,7 +427,7 @@ Menu items are appended to the common grammar menu.") "\n;; It is derived from the grammar in the ECMAScript Language ;; Specification published at ;; -;; http://www.ecma-international.org/publications/standards/Ecma-262.htm +;; https://www.ecma-international.org/publications/standards/Ecma-262.htm ;; ;; and redistributed under the following license: ;; diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 90bd8bd09e..fdf5195468 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -9116,7 +9116,7 @@ 2002-11-10 Alex Schroeder * TODO: - TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO + TODO: moved it to https://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO * erc.el(with-erc-channel-buffer): Rudimentary doc string. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 1cf0bb4921..f99088d4c7 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -408,7 +408,7 @@ This string is processed using `format-time-string'." ;;; Flood-related ;; Most of this is courtesy of Jorgen Schaefer and Circe -;; (http://www.nongnu.org/circe) +;; (https://www.nongnu.org/circe) (defcustom erc-server-flood-margin 10 "A margin on how much excess data we send. diff --git a/lisp/frame.el b/lisp/frame.el index 29ac862ccd..772ba3d8c4 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1934,7 +1934,7 @@ for FRAME." ;; features change, it will be easy to find all the tests for such ;; capabilities by a simple text search. See more about the history ;; and the intent of these functions in -;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html +;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html ;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17. (declare-function msdos-mouse-p "dosfns.c") diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index c84f0a4990..42dd19842c 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -39,7 +39,7 @@ ;; Society of Japan/Information Technology Standards Commission of ;; Japan (IPSJ/ITSCJ) at https://www.itscj.ipsj.or.jp/itscj_english/. ;; Standards docs equivalent to iso-2022 and iso-8859 are at -;; http://www.ecma.ch/. +;; https://www.ecma.ch/. ;; FWIW, http://www.microsoft.com/globaldev/ lists the following for ;; MS Windows, which are presumably the only charsets we really need diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index ffbc253a97..7de6baeb00 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; This library implements the JSONRPC 2.0 specification as described -;; in http://www.jsonrpc.org/. As the name suggests, JSONRPC is a +;; in https://www.jsonrpc.org/. As the name suggests, JSONRPC is a ;; generic Remote Procedure Call protocol designed around JSON ;; objects. To learn how to write JSONRPC programs with this library, ;; see Info node `(elisp)JSONRPC'." diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index c296f29f9e..49dfd2ee87 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1851,7 +1851,7 @@ place. It affects how `mail-extract-address-components' works." ;; Updated by the RIPE Network Coordination Centre. ;; ;; Source: ISO 3166 Maintenance Agency -;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt +;; https://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt ;; https://www.iana.org/domain-names.htm ;; https://www.iana.org/cctld/cctld-whois.htm ;; Latest change: 2007/11/15 diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index 43a589aeca..e6ee87b841 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -29,7 +29,7 @@ ;; https://www.jwz.org/doc/threading.html ;; It also begins to implement the threading section of the IMAP - ;; SORT and THREAD Extensions RFC at: -;; http://tools.ietf.org/html/rfc5256 +;; https://tools.ietf.org/html/rfc5256 ;; The implementation lacks the reference and subject canonicalization ;; of the RFC. diff --git a/lisp/misc.el b/lisp/misc.el index be191c50d2..03395781a5 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -127,7 +127,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure air to form, which act as lenses that deflect incoming cosmic rays, focusing them to strike the drive platter and flip the desired bit. You can type `M-x butterfly C-M-c' to run it. This is a permuted -variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." +variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." (interactive) (if (yes-or-no-p "Do you really want to unleash the powers of the butterfly? ") (progn @@ -139,7 +139,7 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." (sit-for (* 5 (/ (abs (random)) (float most-positive-fixnum)))) (message "Successfully flipped one bit!")) (message "Well, then go to xkcd.com!") - (browse-url "http://xkcd.com/378/"))) + (browse-url "https://xkcd.com/378/"))) ;; A command to list dynamically loaded libraries. This useful in ;; environments where dynamic-library-alist is used, i.e., Windows diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 700653250f..5639d52f81 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -29,7 +29,7 @@ ;; `ldapsearch' to actually perform the searches. That program can be ;; found in all LDAP developer kits such as: ;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) -;; - OpenLDAP (http://www.openldap.org/) +;; - OpenLDAP (https://www.openldap.org/) ;;; Code: diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9502cc3530..931a971731 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -163,7 +163,7 @@ "List of suffixes which indicate a file archive. It must be supported by libarchive(3).") -;; +;; ;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress. ;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab. diff --git a/lisp/notifications.el b/lisp/notifications.el index 3c2a8cf39c..f83898622e 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; This package provides an implementation of the Desktop Notifications -;; . +;; . ;; In order to activate this package, you must add the following code ;; into your .emacs: diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index f5bdf79349..622ba91199 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -24,7 +24,7 @@ ;; This handles the regular expressions in the syntax defined by: ;; W3C XML Schema Part 2: Datatypes -;; +;; ;; ;; The main entry point is `xsdre-translate'. ;; @@ -1219,7 +1219,7 @@ Code is inserted into the current buffer." ;; The rest of the file was auto-generated by doing M-x xsdre-gen-categories ;; on UnicodeData-3.1.0.txt available from -;; http://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt +;; https://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt (xsdre-def-primitive-category 'Lu '((65 . 90) diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el index 56a57cdf64..d04a40dd3b 100644 --- a/lisp/org/ob-coq.el +++ b/lisp/org/ob-coq.el @@ -27,7 +27,7 @@ ;; session evaluation is supported. Requires both coq.el and ;; coq-inferior.el, both of which are distributed with Coq. ;; -;; http://coq.inria.fr/ +;; https://coq.inria.fr/ ;;; Code: (require 'ob) diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 8f66d10207..655e253d92 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -30,11 +30,11 @@ ;;; Requirements: -;; - a non-browser javascript engine such as node.js http://nodejs.org/ -;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; - a non-browser javascript engine such as node.js https://nodejs.org/ +;; or mozrepl https://wiki.github.com/bard/mozrepl/ ;; ;; - for session based evaluation mozrepl and moz.el are required see -;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; https://wiki.github.com/bard/mozrepl/emacs-integration for ;; configuration instructions ;;; Code: diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el index e9c214f7df..b1c2275622 100644 --- a/lisp/org/ob-vala.el +++ b/lisp/org/ob-vala.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; ob-vala.el provides Babel support for the Vala language -;; (see http://live.gnome.org/Vala for details) +;; (see https://live.gnome.org/Vala for details) ;;; Requirements: diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el index 9ae2700549..fe3b5f8da1 100644 --- a/lisp/org/org-tempo.el +++ b/lisp/org/org-tempo.el @@ -4,7 +4,7 @@ ;; ;; Author: Rasmus Pank Roulund ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org +;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 6e96a67b7b..0fd426e3d1 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -141,7 +141,7 @@ (pcomplete-here* (pcomplete-dirs-or-entries))))))) -;;;; ack - http://betterthangrep.com +;;;; ack - https://betterthangrep.com ;; Usage: ;; - To complete short options type '-' first diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 00fcb804d4..9dacd5856c 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -52,7 +52,7 @@ ;; ;; * Probably. Show rules/dependencies for ANT like for Makefile (does ANT ;; support vocabularies and grammar inheritance?), I have to look at -;; jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html +;; jde-ant.el: https://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html ;; * Probably. Make `indent-region' faster, especially in actions. ELP ;; profiling in a class init action shows half the time is spent in ;; `antlr-next-rule', the other half in `c-guess-basic-syntax'. diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el index 65090ac3ca..cb6bd6c34b 100644 --- a/lisp/progmodes/cl-font-lock.el +++ b/lisp/progmodes/cl-font-lock.el @@ -23,7 +23,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 7f4d2251fd..0487964d81 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -135,7 +135,7 @@ ;; values enable completion for both CPython and IPython, and probably ;; any readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), -;; installing pyreadline (URL `http://ipython.org/pyreadline.html') +;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any ;; completions, you can try the following in your Python shell: diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index de2053c3c9..a1c4c08c26 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1325,7 +1325,7 @@ FILES must be a list of absolute file names." ;; call-process-region *is* measurably faster, even for a program ;; doing some actual work (for a period of time). Even though ;; call-process-region also creates a temp file internally - ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). + ;; (https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html). (if (not (file-remote-p default-directory)) (apply #'call-process-region start end program nil buffer display args) diff --git a/lisp/term.el b/lisp/term.el index ff8b3f00f3..8cbbfff1b6 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2805,7 +2805,7 @@ See `term-prompt-regexp'." ;; References: ;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm +;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm ;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html (defconst term-control-seq-regexp diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f98730ed22..e2d0ca69a2 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -26,7 +26,7 @@ ;;; Commentary: -;; See concerning bzr. +;; See concerning bzr. ;; This library provides bzr support in VC. diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index e108b3a340..06dd09490d 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -51,8 +51,8 @@ :group 'vc-svn) ;; Might be nice if svn defaulted to non-interactive if stdin not tty. -;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml -;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml +;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml +;; https://svn.haxx.se/dev/archive-2009-04/0094.shtml ;; Maybe newer ones do? (defcustom vc-svn-global-switches (unless (eq system-type 'darwin) ; bug#13513 '("--non-interactive")) diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in index be1a84faa6..42a4656f9d 100644 --- a/msdos/autogen/Makefile.in +++ b/msdos/autogen/Makefile.in @@ -26,7 +26,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see . +# along with this file. If not, see . # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that @@ -49,7 +49,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see . +# along with this file. If not, see . # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in index 6101abd1fa..6475d99d6f 100644 --- a/msdos/autogen/config.in +++ b/msdos/autogen/config.in @@ -18,7 +18,7 @@ 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 GNU Emacs. If not, see . */ +along with GNU Emacs. If not, see . */ /* No code in Emacs #includes config.h twice, but some bits of code diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index c3d4dfa4c2..0a0e0330a2 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -22,7 +22,7 @@ MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit Windows -- it's located at http://mingw-w64.org/. MSYS2 is a Cygwin-derived software distribution for Windows which provides -build tools for MinGW-w64 -- see http://msys2.github.io/. +build tools for MinGW-w64 -- see https://msys2.github.io/. ** Download and install MinGW-w64 and MSYS2 diff --git a/src/nsxwidget.h b/src/nsxwidget.h index 3d91594c34..dcdb26cb34 100644 --- a/src/nsxwidget.h +++ b/src/nsxwidget.h @@ -15,7 +15,7 @@ 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 GNU Emacs. If not, see . */ +along with GNU Emacs. If not, see . */ #ifndef NSXWIDGET_H_INCLUDED #define NSXWIDGET_H_INCLUDED diff --git a/src/nsxwidget.m b/src/nsxwidget.m index 3c6402c03f..dbd4cb29a6 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/w32heap.c b/src/w32heap.c index ba3550b6e9..a72bed62ca 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -191,7 +191,7 @@ free_fn the_free_fn; /* It doesn't seem to be useful to allocate from a file mapping. It would be if the memory was shared. - http://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ + https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ /* This is the function to commit memory when the heap allocator claims for new memory. Before dumping with unexec, we allocate @@ -246,7 +246,7 @@ init_heap (bool use_dynamic_heap) environment before starting GDB to get low fragmentation heap on XP and older systems, for the price of losing "certain heap debug options"; for the details see - http://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ + https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ data_region_end = data_region_base; /* Create the private heap. */ diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el index 4869d162fb..5a5e66594f 100644 --- a/test/lisp/gnus/gnus-util-tests.el +++ b/test/lisp/gnus/gnus-util-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 3da620d64e..d85516179f 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index 8267d8e4f6..ddf22ecd40 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -44,7 +44,7 @@ sinl [sin] (3) - sine function" sin(3), sinf(3), sinl(3) - sine functions" . (#("sin(3)" 0 6 (help-echo "sine functions")) #("sinf(3)" 0 7 (help-echo "sine functions")) #("sinl(3)" 0 7 (help-echo "sine functions")))) ;; SunOS, Solaris - ;; http://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html + ;; https://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html ;; SunOS 4 ("\ tset, reset (1) - establish or restore terminal characteristics" @@ -61,7 +61,7 @@ cawf, nroff (1) - C version of the nroff-like, Amazingly Workable (text) Formatt whatis (5) - database of online manual pages" . (#("cawf(1)" 0 7 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("nroff(1)" 0 8 (help-echo "C version of the nroff-like, Amazingly Workable (text) Formatter")) #("whatis(5)" 0 9 (help-echo "database of online manual pages")))) ;; HP-UX - ;; http://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html + ;; https://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html ;; Assuming that the line break in the zgrep description was ;; introduced by the man page formatting. ("\ diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index bc77443ff4..64626333c4 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -204,7 +204,7 @@ aliqua." ;;; Indentation -;; See: http://www.python.org/dev/peps/pep-0008/#indentation +;; See: https://www.python.org/dev/peps/pep-0008/#indentation (ert-deftest python-indent-pep8-1 () "First pep8 case." diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index 6b7d10dea3..9592803039 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -343,7 +343,7 @@ def bar tee .qux) -# http://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation +# https://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation tee = if foo bar else diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el index c12722fca1..56bd54efb7 100644 --- a/test/lisp/textmodes/bibtex-tests.el +++ b/test/lisp/textmodes/bibtex-tests.el @@ -17,7 +17,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index d922e98348..bd26f7979d 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -37,7 +37,7 @@ ;; commands (eg `bzr status') want to access ~/.bazaar, and will ;; abort if they cannot. I could not figure out how to stop bzr ;; doing that, so just give it a temporary homedir for the duration. - ;; http://bugs.launchpad.net/bzr/+bug/137407 ? + ;; https://bugs.launchpad.net/bzr/+bug/137407 ? ;; ;; Note that with bzr 2.x, this works: ;; mkdir /tmp/bzr commit 10e7c76ee3e263a7691745d9384bae475c2f5c86 Author: João Távora Date: Sun Oct 4 19:31:02 2020 +0100 Rework semantics of eldoc-echo-are-use-multiline-p Per bug#43543. Now uses logical lines, not visual lines. * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-use-multiline-p): Rework semantics. (eldoc--echo-area-substring): New helper. (eldoc--echo-area-prefer-doc-buffer-p): New helper. (eldoc-display-in-echo-area): Rework using new helpers. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index bad9eabe64..922de18743 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -96,19 +96,22 @@ Note that this variable has no effect, unless If value is t, never attempt to truncate messages, even if the echo area must be resized to fit. -If value is a number (integer or floating point), it has the -semantics of `max-mini-window-height', constraining the resizing -for ElDoc purposes only. +If the value is a positive number, it is used to calculate a +number of logical lines of documentation that ElDoc is allowed to +put in the echo area. If a positive integer, the number is used +directly, while a float specifies the number of lines as a +proporting of the echo area frame's height. -Any resizing respects `max-mini-window-height'. - -If value is any non-nil symbol other than t, the part of the doc -string that represents the symbol's name may be truncated if it -will enable the rest of the doc string to fit on a single line, -without resizing the echo area. +If value is the symbol `truncate-sym-name-if-fit' t, the part of +the doc string that represents a symbol's name may be truncated +if it will enable the rest of the doc string to fit on a single +line, without resizing the echo area. If value is nil, a doc string is always truncated to fit in a -single line of display in the echo area." +single line of display in the echo area. + +Any resizing of the echo area additionally respects +`max-mini-window-height'." :type '(radio (const :tag "Always" t) (float :tag "Fraction of frame height" 0.25) (integer :tag "Number of lines" 5) @@ -489,6 +492,41 @@ This holds the results of the last documentation request." "*eldoc*"))))) eldoc--doc-buffer) +(defun eldoc--echo-area-substring (available) + "Given AVAILABLE lines, get buffer substring to display in echo area. +Helper for `eldoc-display-in-echo-area'." + (let ((start (prog1 (progn + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (point)) + (goto-char (line-end-position available)) + (skip-chars-backward " \t\n"))) + (truncated (save-excursion + (skip-chars-forward " \t\n") + (not (eobp))))) + (cond ((eldoc--echo-area-prefer-doc-buffer-p truncated) + nil) + ((and truncated + (> available 1) + eldoc-echo-area-display-truncation-message) + (goto-char (line-end-position 0)) + (concat (buffer-substring start (point)) + (format + "\n(Documentation truncated. Use `%s' to see rest)" + (substitute-command-keys "\\[eldoc-doc-buffer]")))) + (t + (buffer-substring start (point)))))) + +(defun eldoc--echo-area-prefer-doc-buffer-p (truncatedp) + "Tell if display in the echo area should be skipped. +Helper for `eldoc-display-in-echo-area'. If TRUNCATEDP the +documentation to potentially appear in the echo are is truncated." + (and (or (eq eldoc-echo-area-prefer-doc-buffer t) + (and truncatedp + (eq eldoc-echo-area-prefer-doc-buffer + 'maybe))) + (get-buffer-window eldoc--doc-buffer))) + (defun eldoc-display-in-echo-area (docs _interactive) "Display DOCS in echo area. Honor `eldoc-echo-area-use-multiline-p' and @@ -517,20 +555,13 @@ Honor `eldoc-echo-area-use-multiline-p' and (available (cl-typecase val (float (truncate (* (frame-height) val))) (integer val) - (t 1))) - single-doc single-doc-sym - (prefer-doc-buffer-p - (lambda (truncated) - (and (or (eq eldoc-echo-area-prefer-doc-buffer t) - (and truncated - (eq eldoc-echo-area-prefer-doc-buffer - 'maybe))) - (get-buffer-window eldoc--doc-buffer))))) + (t 'just-one-line))) + single-doc single-doc-sym) (let ((echo-area-message (cond - (;; To output to the echo area,We handle the + (;; To output to the echo area, we handle the ;; `truncate-sym-name-if-fit' special case first, by - ;; checking if for a lot of special conditions. + ;; checking for a lot of special conditions. (and (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p) (null (cdr docs)) @@ -541,49 +572,22 @@ Honor `eldoc-echo-area-use-multiline-p' and (not (string-match "\n" single-doc)) (> (+ (length single-doc) (length single-doc-sym) 2) width)) single-doc) - ((> available 1) - ;; The message takes one extra line, so if we don't - ;; display that, we have one extra line to use. - (unless eldoc-echo-area-display-truncation-message - (setq available (1+ available))) - ;; Else we format the *eldoc* buffer, then use some of - ;; its contents top section. I'm pretty sure smarter - ;; strategies can be used here that don't necessarily - ;; involve composing that entire buffer. + ((and (numberp available) + (cl-plusp available)) + ;; Else, given a positive number of logical lines, we + ;; format the *eldoc* buffer, using as most of its + ;; contents as we know will fit. (with-current-buffer (eldoc--format-doc-buffer docs) - (cl-loop - initially - (goto-char (point-min)) - (goto-char (line-end-position (1+ available))) - for truncated = nil then t - for needed - = (let ((truncate-lines message-truncate-lines)) - (count-screen-lines (point-min) (point) t - (minibuffer-window))) - while (> needed (if truncated (1- available) available)) - do (goto-char (line-end-position (if truncated 0 -1))) - (while (and (not (bobp)) (bolp)) (goto-char (line-end-position 0))) - finally - (unless (funcall prefer-doc-buffer-p truncated) - (cl-return - (concat - (buffer-substring (point-min) (point)) - (and - truncated - (if eldoc-echo-area-display-truncation-message - (format - "\n(Documentation truncated. Use `%s' to see rest)" - (substitute-command-keys "\\[eldoc-doc-buffer]")) - "...")))))))) - ((= available 1) + (eldoc--echo-area-substring available))) + (t ;; this is the "truncate brutally" situation (let ((string (with-current-buffer (eldoc--format-doc-buffer docs) (buffer-substring (goto-char (point-min)) (line-end-position 1))))) (if (> (length string) width) ; truncation to happen - (unless (funcall prefer-doc-buffer-p t) + (unless (eldoc--echo-area-prefer-doc-buffer-p t) (truncate-string-to-width string width)) - (unless (funcall prefer-doc-buffer-p nil) + (unless (eldoc--echo-area-prefer-doc-buffer-p nil) string))))))) (when echo-area-message (eldoc--message echo-area-message))))))) commit 77c39284259fe7a6bd6935bbe78a799dd9191c43 Author: João Távora Date: Sun Oct 4 12:19:47 2020 +0100 Rename ElDoc user option controlling display of truncation notice The new name makes it consistent with other variables controlling the display of ElDoc documentation in the echo area. Per bug#43543. * etc/NEWS (Eldoc): Rename eldoc-display-truncation-message to eldoc-echo-area-display-truncation-message. * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-display-truncation-message): Rename from eldoc-display-truncation-message. (eldoc-display-in-echo-area): Use new variable name. diff --git a/etc/NEWS b/etc/NEWS index 8aa27fd651..7dbd3d51fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -636,7 +636,7 @@ definition. ** ElDoc +++ -*** New user option 'eldoc-display-truncation-message'. +*** New user option 'eldoc-echo-area-display-truncation-message'. If non-nil (the default), eldoc will display a message saying something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' to see rest)" when a message has been truncated. If nil, truncated diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 6c6570f847..bad9eabe64 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -67,7 +67,7 @@ If this variable is set to 0, no idle time is required." Changing the value requires toggling `eldoc-mode'." :type 'boolean) -(defcustom eldoc-display-truncation-message t +(defcustom eldoc-echo-area-display-truncation-message t "If non-nil, provide verbose help when a message has been truncated. If nil, truncated messages will just have \"...\" appended." :type 'boolean @@ -544,7 +544,7 @@ Honor `eldoc-echo-area-use-multiline-p' and ((> available 1) ;; The message takes one extra line, so if we don't ;; display that, we have one extra line to use. - (unless eldoc-display-truncation-message + (unless eldoc-echo-area-display-truncation-message (setq available (1+ available))) ;; Else we format the *eldoc* buffer, then use some of ;; its contents top section. I'm pretty sure smarter @@ -570,7 +570,7 @@ Honor `eldoc-echo-area-use-multiline-p' and (buffer-substring (point-min) (point)) (and truncated - (if eldoc-display-truncation-message + (if eldoc-echo-area-display-truncation-message (format "\n(Documentation truncated. Use `%s' to see rest)" (substitute-command-keys "\\[eldoc-doc-buffer]")) commit 5daa6a6a0398131717c5b5fd570c5efad34a4afa Author: João Távora Date: Sat Oct 3 17:27:05 2020 +0100 Rework eldoc-echo-area-prefer-doc-buffer (bug#42532) * lisp/emacs-lisp/eldoc.el: (eldoc-echo-area-prefer-doc-buffer): Rename from eldoc-echo-area-prefer-doc-buffer (eldoc-display-in-echo-area): Rework to honour eldoc-echo-area-prefer-doc-buffer. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 1b180f26c5..6c6570f847 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -117,12 +117,13 @@ single line of display in the echo area." symbol names if it will\ enable argument list to fit on one line" truncate-sym-name-if-fit))) -(defcustom eldoc-prefer-doc-buffer nil +(defcustom eldoc-echo-area-prefer-doc-buffer nil "Prefer ElDoc's documentation buffer if it is showing in some frame. -If this variable's value is t and a piece of documentation needs -to be truncated to fit in the echo area, do so if ElDoc's -documentation buffer is not already showing, since the buffer -always holds the full documentation." +If this variable's value is t, ElDoc will skip showing +documentation in the echo area if the dedicated documentation +buffer (given by `eldoc-doc-buffer') is being displayed in some +window. If the value is the symbol `maybe', then the echo area +is only skipped if the documentation doesn't fit there." :type 'boolean) (defface eldoc-highlight-function-argument @@ -491,7 +492,7 @@ This holds the results of the last documentation request." (defun eldoc-display-in-echo-area (docs _interactive) "Display DOCS in echo area. Honor `eldoc-echo-area-use-multiline-p' and -`eldoc-prefer-doc-buffer'." +`eldoc-echo-area-prefer-doc-buffer'." (cond (;; Check if he wave permission to mess with echo area at all. For ;; example, if this-command is non-nil while running via an idle @@ -517,7 +518,14 @@ Honor `eldoc-echo-area-use-multiline-p' and (float (truncate (* (frame-height) val))) (integer val) (t 1))) - single-doc single-doc-sym) + single-doc single-doc-sym + (prefer-doc-buffer-p + (lambda (truncated) + (and (or (eq eldoc-echo-area-prefer-doc-buffer t) + (and truncated + (eq eldoc-echo-area-prefer-doc-buffer + 'maybe))) + (get-buffer-window eldoc--doc-buffer))))) (let ((echo-area-message (cond (;; To output to the echo area,We handle the @@ -556,9 +564,7 @@ Honor `eldoc-echo-area-use-multiline-p' and do (goto-char (line-end-position (if truncated 0 -1))) (while (and (not (bobp)) (bolp)) (goto-char (line-end-position 0))) finally - (unless (and truncated - eldoc-prefer-doc-buffer - (get-buffer-window eldoc--doc-buffer)) + (unless (funcall prefer-doc-buffer-p truncated) (cl-return (concat (buffer-substring (point-min) (point)) @@ -570,10 +576,15 @@ Honor `eldoc-echo-area-use-multiline-p' and (substitute-command-keys "\\[eldoc-doc-buffer]")) "...")))))))) ((= available 1) - ;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer' too? - (with-current-buffer (eldoc--format-doc-buffer docs) - (truncate-string-to-width - (buffer-substring (goto-char (point-min)) (line-end-position 1)) width)))))) + (let ((string + (with-current-buffer (eldoc--format-doc-buffer docs) + (buffer-substring (goto-char (point-min)) + (line-end-position 1))))) + (if (> (length string) width) ; truncation to happen + (unless (funcall prefer-doc-buffer-p t) + (truncate-string-to-width string width)) + (unless (funcall prefer-doc-buffer-p nil) + string))))))) (when echo-area-message (eldoc--message echo-area-message))))))) commit 4c543a724f2caff41d97a323bd4fffe3e86e8471 Author: João Távora Date: Sun Sep 6 15:37:02 2020 +0100 Introduce eldoc-display-functions See bug#43609. * lisp/emacs-lisp/eldoc.el (eldoc--request-state): Add comment. (eldoc--last-request-state): No longer buffer-local. (eldoc--request-docs-p): Delete. (eldoc-display-functions): New user variable. (eldoc--doc-buffer-docs): New variable. (eldoc-display-message-p): Rework. (eldoc--format-doc-buffer): Rework from eldoc--handle-docs. (eldoc-display-in-echo-area, eldoc-display-in-buffer): New user-visible function. (eldoc--invoke-strategy): Take INTERACTIVE arg. Invoke eldoc-display-in-buffer (eldoc-print-current-symbol-info): Simplify. (Version): Bump to 1.11.0 * etc/NEWS: Mention eldoc-display-functions. diff --git a/etc/NEWS b/etc/NEWS index a405c0dd3d..8aa27fd651 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -650,6 +650,13 @@ may arrange for it to be produced asynchronously. The results of all doc string functions are accessible to the user through the user option 'eldoc-documentation-strategy'. +*** New hook 'eldoc-display-functions'. +This hook is intended to be used for displaying doc string. The +functions receive the docstrings composed according to +`eldoc-documentation-strategy' and are tasked with displaying it to +the user. Examples of such functions would use the echo area, a +separate buffer or a tooltip. + +++ *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 9e38e5908e..1b180f26c5 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,7 +5,7 @@ ;; Author: Noah Friedman ;; Keywords: extensions ;; Created: 1995-10-06 -;; Version: 1.10.0 +;; Version: 1.11.0 ;; Package-Requires: ((emacs "26.3")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -350,40 +350,26 @@ Also store it in `eldoc-last-message' and return that value." ;; for us, but do note that the last-message will be gone. (setq eldoc-last-message nil)))) -(defvar-local eldoc--last-request-state nil +;; The point of `eldoc--request-state' is not to over-request, which +;; can happen if the idle timer is restarted on execution of command +;; which is guaranteed not to change the conditions that warrant a new +;; request for documentation. +(defvar eldoc--last-request-state nil "Tuple containing information about last ElDoc request.") (defun eldoc--request-state () "Compute information to store in `eldoc--last-request-state'." (list (current-buffer) (buffer-modified-tick) (point))) (defun eldoc-display-message-p () - (eldoc--request-docs-p (eldoc--request-state))) + "Tell if ElDoc can use the echo area." + (and (eldoc-display-message-no-interference-p) + (not this-command) + (eldoc--message-command-p last-command))) + (make-obsolete 'eldoc-display-message-p "Use `eldoc-documentation-functions' instead." "eldoc-1.6.0") -(defun eldoc--request-docs-p (request-state) - "Return non-nil when it is appropriate to request docs. -REQUEST-STATE is a candidate for `eldoc--last-request-state'" - (and - ;; FIXME: The original idea behind this function is to protect the - ;; Echo area from ElDoc interference, but since that is only one of - ;; the possible outlets of ElDoc, this must soon be reworked. - (eldoc-display-message-no-interference-p) - (not (and eldoc--doc-buffer - (get-buffer-window eldoc--doc-buffer) - (equal request-state - (with-current-buffer - eldoc--doc-buffer - eldoc--last-request-state)))) - ;; If this-command is non-nil while running via an idle - ;; timer, we're still in the middle of executing a command, - ;; e.g. a query-replace where it would be annoying to - ;; overwrite the echo area. - (not this-command) - (eldoc--message-command-p last-command))) - - ;; Check various conditions about the current environment that might make ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () @@ -416,43 +402,112 @@ about the context around point. To call the CALLBACK function, the hook function must pass it an obligatory argument DOCSTRING, a string containing the -documentation, followed by an optional list of keyword-value -pairs of the form (:KEY VALUE :KEY2 VALUE2...). KEY can be: - -* `:thing', VALUE is a short string or symbol designating what is - being reported on. The documentation display engine can elect - to remove this information depending on space constraints; - -* `:face', VALUE is a symbol designating a face to use when - displaying `:thing''s value. - -Major modes should modify this hook locally, for example: +documentation, followed by an optional list of arbitrary +keyword-value pairs of the form (:KEY VALUE :KEY2 VALUE2...). +The information contained in these pairs is understood by members +of `eldoc-display-functions', allowing the +documentation-producing backend to cooperate with specific +documentation-displaying frontends. For example, KEY can be: + +* `:thing', VALUE being a short string or symbol designating what + is being reported on. It can, for example be the name of the + function whose signature is being documented, or the name of + the variable whose docstring is being documented. + `eldoc-display-in-echo-area', a member of + `eldoc-display-functions', sometimes omits this information + depending on space constraints; + +* `:face', VALUE being a symbol designating a face which both + `eldoc-display-in-echo-area' and `eldoc-display-in-buffer' will + use when displaying `:thing''s value. + +Finally, major modes should modify this hook locally, for +example: (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t) so that the global value (i.e. the default value of the hook) is taken into account if the major mode specific function does not return any documentation.") +(defvar eldoc-display-functions + '(eldoc-display-in-echo-area eldoc-display-in-buffer) + "Hook of functions tasked with displaying ElDoc results. +Each function is passed two arguments: DOCS and INTERACTIVE. DOCS +is a list (DOC ...) where DOC looks like (STRING :KEY VALUE :KEY2 +VALUE2 ...). STRING is a string containing the documentation's +text and the remainder of DOC is an optional list of +keyword-value pairs denoting additional properties of that +documentation. For commonly recognized properties, see +`eldoc-documentation-functions'. + +INTERACTIVE says if the request to display doc strings came +directly from the user or from ElDoc's automatic mechanisms'.") + (defvar eldoc--doc-buffer nil "Buffer displaying latest ElDoc-produced docs.") +(defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.") + (defun eldoc-doc-buffer (&optional interactive) - "Get latest *eldoc* help buffer. Interactively, display it." (interactive (list t)) - (prog1 - (if (and eldoc--doc-buffer (buffer-live-p eldoc--doc-buffer)) - eldoc--doc-buffer - (setq eldoc--doc-buffer (get-buffer-create "*eldoc*"))) - (when interactive (display-buffer eldoc--doc-buffer)))) - - -(defun eldoc--handle-docs (docs) - "Display multiple DOCS in echo area. -DOCS is a list of (STRING PLIST...). It is already sorted. -Honor most of `eldoc-echo-area-use-multiline-p'." - ;; If there's nothing to report clear the echo area, but don't erase - ;; the last *eldoc* buffer. - (if (null docs) (eldoc--message nil) + "Display ElDoc documentation buffer. +This holds the results of the last documentation request." + (unless (buffer-live-p eldoc--doc-buffer) + (setq eldoc--doc-buffer (get-buffer-create "*eldoc*"))) + (when interactive + (display-buffer eldoc--doc-buffer))) + +(defun eldoc--format-doc-buffer (docs) + "Ensure DOCS are displayed in an *eldoc* buffer." + (interactive (list t)) + (eldoc-doc-buffer) ;; ensure buffer exists + (with-current-buffer eldoc--doc-buffer + (unless (eq docs eldoc--doc-buffer-docs) + (setq-local eldoc--doc-buffer-docs docs) + (let ((inhibit-read-only t) + (things-reported-on)) + (erase-buffer) (setq buffer-read-only t) + (local-set-key "q" 'quit-window) + (cl-loop for (docs . rest) on docs + for (this-doc . plist) = docs + for thing = (plist-get plist :thing) + when thing do + (cl-pushnew thing things-reported-on) + (setq this-doc + (concat + (propertize (format "%s" thing) + 'face (plist-get plist :face)) + ": " + this-doc)) + do (insert this-doc) + when rest do (insert "\n")) + ;; Maybe rename the buffer. + (rename-buffer (if things-reported-on + (format "*eldoc for %s*" + (mapconcat (lambda (s) (format "%s" s)) + things-reported-on + ", ")) + "*eldoc*"))))) + eldoc--doc-buffer) + +(defun eldoc-display-in-echo-area (docs _interactive) + "Display DOCS in echo area. +Honor `eldoc-echo-area-use-multiline-p' and +`eldoc-prefer-doc-buffer'." + (cond + (;; Check if he wave permission to mess with echo area at all. For + ;; example, if this-command is non-nil while running via an idle + ;; timer, we're still in the middle of executing a command, e.g. a + ;; query-replace where it would be annoying to overwrite the echo + ;; area. + (or + (not (eldoc-display-message-no-interference-p)) + this-command + (not (eldoc--message-command-p last-command)))) + (;; If we do but nothing to report, clear the echo area. + (null docs) + (eldoc--message nil)) + (t + ;; Otherwise, establish some parameters. (let* - ;; Otherwise, establish some parameters. ((width (1- (window-width (minibuffer-window)))) (val (if (and (symbolp eldoc-echo-area-use-multiline-p) eldoc-echo-area-use-multiline-p) @@ -462,43 +517,12 @@ Honor most of `eldoc-echo-area-use-multiline-p'." (float (truncate (* (frame-height) val))) (integer val) (t 1))) - (things-reported-on) - (request eldoc--last-request-state) single-doc single-doc-sym) - ;; Then, compose the contents of the `*eldoc*' buffer. - (with-current-buffer (eldoc-doc-buffer) - ;; Set doc-buffer's `eldoc--last-request-state', too - (setq eldoc--last-request-state request) - (let ((inhibit-read-only t)) - (erase-buffer) (setq buffer-read-only t) - (local-set-key "q" 'quit-window) - (cl-loop for (docs . rest) on docs - for (this-doc . plist) = docs - for thing = (plist-get plist :thing) - when thing do - (cl-pushnew thing things-reported-on) - (setq this-doc - (concat - (propertize (format "%s" thing) - 'face (plist-get plist :face)) - ": " - this-doc)) - do (insert this-doc) - when rest do (insert "\n"))) - ;; Rename the buffer. - (when things-reported-on - (rename-buffer (format "*eldoc for %s*" - (mapconcat (lambda (s) (format "%s" s)) - things-reported-on - ", "))))) - ;; Finally, output to the echo area. I'm pretty sure nicer - ;; strategies can be used here, probably by splitting this - ;; function into some `eldoc-display-functions' special hook. (let ((echo-area-message (cond - (;; We handle the `truncate-sym-name-if-fit' special - ;; case first, by checking if for a lot of special - ;; conditions. + (;; To output to the echo area,We handle the + ;; `truncate-sym-name-if-fit' special case first, by + ;; checking if for a lot of special conditions. (and (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p) (null (cdr docs)) @@ -514,7 +538,11 @@ Honor most of `eldoc-echo-area-use-multiline-p'." ;; display that, we have one extra line to use. (unless eldoc-display-truncation-message (setq available (1+ available))) - (with-current-buffer (eldoc-doc-buffer) + ;; Else we format the *eldoc* buffer, then use some of + ;; its contents top section. I'm pretty sure smarter + ;; strategies can be used here that don't necessarily + ;; involve composing that entire buffer. + (with-current-buffer (eldoc--format-doc-buffer docs) (cl-loop initially (goto-char (point-min)) @@ -543,11 +571,18 @@ Honor most of `eldoc-echo-area-use-multiline-p'." "...")))))))) ((= available 1) ;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer' too? - (with-current-buffer (eldoc-doc-buffer) + (with-current-buffer (eldoc--format-doc-buffer docs) (truncate-string-to-width (buffer-substring (goto-char (point-min)) (line-end-position 1)) width)))))) (when echo-area-message - (eldoc--message echo-area-message)))))) + (eldoc--message echo-area-message))))))) + +(defun eldoc-display-in-buffer (docs interactive) + "Display DOCS in a dedicated buffer. +If INTERACTIVE is t, also display the buffer." + (let ((buf (eldoc--format-doc-buffer docs))) + (when interactive + (display-buffer buf)))) (defun eldoc-documentation-default () "Show first doc string for item at point. @@ -709,19 +744,29 @@ have the following values: strings so far, as soon as possible." (funcall eldoc--make-callback method)) -(defun eldoc--invoke-strategy () +(defun eldoc--invoke-strategy (interactive) "Invoke `eldoc-documentation-strategy' function. +If INTERACTIVE is non-nil, the request came directly from a user +command, otherwise it came from ElDoc's idle +timer, `eldoc-timer'. + That function's job is to run the `eldoc-documentation-functions' special hook, using the `run-hook' family of functions. ElDoc's built-in strategy functions play along with the -`eldoc--make-callback' protocol, using it to produce callback to -feed to the functgions of `eldoc-documentation-functions'. - -Other third-party strategy functions do not use -`eldoc--make-callback'. They must find some alternate way to -produce callbacks to feed to `eldoc-documentation-function' and -should endeavour to display the docstrings eventually produced." +`eldoc--make-callback' protocol, using it to produce a callback +argument to feed the functions that the user places in +`eldoc-documentation-functions'. Whenever the strategy +determines it has information to display to the user, this +function passes responsibility to the functions in +`eldoc-display-functions'. + +Other third-party values of `eldoc-documentation-strategy' should +not use `eldoc--make-callback'. They must find some alternate +way to produce callbacks to feed to +`eldoc-documentation-function' and should endeavour to display +the docstrings eventually produced, using +`eldoc-display-functions'." (let* (;; How many callbacks have been created by the strategy ;; function and passed to elements of ;; `eldoc-documentation-functions'. @@ -739,11 +784,12 @@ should endeavour to display the docstrings eventually produced." (push (cons pos (cons string plist)) docs-registered))) (display-doc () - (eldoc--handle-docs - (mapcar #'cdr - (setq docs-registered - (sort docs-registered - (lambda (a b) (< (car a) (car b)))))))) + (run-hook-with-args + 'eldoc-display-functions (mapcar #'cdr + (setq docs-registered + (sort docs-registered + (lambda (a b) (< (car a) (car b)))))) + interactive)) (make-callback (method) (let ((pos (prog1 howmany (cl-incf howmany)))) @@ -786,22 +832,23 @@ should endeavour to display the docstrings eventually produced." (defun eldoc-print-current-symbol-info (&optional interactive) "Document thing at point." (interactive '(t)) - (let ((token (eldoc--request-state))) + (let (token) (cond (interactive - (eldoc--invoke-strategy)) - ((not (eldoc--request-docs-p token)) - ;; Erase the last message if we won't display a new one. - (when eldoc-last-message - (eldoc--message nil))) - (t + (eldoc--invoke-strategy t)) + ((not (equal (setq token (eldoc--request-state)) + eldoc--last-request-state)) (let ((non-essential t)) (setq eldoc--last-request-state token) ;; Only keep looking for the info as long as the user hasn't ;; requested our attention. This also locally disables ;; inhibit-quit. (while-no-input - (eldoc--invoke-strategy))))))) + (eldoc--invoke-strategy nil))))))) + +;; This section only affects ElDoc output to the echo area, as in +;; `eldoc-display-in-echo-area'. +;; ;; When point is in a sexp, the function args are not reprinted in the echo ;; area after every possible interactive command because some of them print ;; their own messages in the echo area; the eldoc functions would instantly @@ -833,7 +880,6 @@ should endeavour to display the docstrings eventually produced." (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) - ;; Prime the command list. (eldoc-add-command-completions "back-to-indentation" commit 8c2382d309b437dca94d453e4bd5f3169bb36bfb Author: Basil L. Contovounesios Date: Sat Oct 24 15:50:16 2020 +0100 ; Fix last change diff --git a/lisp/time.el b/lisp/time.el index 519c96242d..eca9a0752e 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -585,7 +585,7 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. "Cancel the world clock timer." (when world-clock--timer (cancel-timer world-clock--timer) - (setq world-clock--timer nil)))) + (setq world-clock--timer nil))) (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." commit 97267d2bf1fbb9279d32f75eda9dbcf0c4316edd Author: Stefan Kangas Date: Sat Oct 24 15:47:26 2020 +0200 Re-introduce variable for world clock timer * lisp/time.el (world-clock--timer): New variable. (world-clock): Save timer to above variable when it is started. (world-clock-cancel-timer): Delete timer saved in variable instead of searching for the function name. diff --git a/lisp/time.el b/lisp/time.el index 63773d4204..519c96242d 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -531,6 +531,9 @@ See `world-clock'." (setq-local revert-buffer-function #'world-clock-update) (setq show-trailing-whitespace nil)) +(defvar world-clock--timer nil + "The current world clock timer.") + (defun world-clock-display (alist) "Replace current buffer text with times in various zones, based on ALIST." (let ((inhibit-read-only t) @@ -571,7 +574,8 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (pop-to-buffer buffer) (pop-to-buffer world-clock-buffer-name) (when world-clock-timer-enable - (run-at-time t world-clock-timer-second #'world-clock-update) + (setq world-clock--timer + (run-at-time t world-clock-timer-second #'world-clock-update)) (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t))) (world-clock-display (time--display-world-list)) (world-clock-mode) @@ -579,12 +583,9 @@ To turn off the world time display, go to the window and type `\\[quit-window]'. (defun world-clock-cancel-timer () "Cancel the world clock timer." - (let ((list timer-list)) - (while list - (let ((elt (pop list))) - (when (equal (symbol-name (timer--function elt)) - "world-clock-update") - (cancel-timer elt)))))) + (when world-clock--timer + (cancel-timer world-clock--timer) + (setq world-clock--timer nil)))) (defun world-clock-update (&optional _arg _noconfirm) "Update the `world-clock' buffer." commit 6f92674ce81b39a44a0d841a5176884e0321b508 Author: Stefan Kangas Date: Sat Oct 24 15:34:52 2020 +0200 Use lexical-binding in several language support libraries * lisp/language/burmese.el: * lisp/language/cham.el: * lisp/language/czech.el: * lisp/language/georgian.el: * lisp/language/greek.el: * lisp/language/khmer.el: * lisp/language/romanian.el: * lisp/language/sinhala.el: * lisp/language/slovak.el: * lisp/language/tai-viet.el: * lisp/language/vietnamese.el: Use lexical-binding. diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 1888c8f86a..d689e87d78 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -1,4 +1,4 @@ -;;; burmese.el --- support for Burmese -*- coding: utf-8 -*- +;;; burmese.el --- support for Burmese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/cham.el b/lisp/language/cham.el index 4749f2e8db..eef6d6f8f9 100644 --- a/lisp/language/cham.el +++ b/lisp/language/cham.el @@ -1,4 +1,4 @@ -;;; cham.el --- support for Cham -*- coding: utf-8 -*- +;;; cham.el --- support for Cham -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011, 2012 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/czech.el b/lisp/language/czech.el index b3cc152d25..e6923426b5 100644 --- a/lisp/language/czech.el +++ b/lisp/language/czech.el @@ -1,4 +1,4 @@ -;;; czech.el --- support for Czech -*- coding: utf-8 -*- +;;; czech.el --- support for Czech -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el index 3e3c1df31a..53c994bd76 100644 --- a/lisp/language/georgian.el +++ b/lisp/language/georgian.el @@ -1,4 +1,4 @@ -;;; georgian.el --- language support for Georgian +;;; georgian.el --- language support for Georgian -*- lexical-binding: t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/greek.el b/lisp/language/greek.el index 2fec52637b..15ae5f42f9 100644 --- a/lisp/language/greek.el +++ b/lisp/language/greek.el @@ -1,4 +1,4 @@ -;;; greek.el --- support for Greek +;;; greek.el --- support for Greek -*- lexical-binding: t -*- ;; Copyright (C) 2002, 2013-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el index 4a07032196..37173c9fb9 100644 --- a/lisp/language/khmer.el +++ b/lisp/language/khmer.el @@ -1,4 +1,4 @@ -;;; khmer.el --- support for Khmer -*- coding: utf-8 -*- +;;; khmer.el --- support for Khmer -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el index 0cd1d61de0..9f1c67765e 100644 --- a/lisp/language/romanian.el +++ b/lisp/language/romanian.el @@ -1,4 +1,4 @@ -;;; romanian.el --- support for Romanian -*- coding: utf-8 -*- +;;; romanian.el --- support for Romanian -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el index efd8aacc5a..90fc41c1c4 100644 --- a/lisp/language/sinhala.el +++ b/lisp/language/sinhala.el @@ -1,4 +1,4 @@ -;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*- +;;; sinhala.el --- support for Sinhala -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el index bc70a05ad0..c42a872574 100644 --- a/lisp/language/slovak.el +++ b/lisp/language/slovak.el @@ -1,4 +1,4 @@ -;;; slovak.el --- support for Slovak -*- coding: utf-8 -*- +;;; slovak.el --- support for Slovak -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index 22295f39e5..039e478b16 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -1,4 +1,4 @@ -;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*- +;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2007-2020 Free Software Foundation, Inc. ;; Copyright (C) 2007, 2008, 2009, 2010, 2011 diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el index cb282db076..c1cef96286 100644 --- a/lisp/language/vietnamese.el +++ b/lisp/language/vietnamese.el @@ -1,4 +1,4 @@ -;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; -*- +;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, commit 95553309efcdbf219dc0682383172d55c65d2277 Author: Michael Albinus Date: Sat Oct 24 14:36:34 2020 +0200 Accept nil COMMAND in tramp-sh-handle-make-process (Bug#44151) * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Accept nil COMMAND. (Bug#44151) * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process): Extend test. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c7c6dae75..e65d376eff 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2809,7 +2809,7 @@ implementation will be used." (signal 'wrong-type-argument (list #'stringp name))) (unless (or (null buffer) (bufferp buffer) (stringp buffer)) (signal 'wrong-type-argument (list #'stringp buffer))) - (unless (consp command) + (unless (or (null command) (consp command)) (signal 'wrong-type-argument (list #'consp command))) (unless (or (null coding) (and (symbolp coding) (memq coding coding-system-list)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c894f7ddaa..02bd6138d5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4366,6 +4366,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (accept-process-output proc 0 nil t)))) (should (string-match "foo" (buffer-string)))) + ;; Cleanup. + (ignore-errors (delete-process proc))) + + ;; PTY. + (unwind-protect + (with-temp-buffer + ;; It works only for tramp-sh.el, and not direct async processes. + (if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p)) + (should-error + (start-file-process "test4" (current-buffer) nil) + :type 'wrong-type-argument) + (setq proc (start-file-process "test4" (current-buffer) nil)) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (should (stringp (process-tty-name proc))))) + ;; Cleanup. (ignore-errors (delete-process proc)))))) commit 6dfcb4d4dc3b7852143d8f7d9919ab0426476591 Author: Stefan Kangas Date: Sat Oct 24 14:22:58 2020 +0200 Revert "Use lexical-binding in bindat.el" This reverts commit a497b8e4a41e3223089654da4b36d0fdd51ce555. This conversion to lexical-binding broke the eval specification, documented in the ELisp manual. We will probably want to add tests for that before we can confidently convert this to lexical-binding. Problem reported by Mattias EngdegÃ¥rd . diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 95581c40a4..0fd273aa3e 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -1,4 +1,4 @@ -;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t -*- +;;; bindat.el --- binary data structure packing and unpacking. ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. @@ -193,8 +193,8 @@ ;; Helper functions for structure unpacking. ;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX -(defvar bindat-raw nil) -(defvar bindat-idx nil) +(defvar bindat-raw) +(defvar bindat-idx) (defun bindat--unpack-u8 () (prog1 @@ -276,7 +276,7 @@ (t nil))) (defun bindat--unpack-group (spec) - (let (struct) + (let (struct last) (while spec (let* ((item (car spec)) (field (car item)) @@ -330,21 +330,21 @@ (setq data (bindat--unpack-group (cdr case)) cases nil))))) (t - (setq data (bindat--unpack-item type len vectype)))) + (setq data (bindat--unpack-item type len vectype) + last data))) (if data (if field (setq struct (cons (cons field data) struct)) (setq struct (append data struct)))))) struct)) -(defun bindat-unpack (spec raw &optional idx) - "Return structured data according to SPEC for binary data in RAW. -RAW is a unibyte string or vector. -Optional third arg IDX specifies the starting offset in RAW." - (when (multibyte-string-p raw) +(defun bindat-unpack (spec bindat-raw &optional bindat-idx) + "Return structured data according to SPEC for binary data in BINDAT-RAW. +BINDAT-RAW is a unibyte string or vector. +Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW." + (when (multibyte-string-p bindat-raw) (error "String is multibyte")) - (setq bindat-raw raw) - (setq bindat-idx (or idx 0)) + (unless bindat-idx (setq bindat-idx 0)) (bindat--unpack-group spec)) (defun bindat-get-field (struct &rest field) @@ -373,70 +373,74 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (ip . 4))) (defun bindat--length-group (struct spec) - (while spec - (let* ((item (car spec)) - (field (car item)) - (type (nth 1 item)) - (len (nth 2 item)) - (vectype (and (eq type 'vec) (nth 3 item))) - (tail 3)) - (setq spec (cdr spec)) - (if (and (consp field) (eq (car field) 'eval)) - (setq field (eval (car (cdr field))))) - (if (and type (consp type) (eq (car type) 'eval)) - (setq type (eval (car (cdr type))))) - (if (and len (consp len) (eq (car len) 'eval)) - (setq len (eval (car (cdr len))))) - (if (memq field '(eval fill align struct union)) - (setq tail 2 - len type - type field - field nil)) - (if (and (consp len) (not (eq type 'eval))) - (setq len (apply #'bindat-get-field struct len))) - (if (not len) - (setq len 1)) - (while (eq type 'vec) - (if (consp vectype) - (setq len (* len (nth 1 vectype)) - type (nth 2 vectype)) - (setq type (or vectype 'u8) - vectype nil))) - (cond - ((eq type 'eval) - (if field - (setq struct (cons (cons field (eval len)) struct)) - (eval len))) - ((eq type 'fill) - (setq bindat-idx (+ bindat-idx len))) - ((eq type 'align) - (while (/= (% bindat-idx len) 0) - (setq bindat-idx (1+ bindat-idx)))) - ((eq type 'struct) - (bindat--length-group - (if field (bindat-get-field struct field) struct) (eval len))) - ((eq type 'repeat) - (let ((index 0) (count len)) - (while (< index count) - (bindat--length-group - (nth index (bindat-get-field struct field)) - (nthcdr tail item)) - (setq index (1+ index))))) - ((eq type 'union) - (let ((tag len) (cases (nthcdr tail item)) case cc) - (while cases - (setq case (car cases) - cases (cdr cases) - cc (car case)) - (if (or (equal cc tag) (equal cc t) - (and (consp cc) (eval cc))) - (progn - (bindat--length-group struct (cdr case)) - (setq cases nil)))))) - (t - (if (setq type (assq type bindat--fixed-length-alist)) - (setq len (* len (cdr type)))) - (setq bindat-idx (+ bindat-idx len))))))) + (let (last) + (while spec + (let* ((item (car spec)) + (field (car item)) + (type (nth 1 item)) + (len (nth 2 item)) + (vectype (and (eq type 'vec) (nth 3 item))) + (tail 3)) + (setq spec (cdr spec)) + (if (and (consp field) (eq (car field) 'eval)) + (setq field (eval (car (cdr field))))) + (if (and type (consp type) (eq (car type) 'eval)) + (setq type (eval (car (cdr type))))) + (if (and len (consp len) (eq (car len) 'eval)) + (setq len (eval (car (cdr len))))) + (if (memq field '(eval fill align struct union)) + (setq tail 2 + len type + type field + field nil)) + (if (and (consp len) (not (eq type 'eval))) + (setq len (apply 'bindat-get-field struct len))) + (if (not len) + (setq len 1)) + (while (eq type 'vec) + (let ((vlen 1)) + (if (consp vectype) + (setq len (* len (nth 1 vectype)) + type (nth 2 vectype)) + (setq type (or vectype 'u8) + vectype nil)))) + (cond + ((eq type 'eval) + (if field + (setq struct (cons (cons field (eval len)) struct)) + (eval len))) + ((eq type 'fill) + (setq bindat-idx (+ bindat-idx len))) + ((eq type 'align) + (while (/= (% bindat-idx len) 0) + (setq bindat-idx (1+ bindat-idx)))) + ((eq type 'struct) + (bindat--length-group + (if field (bindat-get-field struct field) struct) (eval len))) + ((eq type 'repeat) + (let ((index 0) (count len)) + (while (< index count) + (bindat--length-group + (nth index (bindat-get-field struct field)) + (nthcdr tail item)) + (setq index (1+ index))))) + ((eq type 'union) + (let ((tag len) (cases (nthcdr tail item)) case cc) + (while cases + (setq case (car cases) + cases (cdr cases) + cc (car case)) + (if (or (equal cc tag) (equal cc t) + (and (consp cc) (eval cc))) + (progn + (bindat--length-group struct (cdr case)) + (setq cases nil)))))) + (t + (if (setq type (assq type bindat--fixed-length-alist)) + (setq len (* len (cdr type)))) + (if field + (setq last (bindat-get-field struct field))) + (setq bindat-idx (+ bindat-idx len)))))))) (defun bindat-length (spec struct) "Calculate bindat-raw length for STRUCT according to bindat SPEC." @@ -592,17 +596,17 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (bindat--pack-item last type len vectype) )))))) -(defun bindat-pack (spec struct &optional raw idx) +(defun bindat-pack (spec struct &optional bindat-raw bindat-idx) "Return binary data packed according to SPEC for structured data STRUCT. -Optional third arg RAW is a pre-allocated unibyte string or -vector to pack into. -Optional fourth arg IDX is the starting offset into BINDAT-RAW." - (when (multibyte-string-p raw) +Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to +pack into. +Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW." + (when (multibyte-string-p bindat-raw) (error "Pre-allocated string is multibyte")) - (let ((no-return raw)) - (setq bindat-idx (or idx 0)) - (setq bindat-raw (or raw - (make-string (+ bindat-idx (bindat-length spec struct)) 0))) + (let ((no-return bindat-raw)) + (unless bindat-idx (setq bindat-idx 0)) + (unless bindat-raw + (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0))) (bindat--pack-group struct spec) (if no-return nil bindat-raw))) commit f378d65e5ea26662bf90a171ea292f20510939eb Author: Stefan Kangas Date: Sat Oct 24 14:17:35 2020 +0200 Use lexical-binding in most term libraries * lisp/term/AT386.el: * lisp/term/internal.el: * lisp/term/iris-ansi.el: * lisp/term/lk201.el: * lisp/term/news.el: * lisp/term/rxvt.el: * lisp/term/sun.el: * lisp/term/tvi970.el: * lisp/term/wyse50.el: Use lexical-binding. diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 674c33b45c..8ce7fbbcaf 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -1,4 +1,4 @@ -;;; AT386.el --- terminal support package for IBM AT keyboards +;;; AT386.el --- terminal support package for IBM AT keyboards -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/internal.el b/lisp/term/internal.el index c54481a532..9a6f4fac1e 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -1,4 +1,4 @@ -;;; internal.el --- support for PC internal terminal +;;; internal.el --- support for PC internal terminal -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 1998-1999, 2001-2020 Free Software ;; Foundation, Inc. diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index 8a99ddf8c0..7a92aa7ada 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -1,4 +1,4 @@ -;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps +;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- lexical-binding: t -*- ;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index aab4110b3a..3bcaa2ecd1 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -1,4 +1,4 @@ -;; Define function key sequences for DEC terminals. +;; Define function key sequences for DEC terminals. -*- lexical-binding: t -*- (defvar lk201-function-map (let ((map (make-sparse-keymap))) diff --git a/lisp/term/news.el b/lisp/term/news.el index e01d6f64be..33c7aa6cca 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -1,4 +1,4 @@ -;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard +;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 31e3d6ede4..71ee908693 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -1,4 +1,4 @@ -;;; rxvt.el --- define function key sequences and standard colors for rxvt +;;; rxvt.el --- define function key sequences and standard colors for rxvt -*- lexical-binding: t -*- ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 41915e1b07..7d1cd9f2cf 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -1,4 +1,4 @@ -;;; sun.el --- keybinding for standard default sunterm keys +;;; sun.el --- keybinding for standard default sunterm keys -*- lexical-binding: t -*- ;; Copyright (C) 1987, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index c0e6a12b73..fc8ad80ae5 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -1,4 +1,4 @@ -;;; tvi970.el --- terminal support for the Televideo 970 +;;; tvi970.el --- terminal support for the Televideo 970 -*- lexical-binding: t -*- ;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc. diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index 9e9fc4dd7d..6d72d4a05b 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -1,4 +1,4 @@ -;;; wyse50.el --- terminal support code for Wyse 50 +;;; wyse50.el --- terminal support code for Wyse 50 -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1993-1994, 2001-2020 Free Software Foundation, ;; Inc. commit 9f1dd2a7d51e20c76b7916db76a2e90c86356b3d Author: Stefan Kangas Date: Sat Oct 24 13:35:04 2020 +0200 Use lexical-binding in copyright.el and add tests * lisp/emacs-lisp/copyright.el: Use lexical-binding. Remove redundant :group args. * test/lisp/emacs-lisp/copyright-tests.el: New file. diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6fa51c3f64..9828ca63eb 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,4 +1,4 @@ -;;; copyright.el --- update the copyright notice in current buffer +;;; copyright.el --- update the copyright notice in current buffer -*- lexical-binding: t -*- ;; Copyright (C) 1991-1995, 1998, 2001-2020 Free Software Foundation, ;; Inc. @@ -37,14 +37,12 @@ (defcustom copyright-limit 2000 "Don't try to update copyright beyond this position unless interactive. A value of nil means to search whole buffer." - :group 'copyright :type '(choice (integer :tag "Limit") (const :tag "No limit"))) (defcustom copyright-at-end-flag nil "Non-nil means to search backwards from the end of the buffer for copyright. This is useful for ChangeLogs." - :group 'copyright :type 'boolean :version "23.1") ;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp) @@ -56,7 +54,6 @@ This is useful for ChangeLogs." \\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "What your copyright notice looks like. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) (defcustom copyright-names-regexp "" @@ -64,7 +61,6 @@ The second \\( \\) construct must match the years." Only copyright lines where the name matches this regexp will be updated. This allows you to avoid adding years to a copyright notice belonging to someone else or to a group for which you do not work." - :group 'copyright :type 'regexp) ;; The worst that can happen is a malicious regexp that overflows in @@ -76,7 +72,6 @@ someone else or to a group for which you do not work." "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" "Match additional copyright notice years. The second \\( \\) construct must match the years." - :group 'copyright :type 'regexp) ;; See "Copyright Notices" in maintain.info. @@ -87,7 +82,6 @@ The second \\( \\) construct must match the years." For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008. If you use ranges, you should add an explanatory note in a README file. The function `copyright-fix-years' respects this variable." - :group 'copyright :type 'boolean :version "24.1") @@ -96,7 +90,6 @@ The function `copyright-fix-years' respects this variable." (defcustom copyright-query 'function "If non-nil, ask user before changing copyright. When this is `function', only ask when called non-interactively." - :group 'copyright :type '(choice (const :tag "Do not ask") (const :tag "Ask unless interactive" function) (other :tag "Ask" t))) diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el new file mode 100644 index 0000000000..77b9e05da6 --- /dev/null +++ b/test/lisp/emacs-lisp/copyright-tests.el @@ -0,0 +1,50 @@ +;;; copyright-tests.el --- tests for copyright.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; 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 GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'copyright) + +(defmacro with-copyright-test (orig result) + `(cl-letf (((symbol-function 'format-time-string) (lambda (&rest _) "2019"))) + (let ((copyright-query nil) + (copyright-current-year 2019)) + (with-temp-buffer + (insert ,orig) + (copyright-update) + (should (equal (buffer-string) ,result)))))) + +(defvar copyright-tests--data + '((";; Copyright (C) 2017 Free Software Foundation, Inc." + . ";; Copyright (C) 2017, 2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2017-2019 Free Software Foundation, Inc.") + (";; Copyright (C) 2005-2006, 2015, 2017-2018 Free Software Foundation, Inc." + . ";; Copyright (C) 2005-2006, 2015, 2017-2019 Free Software Foundation, Inc.") + (";; copyright '18 FSF" + . ";; copyright '18, '19 FSF"))) + +(ert-deftest test-copyright-update () + (dolist (test copyright-tests--data) + (with-copyright-test (car test) (cdr test)))) + +(provide 'copyright-tests) +;;; copyright-tests.el ends here commit ff1068936fe59019b9d94aaf80d4cb8481c4acdd Author: Stefan Kangas Date: Sat Oct 24 12:34:23 2020 +0200 * test/manual/image-transforms-tests.el: Use lexical-binding. diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el index 02607e6367..13d74a7c4b 100644 --- a/test/manual/image-transforms-tests.el +++ b/test/manual/image-transforms-tests.el @@ -1,4 +1,4 @@ -;;; image-transform-tests.el --- Test suite for image transforms. +;;; image-transform-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*- ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. commit 228d9d615d7067ca06a2b53205c29d78dbbfe725 Author: Stefan Kangas Date: Sat Oct 24 03:45:48 2020 +0200 Move faces.el test data to follow our conventions * test/lisp/faces-tests.el (ert-x): Require. (faces--test-data-dir): Remove variable. (faces--test-extend-with-themes): Use ert-resource-directory. * test/lisp/faces-resources/*: Moved from test/data/themes/*. diff --git a/test/data/themes/faces-test-dark-theme.el b/test/lisp/faces-resources/faces-test-dark-theme.el similarity index 100% rename from test/data/themes/faces-test-dark-theme.el rename to test/lisp/faces-resources/faces-test-dark-theme.el diff --git a/test/data/themes/faces-test-light-theme.el b/test/lisp/faces-resources/faces-test-light-theme.el similarity index 100% rename from test/data/themes/faces-test-light-theme.el rename to test/lisp/faces-resources/faces-test-light-theme.el diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el index 32dc1eea85..b19cef5dec 100644 --- a/test/lisp/faces-tests.el +++ b/test/lisp/faces-tests.el @@ -23,13 +23,9 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'faces) -(defvar faces--test-data-dir - (expand-file-name "../data/" - (file-name-directory (or load-file-name - buffer-file-name)))) - (defgroup faces--test nil "" :group 'faces--test) @@ -122,7 +118,7 @@ (should (equal (face-attribute 'spiff-changed-face :extend) t)) (should (equal (face-attribute 'spiff-added :extend) 'unspecified)) (should (equal (face-attribute 'spiff-file-header-face :extend) nil)) - (add-to-list 'custom-theme-load-path (concat faces--test-data-dir "themes")) + (add-to-list 'custom-theme-load-path (ert-resource-directory)) (load-theme 'faces-test-dark t t) (load-theme 'faces-test-light t t) (should (equal (face-attribute 'faces--test-inherit-extend :extend) commit 2c487c47c8c3060818b2fcbfebbcd859f9d06ef5 Author: Jared Finder Date: Sun Oct 11 20:16:00 2020 -0700 Fix a bug where the wrong menu would be triggered by mouse For layouts such as the following, clicking the "l" in Tools with the right window focused would trigger the File menu, not the Tools menu. This is because the event would have window coordinate (1 . 0). Similarly, clicking the "p" in Help would trigger the Edit menu. Example Emacs frame: +--------------------------------------------------------+ |File Edit Options Buffers Tools Help | |;; This buffer is for text$|;; This buffer is for text $| |;; To create a file, visit$|;; To create a file, visit $| | | | | | | |-UUU:----F1 *scratch* |-UUU:----F1 *scratch* | | | +--------------------------------------------------------+ * lisp/menu-bar.el (menu-bar-open-mouse): Reject clicks not on the menu bar. *lisp/xt-mouse.el (xterm-mouse-event): Pass the current frame to 'posn-at-x-y', to make the effect consistent with other mouse-handling features. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index e42602364d..f9afc8a5f3 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2672,6 +2672,12 @@ EVENT should be a mouse down or click event. Also see `menu-bar-open', which this calls. This command is to be used when you click the mouse in the menubar." (interactive "e") + ;; This only should be bound to clicks on the menu-bar, outside of + ;; any window. + (let ((window (posn-window (event-start event)))) + (when window + (error "Event is inside window %s" window))) + (let* ((x-position (car (posn-x-y (event-start event)))) (menu-bar-item-cons (menu-bar-item-at-x x-position))) (menu-bar-open nil diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 3c0dfb65ec..f9c08f9a17 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -267,7 +267,7 @@ which is the \"1006\" extension implemented in Xterm >= 277." (eq y 1))) 'tab-bar 'menu-bar)) - (nthcdr 2 (posn-at-x-y x y))))) + (nthcdr 2 (posn-at-x-y x y (selected-frame)))))) (event (list type posn))) (setcar (nthcdr 3 posn) timestamp) commit 92d37029a755e7f610c3bc10c816763c5d853d2f Author: Jared Finder Date: Tue Oct 6 20:04:12 2020 -0700 Enable TTY menus with xterm-mouse-mode * lisp/tmm.el: No need to bind 'tmm-menubar-mouse' to mouse clicks on the menu bar. * lisp/menu-bar.el (global-map): Bind 'menu-bar-open-mouse' to mouse click on menu bar. This is needed in xt-mouse. * etc/NEWS: Announce TTY menu support in xterm-mouse-mode. diff --git a/etc/NEWS b/etc/NEWS index a212edfcfb..a405c0dd3d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1325,6 +1325,16 @@ to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. 'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and horizontal movements now stop at the edge of the board. +** xterm-mouse mode + +--- +*** TTY menu navigation is now supported in 'xterm-mouse-mode'. +TTY menus support mouse navigation and selection when xterm-mouse-mode +is active. When run on a terminal, clicking on the menu bar with the +mouse now pops up a TTY menu by default instead of running the command +'tmm-menubar'. To restore the old behavior, set the variable +'tty-menu-open-use-tmm' to non-nil. + ** xwidget-webkit mode *** New xwidget commands. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index e78c1a6c70..e42602364d 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2088,6 +2088,8 @@ key, a click, or a menu-item")) (bindings--define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) +(define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) + (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. The menu frame is the frame for which we are updating the menu." diff --git a/lisp/tmm.el b/lisp/tmm.el index fc02fd5790..4c2855751c 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -43,7 +43,6 @@ (defvar tmm-table-undef) ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) -;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) ;;;###autoload (defun tmm-menubar (&optional x-position) commit 0695c9e8599b5036a80361571e7cb0ea9fdead99 Author: Jared Finder Date: Sat Oct 3 14:46:30 2020 -0700 Make TTY menus work with xterm-mouse-mode * src/term.c (mouse_get_xy): Call 'mouse_position' passing it the value of 'tty-menu-calls-mouse-position-function' as the argument. (syms_of_term) : New DEFVAR_BOOL. * src/frame.c (mouse_position): New function, with most of the code from Fmouse_position, but call 'mouse-position-function' only if called with non-zero argument. (Fmouse_position): Call 'mouse_position' to do the job. * lisp/xt-mouse.el (xterm-mouse-translate-1): Respect 'track-mouse'. (xterm-mouse-mode): Set 'tty-menu-calls-mouse-position-function' when setting 'mouse-position-function'. (xterm-mouse-tracking-enable-sequence): Use SET_ANY_EVENT_MOUSE (0x1003) so that mouse movement can be reported even if no buttons are pressed. Doc fix. * lisp/menu-bar.el (menu-bar-define-mouse-key): New function. (tty-menu-navigation-map): Call it. * doc/lispref/frames.texi (Mouse Position): Document 'tty-menu-calls-mouse-position-function'. * etc/NEWS: Announce 'tty-menu-calls-mouse-position-function'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 22d32c00d9..e3d0fdeb27 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3526,6 +3526,13 @@ This abnormal hook exists for the benefit of packages like @file{xt-mouse.el} that need to do mouse handling at the Lisp level. @end defvar +@defvar tty-menu-calls-mouse-position-function +If non-@code{nil}, TTY menus will call @code{mouse-position-function} +as described above. This exists for cases where +@code{mouse-position-function} is not safe to be called by the TTY +menus, such as if it could trigger redisplay. +@end defvar + @defun set-mouse-position frame x y This function @dfn{warps the mouse} to position @var{x}, @var{y} in frame @var{frame}. The arguments @var{x} and @var{y} are integers, diff --git a/etc/NEWS b/etc/NEWS index 11c19b378a..a212edfcfb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1748,6 +1748,14 @@ convert them to a list '(R G B)' of primary color values. This user option can be one of the predefined styles or a function to personalize the uniquified buffer name. ++++ +** New variable 'tty-menu-calls-mouse-position-function'. +This controls whether 'mouse-position-function' is called by functions +that retrieve the mouse position when that happens during TTY menu +handling. Lisp programs that set 'mouse-position-function' should +also set this variable non-nil if they are compatible with the tty +menu handling. + +++ ** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 8690569ac0..e78c1a6c70 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2762,6 +2762,16 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (menu-bar-buffer-vector item))))) km)) +(defun menu-bar-define-mouse-key (map key def) + "Like `define-key', but adds all possible prefixes for the mouse." + (define-key map (vector key) def) + (mapc (lambda (prefix) (define-key map (vector prefix key) def)) + ;; This list only needs to contain special window areas that + ;; are rendered in TTYs. No need for *-scroll-bar, *-fringe, + ;; or *-divider. + '(tab-line header-line menu-bar tab-bar mode-line vertical-line + left-margin right-margin))) + (defvar tty-menu-navigation-map (let ((map (make-sparse-keymap))) ;; The next line is disabled because it breaks interpretation of @@ -2796,39 +2806,33 @@ This is the keyboard interface to \\[mouse-buffer-menu]." (define-key map [?\C-j] 'tty-menu-select) (define-key map [return] 'tty-menu-select) (define-key map [linefeed] 'tty-menu-select) - (define-key map [mouse-1] 'tty-menu-select) - (define-key map [drag-mouse-1] 'tty-menu-select) - (define-key map [mouse-2] 'tty-menu-select) - (define-key map [drag-mouse-2] 'tty-menu-select) - (define-key map [mouse-3] 'tty-menu-select) - (define-key map [drag-mouse-3] 'tty-menu-select) - (define-key map [wheel-down] 'tty-menu-next-item) - (define-key map [wheel-up] 'tty-menu-prev-item) - (define-key map [wheel-left] 'tty-menu-prev-menu) - (define-key map [wheel-right] 'tty-menu-next-menu) - ;; The following 4 bindings are for those whose text-mode mouse + (menu-bar-define-mouse-key map 'mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-1 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-2 'tty-menu-select) + (menu-bar-define-mouse-key map 'mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'drag-mouse-3 'tty-menu-select) + (menu-bar-define-mouse-key map 'wheel-down 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'wheel-up 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'wheel-left 'tty-menu-prev-menu) + (menu-bar-define-mouse-key map 'wheel-right 'tty-menu-next-menu) + ;; The following 6 bindings are for those whose text-mode mouse ;; lack the wheel. - (define-key map [S-mouse-1] 'tty-menu-next-item) - (define-key map [S-drag-mouse-1] 'tty-menu-next-item) - (define-key map [S-mouse-2] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-2] 'tty-menu-prev-item) - (define-key map [S-mouse-3] 'tty-menu-prev-item) - (define-key map [S-drag-mouse-3] 'tty-menu-prev-item) - (define-key map [header-line mouse-1] 'tty-menu-select) - (define-key map [header-line drag-mouse-1] 'tty-menu-select) + (menu-bar-define-mouse-key map 'S-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-1 'tty-menu-next-item) + (menu-bar-define-mouse-key map 'S-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-2 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-mouse-3 'tty-menu-prev-item) + (menu-bar-define-mouse-key map 'S-drag-mouse-3 'tty-menu-prev-item) ;; The down-mouse events must be bound to tty-menu-ignore, so that ;; only releasing the mouse button pops up the menu. - (define-key map [mode-line down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line down-mouse-3] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore) - (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore) - (define-key map [down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-1] 'tty-menu-ignore) - (define-key map [C-down-mouse-2] 'tty-menu-ignore) - (define-key map [C-down-mouse-3] 'tty-menu-ignore) - (define-key map [mouse-movement] 'tty-menu-mouse-movement) + (menu-bar-define-mouse-key map 'down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-1 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-2 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'C-down-mouse-3 'tty-menu-ignore) + (menu-bar-define-mouse-key map 'mouse-movement 'tty-menu-mouse-movement) map) "Keymap used while processing TTY menus.") diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 362d29b943..3c0dfb65ec 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -76,7 +76,11 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." ;; to guard against that. (copy-sequence event)) vec) - (is-move vec) + (is-move + (if track-mouse vec + ;; Mouse movement events are currently supposed to be + ;; suppressed. Return no event. + [])) (t (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) (down-data (nth 1 down)) @@ -321,11 +325,13 @@ down the SHIFT key while pressing the mouse button." (if xterm-mouse-mode ;; Turn it on (progn - (setq mouse-position-function #'xterm-mouse-position-function) + (setq mouse-position-function #'xterm-mouse-position-function + tty-menu-calls-mouse-position-function t) (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list))) ;; Turn it off (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) - (setq mouse-position-function nil))) + (setq mouse-position-function nil + tty-menu-calls-mouse-position-function nil))) (defun xterm-mouse-tracking-enable-sequence () "Return a control sequence to enable XTerm mouse tracking. @@ -339,8 +345,8 @@ modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -360,7 +366,7 @@ given escape sequence takes precedence over the former." (apply #'concat (xterm-mouse--tracking-sequence ?h))) (defconst xterm-mouse-tracking-enable-sequence - "\e[?1000h\e[?1002h\e[?1005h\e[?1006h" + "\e[?1000h\e[?1003h\e[?1005h\e[?1006h" "Control sequence to enable xterm mouse tracking. Enables basic mouse tracking, mouse motion events and finally extended tracking on terminals that support it. The following @@ -371,8 +377,8 @@ escape sequences are understood by modern xterms: position (<= 223), which can be reported in this basic mode. -\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse - motion events during dragging operations. +\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse + motion events. \"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension to the basic mouse mode, which uses UTF-8 @@ -400,7 +406,7 @@ The control sequence resets the modes set by (apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l)))) (defconst xterm-mouse-tracking-disable-sequence - "\e[?1006l\e[?1005l\e[?1002l\e[?1000l" + "\e[?1006l\e[?1005l\e[?1003l\e[?1000l" "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") (make-obsolete-variable @@ -414,7 +420,7 @@ SUFFIX is the last character of each escape sequence (?h to enable, ?l to disable)." (mapcar (lambda (code) (format "\e[?%d%c" code suffix)) - `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) + `(1000 1003 ,@(when xterm-mouse-utf-8 '(1005)) 1006))) (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." diff --git a/src/frame.c b/src/frame.c index 0b707c2af8..5d967a59ce 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2433,6 +2433,12 @@ If `mouse-position-function' is non-nil, `mouse-position' calls it, passing the normal return value to that function as an argument, and returns whatever that function returns. */) (void) +{ + return mouse_position (true); +} + +Lisp_Object +mouse_position (bool call_mouse_position_function) { struct frame *f; Lisp_Object lispy_dummy; @@ -2462,7 +2468,7 @@ and returns whatever that function returns. */) } XSETFRAME (lispy_dummy, f); retval = Fcons (lispy_dummy, Fcons (x, y)); - if (!NILP (Vmouse_position_function)) + if (call_mouse_position_function && !NILP (Vmouse_position_function)) retval = call1 (Vmouse_position_function, retval); return retval; } diff --git a/src/frame.h b/src/frame.h index 476bac67fa..16ecfd311c 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1361,6 +1361,7 @@ extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object); extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object); extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol, int width, int height, Lisp_Object rest); +extern Lisp_Object mouse_position (bool); extern Lisp_Object Vframe_list; diff --git a/src/term.c b/src/term.c index 53a1016183..ff1aabfed2 100644 --- a/src/term.c +++ b/src/term.c @@ -2804,16 +2804,15 @@ tty_menu_calc_size (tty_menu *menu, int *width, int *height) static void mouse_get_xy (int *x, int *y) { - struct frame *sf = SELECTED_FRAME (); - Lisp_Object lmx = Qnil, lmy = Qnil, lisp_dummy; - enum scroll_bar_part part_dummy; - Time time_dummy; - - if (FRAME_TERMINAL (sf)->mouse_position_hook) - (*FRAME_TERMINAL (sf)->mouse_position_hook) (&sf, -1, - &lisp_dummy, &part_dummy, - &lmx, &lmy, - &time_dummy); + Lisp_Object lmx = Qnil, lmy = Qnil; + Lisp_Object mouse = mouse_position (tty_menu_calls_mouse_position_function); + + if (EQ (selected_frame, XCAR (mouse))) + { + lmx = XCAR (XCDR (mouse)); + lmy = XCDR (XCDR (mouse)); + } + if (!NILP (lmx)) { *x = XFIXNUM (lmx); @@ -4554,6 +4553,13 @@ What means \"very visible\" is up to your terminal. It may make the cursor bigger, or it may make it blink, or it may do nothing at all. */); visible_cursor = 1; + DEFVAR_BOOL ("tty-menu-calls-mouse-position-function", + tty_menu_calls_mouse_position_function, + doc: /* Non-nil means TTY menu code will call `mouse-position-function'. +This should be set if the function in `mouse-position-function' does not +trigger redisplay. */); + tty_menu_calls_mouse_position_function = 0; + defsubr (&Stty_display_color_p); defsubr (&Stty_display_color_cells); defsubr (&Stty_no_underline); commit 9d230684ff16e105db168ebaafdbea2de2e7d6ca Author: Jared Finder Date: Sat Sep 19 00:43:29 2020 -0700 Adding mouse controls to menu-bar.el. * lisp/isearch.el (tmm-menubar-keymap): Remove declare-function. * lisp/menu-bar.el (menu-bar-open-mouse, menu-bar-keymap) (menu-bar-current-active-maps, menu-bar-item-at-x): New functions. *lisp.tmm.el (tmm-menubar-keymap, tmm-get-keybind): Functions deleted. (tmm-menubar): Call 'menu-bar-item-at-x'. diff --git a/lisp/isearch.el b/lisp/isearch.el index 0879f948cf..c3d5ff2d31 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -54,7 +54,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(declare-function tmm-menubar-keymap "tmm.el") ;; Some additional options and constants. @@ -505,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys." (require 'tmm) (run-hooks 'menu-bar-update-hook) (let ((command nil)) - (let ((menu-bar (tmm-menubar-keymap))) + (let ((menu-bar (menu-bar-keymap))) (with-isearch-suspended (setq command (let ((isearch-mode t)) ; Show bindings from ; `isearch-mode-map' in diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index da4ad9799b..8690569ac0 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2663,6 +2663,86 @@ If FRAME is nil or not given, use the selected frame." (global-set-key [f10] 'menu-bar-open) +(defun menu-bar-open-mouse (event) + "Open the menu bar for the menu item clicked on by the mouse. +EVENT should be a mouse down or click event. + +Also see `menu-bar-open', which this calls. +This command is to be used when you click the mouse in the menubar." + (interactive "e") + (let* ((x-position (car (posn-x-y (event-start event)))) + (menu-bar-item-cons (menu-bar-item-at-x x-position))) + (menu-bar-open nil + (if menu-bar-item-cons + (cdr menu-bar-item-cons) + 0)))) + +(defun menu-bar-keymap () + "Return the current menu-bar keymap. + +The ordering of the return value respects `menu-bar-final-items'." + (let ((menu-bar '()) + (menu-end '())) + (map-keymap + (lambda (key binding) + (let ((pos (seq-position menu-bar-final-items key)) + (menu-item (cons key binding))) + (if pos + ;; If KEY is the name of an item that we want to put + ;; last, store it separately with explicit ordering for + ;; sorting. + (push (cons pos menu-item) menu-end) + (push menu-item menu-bar)))) + (lookup-key (menu-bar-current-active-maps) [menu-bar])) + `(keymap ,@(nreverse menu-bar) + ,@(mapcar #'cdr (sort menu-end + (lambda (a b) + (< (car a) (car b)))))))) + +(defun menu-bar-current-active-maps () + "Return the current active maps in the order the menu bar displays them. +This value does not take into account `menu-bar-final-items' as that applies +per-item." + ;; current-active-maps returns maps in the order local then + ;; global. The menu bar displays items in the opposite order. + (cons 'keymap (nreverse (current-active-maps)))) + +(defun menu-bar-item-at-x (x-position) + "Return a cons of the form (KEY . X) for a menu item. +The returned X is the left X coordinate for that menu item. + +X-POSITION is the X coordinate being queried. If nothing is clicked on, +returns nil." + (let ((column 0) + (menu-bar (menu-bar-keymap)) + prev-key + prev-column + found) + (catch 'done + (map-keymap + (lambda (key binding) + (when (> column x-position) + (setq found t) + (throw 'done nil)) + (setq prev-key key) + (pcase binding + ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. + `(menu-item ,name ,_cmd ;Extended menu item. + . ,(and props + (guard (let ((visible + (plist-get props :visible))) + (or (null visible) + (eval visible))))))) + (setq prev-column column + column (+ column (length name) 1))))) + menu-bar) + ;; Check the last menu item. + (when (> column x-position) + (setq found t))) + (if found + (cons prev-key prev-column) + nil))) + (defun buffer-menu-open () "Start key navigation of the buffer menu. This is the keyboard interface to \\[mouse-buffer-menu]." diff --git a/lisp/tmm.el b/lisp/tmm.el index 0e83f427f5..fc02fd5790 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -42,28 +42,6 @@ (defvar tmm-next-shortcut-digit) (defvar tmm-table-undef) -(defun tmm-menubar-keymap () - "Return the current menu-bar keymap. - -The ordering of the return value respects `menu-bar-final-items'." - (let ((menu-bar '()) - (menu-end '())) - (map-keymap - (lambda (key binding) - (let ((pos (seq-position menu-bar-final-items key)) - (menu-item (cons key binding))) - (if pos - ;; If KEY is the name of an item that we want to put - ;; last, store it separately with explicit ordering for - ;; sorting. - (push (cons pos menu-item) menu-end) - (push menu-item menu-bar)))) - (tmm-get-keybind [menu-bar])) - `(keymap ,@(nreverse menu-bar) - ,@(mapcar #'cdr (sort menu-end - (lambda (a b) - (< (car a) (car b)))))))) - ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -79,33 +57,12 @@ to invoke `tmm-menubar' instead, customize the variable `tty-menu-open-use-tmm' to a non-nil value." (interactive) (run-hooks 'menu-bar-update-hook) - ;; Obey menu-bar-final-items; put those items last. - (let ((menu-bar (tmm-menubar-keymap)) - menu-bar-item) - (if x-position - (let ((column 0) - prev-key) - (catch 'done - (map-keymap - (lambda (key binding) - (when (> column x-position) - (setq menu-bar-item prev-key) - (throw 'done nil)) - (setq prev-key key) - (pcase binding - ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item. - `(menu-item ,name ,_cmd ;Extended menu item. - . ,(and props - (guard (let ((visible - (plist-get props :visible))) - (or (null visible) - (eval visible))))))) - (setq column (+ column (length name) 1))))) - menu-bar) - ;; Check the last menu item. - (when (> column x-position) - (setq menu-bar-item prev-key))))) - (tmm-prompt menu-bar nil menu-bar-item))) + (let ((menu-bar (menu-bar-keymap)) + (menu-bar-item-cons (and x-position + (menu-bar-item-at-x x-position)))) + (tmm-prompt menu-bar + nil + (and menu-bar-item-cons (car menu-bar-item-cons))))) ;;;###autoload (defun tmm-menubar-mouse (event) @@ -525,14 +482,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys." (or (assoc str tmm-km-list) (push (cons str (cons event km)) tmm-km-list)))))) -(defun tmm-get-keybind (keyseq) - "Return the current binding of KEYSEQ, merging prefix definitions. -If KEYSEQ is a prefix key that has local and global bindings, -we merge them into a single keymap which shows the proper order of the menu. -However, for the menu bar itself, the value does not take account -of `menu-bar-final-items'." - (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq)) - (provide 'tmm) ;;; tmm.el ends here