commit/cc-mode: acm: Fix "Args out of range" error in
c-determine-limit.
7 years, 2 months
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/commits/a63d84d98ded/
Changeset: a63d84d98ded
User: acm
Date: 2017-10-30 17:15:44+00:00
Summary: Fix "Args out of range" error in c-determine-limit.
* cc-engine.el (c-determine-limit-get-base): If the candidate position for
BASE is below point-min, scan forward to the end of the current literal.
(c-determine-limit): Add an extra arm to the final cond form, testing for BASE
being at point-min.
Affected #: 1 file
diff -r d578a1da16151441048b84552790befc5db43f00 -r a63d84d98dedcefec044dfec5e286b57ad4f79ce cc-engine.el
--- a/cc-engine.el
+++ b/cc-engine.el
@@ -5199,16 +5199,25 @@
;; Get a "safe place" approximately TRY-SIZE characters before START.
;; This defsubst doesn't preserve point.
(let* ((pos (max (- start try-size) (point-min)))
- (s (c-state-semi-pp-to-literal pos)))
- (or (car (cddr s)) pos)))
+ (s (c-state-semi-pp-to-literal pos))
+ (cand (or (car (cddr s)) pos)))
+ (if (>= cand (point-min))
+ cand
+ (parse-partial-sexp pos start nil nil (car s) 'syntax-table)
+ (point))))
(defun c-determine-limit (how-far-back &optional start try-size)
- ;; Return a buffer position HOW-FAR-BACK non-literal characters from START
- ;; (default point). This is done by going back further in the buffer then
- ;; searching forward for literals. The position found won't be in a
- ;; literal. We start searching for the sought position TRY-SIZE (default
- ;; twice HOW-FAR-BACK) bytes back from START. This function must be fast.
- ;; :-)
+ ;; Return a buffer position HOW-FAR-BACK non-literal characters from
+ ;; START (default point). The starting position, either point or
+ ;; START may not be in a comment or string.
+ ;;
+ ;; The position found will not be before POINT-MIN and won't be in a
+ ;; literal.
+ ;;
+ ;; We start searching for the sought position TRY-SIZE (default
+ ;; twice HOW-FAR-BACK) bytes back from START.
+ ;;
+ ;; This function must be fast. :-)
(save-excursion
(let* ((start (or start (point)))
(try-size (or try-size (* 2 how-far-back)))
@@ -5264,6 +5273,8 @@
(+ (car elt) (- count how-far-back)))
((eq base (point-min))
(point-min))
+ ((> base (- start try-size)) ; Can only happen if we hit point-min.
+ (car elt))
(t
(c-determine-limit (- how-far-back count) base try-size))))))
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: #'cl-macro-expand-all;
delay symbol macro shadowing until all args processed, let
7 years, 2 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/efa8f1377817/
Changeset: efa8f1377817
User: kehoea
Date: 2017-10-29 13:59:44+00:00
Summary: #'cl-macro-expand-all; delay symbol macro shadowing until all args processed, let
lisp/ChangeLog addition:
2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (cl-macroexpand-all):
When processing a let binding, and an existing symbol macro has
the same symbol name as the let binding, delay shadowing until all
bindings are processed.
tests/ChangeLog addition:
2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Test the SHADOW argument to symbol-macrolet.
Affected #: 4 files
diff -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 -r efa8f1377817cf7f529bbd39b58857c7675c59ad lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (cl-macroexpand-all):
+ When processing a let binding, and an existing symbol macro has
+ the same symbol name as the let binding, delay shadowing until all
+ bindings are processed.
+
2017-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
* frame.el (frame-utmost-window-2): Made into a label.
diff -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 -r efa8f1377817cf7f529bbd39b58857c7675c59ad lisp/cl-extra.el
--- a/lisp/cl-extra.el
+++ b/lisp/cl-extra.el
@@ -523,7 +523,7 @@
(push `(,eq-hash . nil) env)
;; `let'; delay until all bindings
;; processed.
- (push `(,eq-hash . nil) env))
+ (push `(,eq-hash . nil) shadows))
;; Don't shadow it.
(setq symbol (car acons))
(unless (symbolp symbol) (setq letf t)))
diff -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 -r efa8f1377817cf7f529bbd39b58857c7675c59ad tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,8 @@
+2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Test the SHADOW argument to symbol-macrolet.
+
2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el:
diff -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 -r efa8f1377817cf7f529bbd39b58857c7675c59ad tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el
+++ b/tests/automated/lisp-tests.el
@@ -3034,6 +3034,21 @@
(Assert (equal '([symbol expansion] [copy expansion] [third expansion])
(test-symbol-macrolet))))
+;; And test it with the SHADOW argument.
+
+(Assert (eql (let ((hello 20) (everyone 5))
+ (symbol-macrolet ((hello everyone))
+ (let ((hello (+ hello 5)))
+ hello)))
+ 10))
+
+(Assert (eql (let ((hello 20) (everyone 5))
+ (symbol-macrolet ((hello everyone t))
+ (let ((hello (+ hello 5))
+ (there (+ hello 10)))
+ (+ hello there))))
+ 25))
+
;; Basic tests of #'apply-partially.
(let* ((four 4)
(times-four (apply-partially '* four))
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Don't run #'test-chars on unicode-internal,
mule-tests.el
7 years, 2 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/450ec5be18d1/
Changeset: 450ec5be18d1
User: kehoea
Date: 2017-10-29 13:48:11+00:00
Summary: Don't run #'test-chars on unicode-internal, mule-tests.el
tests/ChangeLog addition:
2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el:
Don't run #'test-chars on unicode-internal, the time and memory
demands for inserting #x40000000 characters, then comparing them
to a string constructed separately make it impractical.
Affected #: 2 files
diff -r 75c2debd5be652fa2c9959d9a7b01c66248d3712 -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
@@ -1,3 +1,10 @@
+2017-10-29 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/mule-tests.el:
+ Don't run #'test-chars on unicode-internal, the time and memory
+ demands for inserting #x40000000 characters, then comparing them
+ to a string constructed separately make it impractical.
+
2017-09-30 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/extent-tests.el:
diff -r 75c2debd5be652fa2c9959d9a7b01c66248d3712 -r 450ec5be18d1431b8a6f8377d836a2bc86f59f59 tests/automated/mule-tests.el
--- a/tests/automated/mule-tests.el
+++ b/tests/automated/mule-tests.el
@@ -74,9 +74,14 @@
(insert string)
(assert (equal (buffer-string) string))))))
-;; Run #'test-chars in byte-compiled mode only.
-(when (compiled-function-p (symbol-function 'test-chars))
- (test-chars t))
+(Skip-Test-Unless
+ ;; unicode-internal has a value of #x40000000, (expt 2 30), for
+ ;; char-code-limit and even re-writing the above to avoid allocating the list
+ ;; and the string means I run out of memory when I attempt to run this.
+ (<= char-code-limit #x200000)
+ "CHAR-CODE-LIMIT is impractically large"
+ ;; Run #'test-chars in byte-compiled mode only.
+ (and (compiled-function-p (symbol-function 'test-chars)) (test-chars t)))
(defun unicode-code-point-to-utf-8-string (code-point)
"Convert a Unicode code point to the equivalent UTF-8 string.
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Accept error octets on encoding,
"multibyte" coding systems, file-coding.c
7 years, 2 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/75c2debd5be6/
Changeset: 75c2debd5be6
User: kehoea
Date: 2017-10-28 10:55:04+00:00
Summary: Accept error octets on encoding, "multibyte" coding systems, file-coding.c
src/ChangeLog addition:
2017-10-28 Aidan Kehoe <kehoea(a)parhasard.net>
* file-coding.c (handle_possible_error_octet):
Pass CONVERR_USE_PRIVATE to ichar_to_unicode(), allowing it to
return an error octet, and allowing us to preserve error octets
seen in external data.
* mule-coding.c (multibyte_encode):
Document a consideration about which error octets to pass through.
Affected #: 3 files
diff -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 -r 75c2debd5be652fa2c9959d9a7b01c66248d3712 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2017-10-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * file-coding.c (handle_possible_error_octet):
+ Pass CONVERR_USE_PRIVATE to ichar_to_unicode(), allowing it to
+ return an error octet, and allowing us to preserve error octets
+ seen in external data.
+ * mule-coding.c (multibyte_encode):
+ Document a consideration about which error octets to pass through.
+
2017-10-26 Aidan Kehoe <kehoea(a)parhasard.net>
* mule-coding.c (iso2022_encode):
diff -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 -r 75c2debd5be652fa2c9959d9a7b01c66248d3712 src/file-coding.c
--- a/src/file-coding.c
+++ b/src/file-coding.c
@@ -2989,7 +2989,7 @@
struct coding_stream *str, const UExtbyte *src,
unsigned_char_dynarr *dst, int *code_out)
{
- int code = ichar_to_unicode (ich, CONVERR_FAIL);
+ int code = ichar_to_unicode (ich, CONVERR_USE_PRIVATE);
if (code >= 0)
{
if (code_out)
diff -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 -r 75c2debd5be652fa2c9959d9a7b01c66248d3712 src/mule-coding.c
--- a/src/mule-coding.c
+++ b/src/mule-coding.c
@@ -297,6 +297,9 @@
if (handle_possible_error_octet (ich, str, src, dst, NULL))
{
+ /* #### This should behave differently depending on whether this
+ error octet can be produced by multibyte_decode() with this
+ coding system, or not. */
ENCODING_ERROR_RETURN_OR_CONTINUE (str, src);
}
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/cc-mode: acm: Fix another "wrong side of point" error in CC
Mode.
7 years, 2 months
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/commits/d578a1da1615/
Changeset: d578a1da1615
User: acm
Date: 2017-10-26 18:17:41+00:00
Summary: Fix another "wrong side of point" error in CC Mode.
This fixes (a follow-up to) bug #28850.
A internal generated form for scanning text to fontify had a LIMIT parameter.
It also locally bound LIMIT to a value possibly beyond the original LIMIT,
allowing point to move beyond the original LIMIT, and to create the wrong side
error. Fix it by checking point is not beyond LIMIT in the outer context
before using it.
* cc-fonts.el (c-make-font-lock-search-form): Add a new parameter CHECK-POINT
which, when non-nil, directs the function to generate a check on point.
(c-make-font-lock-context-search-function): Invoke the above function with new
argument value t.
Affected #: 1 file
diff -r 92de7b41bfc97db49178d2f7317ce6583584ed94 -r d578a1da16151441048b84552790befc5db43f00 cc-fonts.el
--- a/cc-fonts.el
+++ b/cc-fonts.el
@@ -286,12 +286,17 @@
nil)))))
res))))
- (defun c-make-font-lock-search-form (regexp highlights)
+ (defun c-make-font-lock-search-form (regexp highlights &optional check-point)
;; Return a lisp form which will fontify every occurrence of REGEXP
;; (a regular expression, NOT a function) between POINT and `limit'
;; with HIGHLIGHTS, a list of highlighters as specified on page
- ;; "Search-based Fontification" in the elisp manual.
- `(while (re-search-forward ,regexp limit t)
+ ;; "Search-based Fontification" in the elisp manual. If CHECK-POINT
+ ;; is non-nil, we will check (< (point) limit) in the main loop.
+ `(while
+ ,(if check-point
+ `(and (< (point) limit)
+ (re-search-forward ,regexp limit t))
+ `(re-search-forward ,regexp limit t))
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
@@ -470,7 +475,9 @@
,(c-make-font-lock-search-form
regexp highlights)))))
state-stanzas)
- ,(c-make-font-lock-search-form (car normal) (cdr normal))
+ ;; In the next form, check that point hasn't been moved beyond
+ ;; `limit' in any of the above stanzas.
+ ,(c-make-font-lock-search-form (car normal) (cdr normal) t)
nil))))
(eval-after-load "edebug"
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Don't encode private code-points by default in
UTF-8, #'encode-coding-region
7 years, 2 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/32aa4c87fa7f/
Changeset: 32aa4c87fa7f
User: kehoea
Date: 2017-10-26 08:34:51+00:00
Summary: Don't encode private code-points by default in UTF-8, #'encode-coding-region
src/ChangeLog addition:
2017-10-26 Aidan Kehoe <kehoea(a)parhasard.net>
* mule-coding.c (iso2022_encode):
Pass the new ALLOW_PRIVATE argument to encode_unicode_to_dynarr().
* unicode.c:
* unicode.c (struct unicode_coding_system):
Add a new allow_private field here, respected on encoding and
decoding.
* unicode.c (CODING_SYSTEM_UNICODE_ALLOW_PRIVATE):
New macro.
* unicode.c (decode_utf_8):
Make ALLOW_PRIVATE a Boolint in this function.
* unicode.c (encode_unicode_to_dynarr):
Take a new ALLOW_PRIVATE argument.
* unicode.c (unicode_decode):
* unicode.c (unicode_encode):
Use the ALLOW_PRIVATE coding system property in these two functions.
* unicode.c (unicode_putprop):
Implement the ALLOW_PRIVATE property.
* unicode.c (syms_of_unicode):
Make Qallow_private available.
* unicode.h:
Declare encode_unicode_to_dynarr() as having an ALLOW_PRIVATE
argument.
Affected #: 4 files
diff -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,28 @@
+2017-10-26 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * mule-coding.c (iso2022_encode):
+ Pass the new ALLOW_PRIVATE argument to encode_unicode_to_dynarr().
+ * unicode.c:
+ * unicode.c (struct unicode_coding_system):
+ Add a new allow_private field here, respected on encoding and
+ decoding.
+ * unicode.c (CODING_SYSTEM_UNICODE_ALLOW_PRIVATE):
+ New macro.
+ * unicode.c (decode_utf_8):
+ Make ALLOW_PRIVATE a Boolint in this function.
+ * unicode.c (encode_unicode_to_dynarr):
+ Take a new ALLOW_PRIVATE argument.
+ * unicode.c (unicode_decode):
+ * unicode.c (unicode_encode):
+ Use the ALLOW_PRIVATE coding system property in these two functions.
+ * unicode.c (unicode_putprop):
+ Implement the ALLOW_PRIVATE property.
+ * unicode.c (syms_of_unicode):
+ Make Qallow_private available.
+ * unicode.h:
+ Declare encode_unicode_to_dynarr() as having an ALLOW_PRIVATE
+ argument.
+
2017-10-19 Aidan Kehoe <kehoea(a)parhasard.net>
* symbols.c (Fapropos_internal):
diff -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 src/mule-coding.c
--- a/src/mule-coding.c
+++ b/src/mule-coding.c
@@ -3102,7 +3102,8 @@
int code = ichar_to_unicode (ich, CONVERR_FAIL);
if (encode_unicode_to_dynarr
(code, str, src, dst, UNICODE_UTF_8, 0,
- XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)) < 0)
+ XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys),
+ 1) < 0)
{
ENCODING_ERROR_RETURN_OR_CONTINUE (str, src);
}
diff -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 src/unicode.c
--- a/src/unicode.c
+++ b/src/unicode.c
@@ -202,7 +202,7 @@
Lisp_Object Qunicode;
Lisp_Object Qutf_16, Qutf_8, Qucs_4, Qutf_7, Qutf_32;
-Lisp_Object Qneed_bom;
+Lisp_Object Qneed_bom, Qallow_private;
Lisp_Object Qutf_16_little_endian, Qutf_16_bom;
Lisp_Object Qutf_16_little_endian_bom;
@@ -2705,6 +2705,7 @@
enum unicode_encoding_type type;
unsigned int little_endian :1;
unsigned int need_bom :1;
+ unsigned int allow_private :1;
};
#define CODING_SYSTEM_UNICODE_TYPE(codesys) \
@@ -2719,6 +2720,10 @@
(CODING_SYSTEM_TYPE_DATA (codesys, unicode)->need_bom)
#define XCODING_SYSTEM_UNICODE_NEED_BOM(codesys) \
CODING_SYSTEM_UNICODE_NEED_BOM (XCODING_SYSTEM (codesys))
+#define CODING_SYSTEM_UNICODE_ALLOW_PRIVATE(codesys) \
+ (CODING_SYSTEM_TYPE_DATA (codesys, unicode)->allow_private)
+#define XCODING_SYSTEM_UNICODE_ALLOW_PRIVATE(codesys) \
+ CODING_SYSTEM_UNICODE_ALLOW_PRIVATE (XCODING_SYSTEM (codesys))
static const struct memory_description unicode_coding_system_description[] = {
{ XD_END }
@@ -2777,7 +2782,7 @@
void
decode_utf_8 (struct unicode_coding_stream *data, unsigned_char_dynarr *dst,
- UExtbyte c, int ignore_bom, int allow_private)
+ UExtbyte c, int ignore_bom, Boolint allow_private)
{
if (0 == data->counter)
{
@@ -2942,7 +2947,8 @@
unsigned_char_dynarr *dst,
enum unicode_encoding_type type,
int little_endian,
- int preserve_error_characters)
+ Boolint preserve_error_characters,
+ Boolint allow_private)
{
int err = 0;
if (code == -1)
@@ -3024,11 +3030,25 @@
register int bytes;
register unsigned char *dstp;
+ reconsider_length:
if (code <= 0x7ff) bytes = 2;
else if (code <= 0xffff) bytes = 3;
- else if (code <= 0x1fffff) bytes = 4;
- else if (code <= 0x3ffffff) bytes = 5;
- else bytes = 6;
+ else if (code <= UNICODE_OFFICIAL_MAX) bytes = 4;
+ else if (allow_private)
+ {
+ if (code <= 0x1fffff) bytes = 4;
+ else if (code <= 0x3ffffff) bytes = 5;
+ else bytes = 6;
+ }
+ else
+ {
+ /* Not valid Unicode. Pass the replacement char (U+FFFD). */
+ handle_encoding_error_before_output (str, src, dst, 1,
+ CODING_UNENCODABLE);
+ err = -1;
+ code = CANT_CONVERT_CHAR_WHEN_ENCODING_UNICODE;
+ goto reconsider_length;
+ }
Dynarr_add_many (dst, 0, bytes);
dstp = Dynarr_past_lastp (dst);
@@ -3091,6 +3111,7 @@
int little_endian =
XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (str->codesys);
int ignore_bom = XCODING_SYSTEM_UNICODE_NEED_BOM (str->codesys);
+ Boolint allow_private = XCODING_SYSTEM_UNICODE_ALLOW_PRIVATE (str->codesys);
Bytecount orign = n;
int counter = data->counter;
@@ -3103,7 +3124,7 @@
while (n--)
{
UExtbyte c = *src++;
- decode_utf_8 (data, dst, c, ignore_bom, 0);
+ decode_utf_8 (data, dst, c, ignore_bom, allow_private);
}
counter = data->counter;
ch = data->ch;
@@ -3339,6 +3360,8 @@
XCODING_SYSTEM_UNICODE_TYPE (str->codesys);
int little_endian =
XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (str->codesys);
+ const Boolint allow_private
+ = XCODING_SYSTEM_UNICODE_ALLOW_PRIVATE (str->codesys);
const Ibyte *srcend = src + n;
#ifdef ENABLE_COMPOSITE_CHARS
@@ -3353,8 +3376,9 @@
if (XCODING_SYSTEM_UNICODE_NEED_BOM (str->codesys) && !data->wrote_bom)
{
- assert (encode_unicode_to_dynarr (0xFEFF, str, src, dst, type,
- little_endian, 0) >= 0);
+ text_checking_assert (encode_unicode_to_dynarr (0xFEFF, str, src, dst,
+ type, little_endian,
+ 0, allow_private) >= 0);
data->wrote_bom = 1;
}
@@ -3366,8 +3390,10 @@
if (byte_ascii_p (c))
#endif /* MULE */
{
- assert (encode_unicode_to_dynarr (c, str, src, dst, type,
- little_endian, 0) >= 0);
+ text_checking_assert (encode_unicode_to_dynarr (c, str, src, dst,
+ type, little_endian,
+ 0, allow_private)
+ >= 0);
src++;
}
#ifdef MULE
@@ -3383,7 +3409,7 @@
#ifdef UNICODE_INTERNAL
if (encode_unicode_to_dynarr (ich, str, src, dst, type,
- little_endian, 0) < 0)
+ little_endian, 0, allow_private) < 0)
{
ENCODING_ERROR_RETURN_OR_CONTINUE (str, src);
}
@@ -3398,7 +3424,8 @@
/* #### Bother! We don't know how to
handle this yet. */
encode_unicode_to_dynarr (-1, str, src, dst,
- type, little_endian, 0);
+ type, little_endian, 0,
+ allow_private);
ENCODING_ERROR_RETURN_OR_CONTINUE (str, src);
}
else
@@ -3423,7 +3450,8 @@
charset_codepoint_to_unicode
(charset, c1, c2, CONVERR_FAIL);
if (encode_unicode_to_dynarr (code, str, src, dst, type,
- little_endian, 0) < 0)
+ little_endian, 0,
+ allow_private) < 0)
{
ENCODING_ERROR_RETURN_OR_CONTINUE (str, src);
}
@@ -3807,6 +3835,8 @@
XCODING_SYSTEM_UNICODE_LITTLE_ENDIAN (codesys) = !NILP (value);
else if (EQ (key, Qneed_bom))
XCODING_SYSTEM_UNICODE_NEED_BOM (codesys) = !NILP (value);
+ else if (EQ (key, Qallow_private))
+ XCODING_SYSTEM_UNICODE_ALLOW_PRIVATE (codesys) = !NILP (value);
else
return 0;
return 1;
@@ -3844,6 +3874,8 @@
write_ascstring (printcharfun, ", little-endian");
if (XCODING_SYSTEM_UNICODE_NEED_BOM (cs))
write_ascstring (printcharfun, ", need-bom");
+ if (XCODING_SYSTEM_UNICODE_ALLOW_PRIVATE (cs))
+ write_ascstring (printcharfun, ", allow-private");
write_ascstring (printcharfun, ")");
}
@@ -3918,6 +3950,7 @@
DEFSYMBOL (Qutf_7);
DEFSYMBOL (Qneed_bom);
+ DEFSYMBOL (Qallow_private);
DEFSYMBOL (Qutf_16);
DEFSYMBOL (Qutf_16_little_endian);
diff -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 -r 32aa4c87fa7f91e059717f5a88300469d7c3e9d7 src/unicode.h
--- a/src/unicode.h
+++ b/src/unicode.h
@@ -94,10 +94,11 @@
unsigned_char_dynarr *dst,
enum unicode_encoding_type type,
int little_endian,
- int preserve_error_characters);
+ Boolint preserve_error_characters,
+ Boolint allow_private);
void decode_utf_8 (struct unicode_coding_stream *data,
unsigned_char_dynarr *dst, UExtbyte c, int ignore_bom,
- int allow_private);
+ Boolint allow_private);
void decode_unicode_to_dynarr (int ucs, unsigned_char_dynarr *dst);
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/cc-mode: acm: Fix a "wrong side of point" error in CC Mode.
Fixes bug #28850.
7 years, 2 months
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/commits/92de7b41bfc9/
Changeset: 92de7b41bfc9
User: acm
Date: 2017-10-25 17:59:54+00:00
Summary: Fix a "wrong side of point" error in CC Mode. Fixes bug #28850.
The cause was a scanning over a bracket pair taking us beyond the supplied
LIMIT parameter in c-forward-declarator.
* cc-engine.el (c-forward-declarator): Add three checks (< (point) limit)
whilst dealing with tokens after the declared identifier.
* cc-fonts.el (c-font-lock-declarators): Don't supply a LIMIT argument to
`c-forward-declarator' (twice), since we want to fontify up till the end of a
declarator, not an arbitrary jit-lock chunk end.
Affected #: 2 files
diff -r e8b41be48ec5204df18d51eca0924527e82d8ee1 -r 92de7b41bfc97db49178d2f7317ce6583584ed94 cc-engine.el
--- a/cc-engine.el
+++ b/cc-engine.el
@@ -8123,12 +8123,14 @@
;; initializing brace lists.
(let (found)
(while
- (and (progn
+ (and (< (point) limit)
+ (progn
;; In the next loop, we keep searching forward whilst
;; we find ":"s which aren't single colons inside C++
;; "for" statements.
(while
(and
+ (< (point) limit)
(setq found
(c-syntactic-re-search-forward
"[;:,]\\|\\s)\\|\\(=\\|\\s(\\)"
@@ -8150,7 +8152,7 @@
(c-go-up-list-forward))
(setq brackets-after-id t))
(when found (backward-char))
- t))
+ (<= (point) limit)))
(list id-start id-end brackets-after-id (match-beginning 1) decorated)
(goto-char here)
diff -r e8b41be48ec5204df18d51eca0924527e82d8ee1 -r 92de7b41bfc97db49178d2f7317ce6583584ed94 cc-fonts.el
--- a/cc-fonts.el
+++ b/cc-fonts.el
@@ -1062,7 +1062,7 @@
;; The following `while' fontifies a single declarator id each time round.
;; It loops only when LIST is non-nil.
(while
- (and pos (setq decl-res (c-forward-declarator limit)))
+ (and pos (setq decl-res (c-forward-declarator)))
(setq next-pos (point)
id-start (car decl-res)
id-face (if (and (eq (char-after) ?\()
@@ -1091,7 +1091,7 @@
(throw 'is-function nil))
((not (eq got-type 'maybe))
(throw 'is-function t)))
- (c-forward-declarator limit t)
+ (c-forward-declarator nil t)
(eq (char-after) ?,))
(forward-char)
(c-forward-syntactic-ws))
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/time: kehoea: Handle mixed TTY and window-system XEmacs better,
don't pollute lossage, time.el
7 years, 2 months
Bitbucket
1 new commit in time:
https://bitbucket.org/xemacs/time/commits/7daf4c73004f/
Changeset: 7daf4c73004f
User: kehoea
Date: 2017-10-24 19:03:13+00:00
Summary: Handle mixed TTY and window-system XEmacs better, don't pollute lossage, time.el
ChangeLog addition:
2017-10-24 Aidan Kehoe <kehoea(a)parhasard.net>
* time.el:
* time.el (display-time-mail-file):
* time.el (display-time-insinuated): Moved earlier in the file.
* time.el (display-time-mail-sign-string):
* time.el (display-time-compatible): Removed.
* time.el (load-conversion-table):
* time.el (display-time-glyph-table): New.
* time.el (display-time-string-to-char-list): Removed.
* time.el (display-time-update-load-glyphs): New.
* time.el (xpm-color-symbols)): New.
* time.el (display-time-generate-time-glyphs):
* time.el (display-time-update-time-glyphs): New.
* time.el (display-time-insinuate):
* time.el (display-time-convert-num):
* time.el (display-time-convert-am-pm):
* time.el (display-time-init-glyphs): Removed.
* time.el (display-time-generate-mail-glyphs): New.
* time.el (display-time-can-do-graphical-display): Removed.
* time.el (display-time-mail-sign):
* time.el (display-time-no-mail-sign):
* time.el (display-time-convert-load): Removed.
* time.el (display-time-form-list):
* time.el (display-time-details): New.
* time.el (make-display-time-details): New.
* time.el (display-time-evaluate-list):
* time.el (display-time-function):
* time.el (display-time-string-forms): Removed.
Extensive changes to this file. Thematically:
1. Rework very amateur code that called #'eval at runtime to map
from a character to a glyph for the LED-type time display, use a
hash table instead.
2. Instead of explicitly checking in Lisp within
#'display-time-function for whether the current device can handle
graphics, and failing to give reasonable output when the modeline
is redisplayed on a TTY after being generated on a window-system,
use specifier tags, as is the correct approach on XEmacs. This
leads to simpler runtime code too.
3. Avoid using dynamic scope to communicate details of the current
time to called functions, define a struct instead and pass an
instance of that struct around.
4. Remove support for display-time-string-forms, long marked as
deprecated. This was a list of forms to be evalled, with the
performance and probably security drawbacks that implies.
5. When display-time-echo-area is t, don't log the output; this
avoids filling up what #'view-lossage shows with a new message
every minute, to the detriment of usability of that command.
Affected #: 2 files
diff -r e6d063da5d54876bcf3855c748b9d41453cb73d9 -r 7daf4c73004fd4f47ef260baebad26953f7e0f5e ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,53 @@
+2017-10-24 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * time.el:
+ * time.el (display-time-mail-file):
+ * time.el (display-time-insinuated): Moved earlier in the file.
+ * time.el (display-time-mail-sign-string):
+ * time.el (display-time-compatible): Removed.
+ * time.el (load-conversion-table):
+ * time.el (display-time-glyph-table): New.
+ * time.el (display-time-string-to-char-list): Removed.
+ * time.el (display-time-update-load-glyphs): New.
+ * time.el (xpm-color-symbols)): New.
+ * time.el (display-time-generate-time-glyphs):
+ * time.el (display-time-update-time-glyphs): New.
+ * time.el (display-time-insinuate):
+ * time.el (display-time-convert-num):
+ * time.el (display-time-convert-am-pm):
+ * time.el (display-time-init-glyphs): Removed.
+ * time.el (display-time-generate-mail-glyphs): New.
+ * time.el (display-time-can-do-graphical-display): Removed.
+ * time.el (display-time-mail-sign):
+ * time.el (display-time-no-mail-sign):
+ * time.el (display-time-convert-load): Removed.
+ * time.el (display-time-form-list):
+ * time.el (display-time-details): New.
+ * time.el (make-display-time-details): New.
+ * time.el (display-time-evaluate-list):
+ * time.el (display-time-function):
+ * time.el (display-time-string-forms): Removed.
+ Extensive changes to this file. Thematically:
+
+ 1. Rework very amateur code that called #'eval at runtime to map
+ from a character to a glyph for the LED-type time display, use a
+ hash table instead.
+ 2. Instead of explicitly checking in Lisp within
+ #'display-time-function for whether the current device can handle
+ graphics, and failing to give reasonable output when the modeline
+ is redisplayed on a TTY after being generated on a window-system,
+ use specifier tags, as is the correct approach on XEmacs. This
+ leads to simpler runtime code too.
+ 3. Avoid using dynamic scope to communicate details of the current
+ time to called functions, define a struct instead and pass an
+ instance of that struct around.
+ 4. Remove support for display-time-string-forms, long marked as
+ deprecated. This was a list of forms to be evalled, with the
+ performance and probably security drawbacks that implies.
+ 5. When display-time-echo-area is t, don't log the output; this
+ avoids filling up what #'view-lossage shows with a new message
+ every minute, to the detriment of usability of that command.
+
2014-05-15 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.16 released.
diff -r e6d063da5d54876bcf3855c748b9d41453cb73d9 -r 7daf4c73004fd4f47ef260baebad26953f7e0f5e time.el
--- a/time.el
+++ b/time.el
@@ -82,7 +82,6 @@
balloon-help must be loaded before these settings take effect."
:group 'display-time)
-
(defcustom display-time-mail-file nil
"*File name of mail inbox file, for indicating existence of new mail.
Non-nil and not a string means don't check for mail. nil means use
@@ -129,6 +128,8 @@
:group 'display-time
:type 'boolean)
+(defvar display-time-insinuated nil)
+
;;;###autoload
(defun display-time ()
"Display current time, load level, and mail flag in mode line of each buffer.
@@ -187,7 +188,7 @@
(defcustom display-time-mail-sign-string " Mail"
"The string used as mail indicator in the echo area
-(and in the modeline if display-time-show-icons-maybe is nil)
+\(and in the modeline if display-time-show-icons-maybe is nil)
if display-time-echo-area is t"
:group 'display-time
:type 'string)
@@ -355,251 +356,213 @@
(number :tag "Threshold 5")
(number :tag "Threshold 6")))
-(defcustom display-time-compatible nil
- "*This variable may be set to t to get the old behaviour of display-time.
-It should be considered obsolete and only be used if you really want the
-old behaviour (eq. you made extensive customizations yourself).
-This means no display of a spiffy mail icon or use of the
-display-time-form-list instead of the old display-time-string-form."
- :group 'display-time
- :type 'boolean)
+(defvar display-time-glyph-table (make-hash-table :test #'eq))
-(defun display-time-string-to-char-list (str)
- (mapcar (function identity) str))
+(defsubst display-time-update-load-glyphs ()
+ (if (not (equal display-time-display-pad display-time-display-pad-old))
+ (display-time-generate-load-glyphs)))
+
+(defvar xpm-color-symbols) ;; Silence bytecomp warnings.
-(defun display-time-generate-load-glyphs (&optional force)
- (let* ((pad-color (if (symbolp display-time-display-pad)
- (list "pad-color" '(face-background 'modeline))
- (list "pad-color" display-time-display-pad)))
- (xpm-color-symbols (append (list pad-color) xpm-color-symbols)))
- (if (and (featurep 'xpm)
- (or force (not (equal display-time-display-pad
- display-time-display-pad-old))))
- (progn
- (setq display-time-load-0.0-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-0.0.xpm"))))
- (setq display-time-load-0.5-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-0.5.xpm"))))
- (setq display-time-load-1.0-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-1.0.xpm"))))
- (setq display-time-load-1.5-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-1.5.xpm"))))
- (setq display-time-load-2.0-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-2.0.xpm"))))
- (setq display-time-load-2.5-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-2.5.xpm"))))
- (setq display-time-load-3.0-glyph
- (cons (make-extent nil nil)
- (make-glyph
- (concat display-time-icons-dir "l-3.0.xpm"))))
- (setq display-time-display-pad-old display-time-display-pad)
- ))))
+(symbol-macrolet
+ ((load-conversion-table [#:0.0 #:0.5 #:1.0 #:1.5 #:2.0 #:2.5 #:3.0 1000]))
+ (fset
+ 'display-time-generate-load-glyphs
+ #'(lambda ()
+ (let* ((xpm-color-symbols (cons `("pad-color"
+ ,(if (symbolp
+ display-time-display-pad)
+ '(face-background 'modeline)
+ display-time-display-pad))
+ (if (featurep 'xpm)
+ xpm-color-symbols))))
+ (macrolet
+ ((make-load-glyphs (&rest alist)
+ (cons
+ 'setf
+ (loop for (index string fallback) in alist
+ append
+ `((gethash (aref load-conversion-table ,index)
+ display-time-glyph-table)
+ (cons (make-extent nil nil)
+ (make-glyph `((global
+ ,@(when (featurep 'xpm)
+ `((win
+ .
+ [xpm :file
+ ,(concat
+ display-time-icons-dir
+ ,(concat string
+ ".xpm"))])))
+ ,,(or fallback
+ `(vector
+ 'string :data
+ (concat
+ " "
+ (number-to-string
+ (elt
+ display-time-load-list
+ ,index))))))))))))))
+ (make-load-glyphs (0 "l-0.0") (1 "l-0.5") (2 "l-1.0")
+ (3 "l-1.5") (4 "l-2.0") (5 "l-2.5")
+ (6 "l-3.0"
+ (vector 'string :data
+ (format ">%f"
+ (elt display-time-load-list
+ 5))))))
+ (setf display-time-display-pad-old
+ display-time-display-pad))))
+ (fset
+ 'display-time-convert-load
+ #'(lambda (load-string &optional textual)
+ (if display-time-echo-area
+ (concat " " load-string)
+ (display-time-update-load-glyphs)
+ (gethash (aref load-conversion-table
+ (or (position (string-to-number load-string)
+ display-time-load-list :test #'<)
+ (1- (length load-conversion-table))))
+ display-time-glyph-table)))))
+(defsubst display-time-update-time-glyphs ()
+ (when (or (not (equal display-time-display-time-background
+ display-time-display-time-bg-old))
+ (not (equal display-time-display-time-foreground
+ display-time-display-time-fg-old)))
+ (display-time-generate-time-glyphs)))
-(defun display-time-generate-time-glyphs (&optional force)
- (let* ((ledbg (if (symbolp display-time-display-time-background)
- (list "ledbg" '(face-background 'modeline))
- (list "ledbg" display-time-display-time-background)))
- (ledfg (if (symbolp display-time-display-time-foreground)
- (list "ledfg" '(face-foreground 'modeline))
- (list "ledfg" display-time-display-time-foreground)))
- (xpm-color-symbols (append (list ledbg)
- (list ledfg) xpm-color-symbols)))
- (if (and (featurep 'xpm)
- (or force (not (equal display-time-display-time-background
- display-time-display-time-bg-old))
- (not (equal display-time-display-time-foreground
- display-time-display-time-fg-old))))
- (progn
- (setq display-time-1-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "1.xpm"))))
- (setq display-time-2-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "2.xpm"))))
- (setq display-time-3-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "3.xpm"))))
- (setq display-time-4-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "4.xpm"))))
- (setq display-time-5-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "5.xpm"))))
- (setq display-time-6-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "6.xpm"))))
- (setq display-time-7-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "7.xpm"))))
- (setq display-time-8-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "8.xpm"))))
- (setq display-time-9-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "9.xpm"))))
- (setq display-time-0-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "0.xpm"))))
- (setq display-time-:-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "dp.xpm"))))
- (setq display-time-am-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "am.xpm"))))
- (setq display-time-pm-glyph
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "pm.xpm"))))
- (setq display-time-display-time-fg-old
- display-time-display-time-foreground
- display-time-display-time-bg-old
- display-time-display-time-background)
- ))))
+(defun display-time-generate-time-glyphs ()
+ (let* ((xpm-color-symbols (list*
+ `("ledbg"
+ ,(if (symbolp
+ display-time-display-time-background)
+ '(face-background 'modeline)
+ display-time-display-time-background))
+ `("ledfg"
+ ,(if (symbolp
+ display-time-display-time-foreground)
+ '(face-foreground 'modeline)
+ display-time-display-time-foreground))
+ (if (featurep 'xpm) xpm-color-symbols))))
+ (macrolet
+ ((make-digit-glyphs (&rest digits)
+ (cons
+ 'setf
+ (loop for key in digits
+ append `((gethash ,key display-time-glyph-table)
+ (cons (make-extent nil nil)
+ (make-glyph `((global
+ ,@(when
+ (featurep 'xpm)
+ `((win
+ .
+ [xpm :file
+ ,(concat
+ display-time-icons-dir
+ ,(format "%c.xpm"
+ key))])))
+ ,,(vector 'string :data
+ (format "%c" key))))))))))
+ (make-other-glyphs (&rest alist)
+ (cons
+ 'setf
+ (loop for (key . string) in alist
+ append `((gethash ,key display-time-glyph-table)
+ (cons (make-extent nil nil)
+ (make-glyph `((global
+ ,@(when
+ (featurep 'xpm)
+ `((win
+ .
+ [xpm :file
+ ,(concat
+ display-time-icons-dir
+ ,(concat string
+ ".xpm"))])))
+ ,,(vector
+ 'string :data
+ (concat " "
+ (upcase
+ string))))))))))))
+ (make-digit-glyphs ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?0)
+ (make-other-glyphs ('am . "am") ('pm . "pm")))
+ (setf (gethash ?: display-time-glyph-table)
+ (cons (make-extent nil nil)
+ (make-glyph `((global
+ ,@(when (featurep 'xpm)
+ `((win . [xpm :file
+ ,(concat
+ display-time-icons-dir
+ "dp.xpm")])))
+ [string :data ":"]))))
+ display-time-display-time-fg-old
+ display-time-display-time-foreground
+ display-time-display-time-bg-old
+ display-time-display-time-background)))
-(defun display-time-init-glyphs ()
- "This is a hack to have all glyphs be displayed one time at startup.
-It helps avoiding problems with the background color of the glyphs if a
-balloon-help frame is open and a not yet displayed glyph is going to be
-displayed."
- (let ((i 0)
- (list '("am" "pm" ":"))
- elem mlist)
- (while (< i 10)
- (push (eval (intern-soft (concat "display-time-"
- (number-to-string i)
- "-glyph"))) mlist)
- (setq i (1+ i)))
- (setq i 0.0)
- (while (<= i 3.0)
- (push (eval (intern-soft (concat "display-time-load-"
- (number-to-string i)
- "-glyph"))) mlist)
- (setq i (+ i 0.5)))
- (while (setq elem (pop list))
- (push (eval (intern-soft (concat "display-time-"
- elem "-glyph"))) mlist))
- (let ((global-mode-string mlist))
- (redisplay-frame))
- ))
-
-(defvar display-time-insinuated nil)
+(defun display-time-generate-mail-glyphs ()
+ (setf (gethash 'mail display-time-glyph-table)
+ (cons (let ((extent (make-extent nil nil)))
+ (setf (extent-property extent 'balloon-help)
+ 'display-time-mail-balloon)
+ extent)
+ (make-glyph
+ `((global
+ ,@(when (featurep 'xpm)
+ `((win . [xpm :file ,(concat display-time-icons-dir
+ "letter.xpm")])))
+ [string :data ,display-time-mail-sign-string]))))
+ (gethash 'no-mail display-time-glyph-table)
+ (cons (let ((extent (make-extent nil nil)))
+ (setf (extent-property extent 'balloon-help)
+ display-time-no-mail-balloon) ;; Yes, not a symbol.
+ extent)
+ (make-glyph
+ `((global
+ ,@(when (featurep 'xpm)
+ `((win . [xpm :file ,(concat display-time-icons-dir
+ "no-letter.xpm")])))
+ [string :data
+ ,(if (> (length display-time-no-mail-sign-string) 0)
+ (concat " " display-time-no-mail-sign-string)
+ display-time-no-mail-sign-string)]))))))
;; This used to be at top-level!
(defun display-time-insinuate ()
- (when (featurep 'xpm)
- (defvar display-time-mail-sign
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "letter.xpm"))))
- (set-extent-property (car display-time-mail-sign) 'balloon-help
- 'display-time-mail-balloon)
-;;; (set-extent-keymap (car display-time-mail-sign)
-;;; display-time-keymap)
- (defvar display-time-no-mail-sign
- (cons (make-extent nil nil)
- (make-glyph (concat display-time-icons-dir "no-letter.xpm"))))
- (set-extent-property (car display-time-no-mail-sign) 'balloon-help
- display-time-no-mail-balloon)
;;; (set-extent-keymap (car display-time-no-mail-sign)
;;; display-time-keymap)
- (defvar display-time-1-glyph nil)
- (defvar display-time-2-glyph nil)
- (defvar display-time-3-glyph nil)
- (defvar display-time-4-glyph nil)
- (defvar display-time-5-glyph nil)
- (defvar display-time-6-glyph nil)
- (defvar display-time-7-glyph nil)
- (defvar display-time-8-glyph nil)
- (defvar display-time-9-glyph nil)
- (defvar display-time-0-glyph nil)
- (defvar display-time-:-glyph nil)
- (defvar display-time-am-glyph nil)
- (defvar display-time-pm-glyph nil)
- (defvar display-time-load-0.0-glyph nil)
- (defvar display-time-load-0.5-glyph nil)
- (defvar display-time-load-1.0-glyph nil)
- (defvar display-time-load-1.5-glyph nil)
- (defvar display-time-load-2.0-glyph nil)
- (defvar display-time-load-2.5-glyph nil)
- (defvar display-time-load-3.0-glyph nil)
- (display-time-generate-time-glyphs 'force)
- (display-time-generate-load-glyphs 'force)
- (display-time-init-glyphs)
- (sit-for 0))
+ (display-time-generate-time-glyphs)
+ (display-time-generate-load-glyphs)
+ (display-time-generate-mail-glyphs)
+ (sit-for 0)
(setq display-time-insinuated t))
+(defun display-time-convert-num (time-string balloon-help help-echo)
+ (if display-time-echo-area
+ time-string
+ (display-time-update-time-glyphs)
+ (loop for character across time-string
+ for glyph = (gethash character display-time-glyph-table)
+ then (gethash character display-time-glyph-table)
+ collect (prog1
+ glyph
+ (setf (extent-property (car glyph) 'balloon-help)
+ balloon-help
+ (extent-property (car glyph) 'help-echo)
+ help-echo)))))
-(defun display-time-can-do-graphical-display (&optional textual)
- (and display-time-show-icons-maybe
- (not textual)
- (console-on-window-system-p)
- (featurep 'xpm)
- (not display-time-echo-area)))
-
-
-(defun display-time-convert-num (time-string &optional textual)
- (let ((list (display-time-string-to-char-list time-string))
- elem tmp balloon-help balloon-ext)
- (if (not (display-time-can-do-graphical-display textual)) time-string
- (display-time-generate-time-glyphs)
- (setq balloon-help
- (format "%s, %s %s %s %s" dayname day monthname year
- (concat " Average load:"
- (if (not (equal load ""))
- load
- " 0"))))
- (setq balloon-ext (make-extent 0 (length balloon-help) balloon-help))
- (set-extent-property balloon-ext 'face 'display-time-time-balloon-face)
- (set-extent-property balloon-ext 'duplicable 't)
- (while (setq elem (pop list))
- (setq elem
- (eval (intern-soft (concat "display-time-"
- (char-to-string elem)
- "-glyph"))))
- (set-extent-property (car elem) 'balloon-help balloon-help)
- (set-extent-property (car elem) 'help-echo
- (format "%s, %s %s %s"
- dayname day monthname year))
-;;; (set-extent-keymap (car elem) display-time-keymap)
- (push elem tmp))
- (reverse tmp))))
-
-(defun display-time-convert-load (load-string &optional textual)
- (let ((load-number (string-to-number load-string))
- (alist (list (cons 0.0 0.0)
- (cons 0.5 (car display-time-load-list))
- (cons 1.0 (cadr display-time-load-list))
- (cons 1.5 (caddr display-time-load-list))
- (cons 2.0 (cadddr display-time-load-list))
- (cons 2.5 (cadr (cdddr display-time-load-list)))
- (cons 3.0 (caddr (cdddr display-time-load-list)))
- (cons 100000 100000)))
- elem load-elem)
- (if (not (display-time-can-do-graphical-display textual))
- load-string
- (display-time-generate-load-glyphs)
- (while (>= load-number (cdr (setq elem (pop alist))))
- (setq load-elem elem))
- (eval (intern-soft (concat "display-time-load-"
- (number-to-string (car load-elem))
- "-glyph"))))))
-
-(defun display-time-convert-am-pm (ampm-string &optional textual)
- (if (not (display-time-can-do-graphical-display textual))
- ampm-string
- (cond ((equal ampm-string "am") display-time-am-glyph)
- ((equal ampm-string "pm") display-time-pm-glyph))))
+(defun display-time-convert-am-pm (ampm-string balloon-help help-echo)
+ (if display-time-echo-area
+ (concat " " ampm-string)
+ (let ((glyph (gethash (if (equal ampm-string "PM") 'pm 'am)
+ display-time-glyph-table)))
+ (if glyph
+ (prog1
+ glyph
+ (setf (extent-property (car glyph) 'balloon-help)
+ balloon-help
+ (extent-property (car glyph) 'help-echo)
+ help-echo))))))
(defun display-time-mail-balloon (&rest ciao)
(let* ((mail-spool-file (or display-time-mail-file
@@ -784,33 +747,29 @@
)))
-(defun display-time-mail-sign (&optional textual)
+(defsubst display-time-mail-sign ()
"*A function giving back the object indicating 'mail' which
is the value of display-time-mail-sign when running under X,
-display-time-echo-area is nil and display-time-show-icons-maybe is t.
-It is the value of display-time-mail-sign-string otherwise or when
-the optional parameter TEXTUAL is non-nil."
- (if (not (display-time-can-do-graphical-display textual))
- display-time-mail-sign-string
- (list " " display-time-mail-sign " ")))
+display-time-echo-area is nil and display-time-show-icons-maybe is t."
+ (if display-time-echo-area
+ (concat " " display-time-mail-sign-string)
+ (list " " (gethash 'mail display-time-glyph-table) " ")))
-(defun display-time-no-mail-sign (&optional textual)
+(defsubst display-time-no-mail-sign ()
"*A function giving back the object indicating 'no mail' which
is the value of display-time-no-mail-sign when running under X,
display-time-echo-area is nil and display-time-show-icons-maybe is t.
It is the value of display-time-no-mail-sign-string otherwise or when
the optional parameter TEXTUAL is non-nil."
- (if (not (display-time-can-do-graphical-display textual))
- display-time-no-mail-sign-string
- (list " " display-time-no-mail-sign " ")))
+ (if display-time-echo-area
+ (concat " " display-time-no-mail-sign-string)
+ (list " " (gethash 'no-mail display-time-glyph-table) " ")))
(defcustom display-time-form-list
(list 'date 'time 'load 'mail)
"*This list describes the format of the strings/glyphs
which are to be displayed by display-time.
-The old variable display-time-string-forms is only used if
-display-time-compatible is non-nil. It is a list consisting of
-strings or any of the following symbols:
+The list comprises strings or any of the following symbols:
There are three complex specs whose behaviour is changed via
the setting of various variables
@@ -897,108 +856,131 @@
(const :tag "Mail sign (text)" mail-text)
(string :tag "String"))))
-(defun display-time-evaluate-list ()
+(defstruct (display-time-details (:constructor nil))
+ 24-hours hour 12-hours am-pm minutes seconds time-zone day month monthname
+ year dayname)
+
+(defun make-display-time-details (&optional time)
+ (read
+ (format-time-string
+ "[cl-struct-display-time-details \"%H\" ;; 24-hours
+%k ;; Hour
+\"%I\" ;; 12 hours
+\"%p\" ;; am-pm
+\"%M\" ;; minutes
+\"%S\" ;; seconds
+\"%Z\" ;; time-zone
+\"%d\" ;; day
+\"%m\" ;; month
+\"%b\" ;; monthname (abbreviated)
+\"%Y\" ;; year
+\"%a\"] ;; dayname " time)))
+
+(defun display-time-evaluate-list (details load mail)
"Evaluate the variable display-time-form-list"
- (let ((list display-time-form-list) elem tmp result)
- (while (setq elem (pop list))
+ (let* ((help-echo (format "%s, %s %s %s"
+ (display-time-details-dayname details)
+ (display-time-details-day details)
+ (display-time-details-monthname details)
+ (display-time-details-year details)))
+ (balloon-help (concat help-echo " Average load:"
+ (if (not (equal load "")) load " 0")))
+ (balloon-ext (make-extent 0 (length balloon-help) balloon-help))
+ tmp)
+ (setf (extent-property balloon-ext 'face)
+ 'display-time-time-balloon-face
+ (extent-property balloon-ext 'duplicable) t)
+ (dolist (elem display-time-form-list)
(cond ((stringp elem) (push elem tmp))
((eq elem 'date)
(push (if display-time-day-and-date
- (format "%s %s %s " dayname monthname day) "") tmp))
+ (concat (display-time-details-dayname details)
+ (display-time-details-monthname details)
+ (display-time-details-day details)
+ " ")
+ "") tmp))
((eq elem 'time)
(progn
(push (display-time-convert-num
- (format "%s:%s"
- (if display-time-24hr-format 24-hours 12-hours)
- minutes)) tmp)
+ (concat (if display-time-24hr-format
+ (display-time-details-24-hours details)
+ (display-time-details-12-hours details))
+ ":" (display-time-details-minutes details))
+ balloon-help help-echo)
+ tmp)
(if (not display-time-24hr-format)
- (push (display-time-convert-am-pm am-pm) tmp))))
+ (push (display-time-convert-am-pm
+ (display-time-details-am-pm details)
+ balloon-help help-echo) tmp))))
((eq elem 'time-text)
- (push (display-time-convert-num
- (format "%s:%s"
- (if display-time-24hr-format 24-hours 12-hours)
- minutes) t) tmp)
+ (push (concat (if display-time-24hr-format
+ (display-time-details-24-hours details)
+ (display-time-details-12-hours details))
+ ":" (display-time-details-minutes details))
+ tmp)
(if (not display-time-24hr-format)
- (push (display-time-convert-am-pm am-pm t) tmp)))
- ((eq elem 'day) (push day tmp))
- ((eq elem 'dayname) (push dayname tmp))
- ((eq elem 'month) (push month tmp))
- ((eq elem 'monthname) (push monthname tmp))
+ (push (display-time-convert-am-pm
+ (display-time-details-am-pm details)
+ balloon-help help-echo) tmp)))
+ ((eq elem 'day) (push (display-time-details-day details) tmp))
+ ((eq elem 'dayname)
+ (push (display-time-details-dayname details) tmp))
+ ((eq elem 'month) (push (display-time-details-month details) tmp))
+ ((eq elem 'monthname)
+ (push (display-time-details-monthname details) tmp))
((eq elem '24-hours)
- (push (display-time-convert-num 24-hours) tmp))
+ (push (display-time-convert-num
+ (display-time-details-24-hours details)
+ balloon-help help-echo) tmp))
((eq elem 'year)
- (push year tmp))
+ (push (display-time-details-year details) tmp))
((eq elem '24-hours-text)
- (push (display-time-convert-num 24-hours t) tmp))
+ (push (display-time-details-24-hours details) tmp))
((eq elem '12-hours)
- (push (display-time-convert-num 12-hours) tmp))
+ (push (display-time-convert-num
+ (display-time-details-12-hours details)
+ balloon-help help-echo) tmp))
((eq elem '12-hours-text)
- (push (display-time-convert-num 12-hours t) tmp))
+ (push (display-time-details-12-hours details) tmp))
((eq elem 'minutes)
- (push (display-time-convert-num minutes) tmp))
+ (push (display-time-convert-num
+ (display-time-details-minutes details)
+ balloon-help help-echo) tmp))
+ ((eq elem 'minutes-text)
+ (push (display-time-details-minutes details) tmp))
((eq elem 'seconds)
- (push (display-time-convert-num seconds) tmp))
- ((eq elem 'minutes-text)
- (push (display-time-convert-num minutes t) tmp))
+ (push (display-time-convert-num
+ (display-time-details-seconds details)
+ balloon-help help-echo) tmp))
((eq elem 'am-pm)
- (push (display-time-convert-am-pm am-pm) tmp))
+ (push (display-time-convert-am-pm
+ (display-time-details-am-pm details)
+ balloon-help help-echo) tmp))
((eq elem 'am-pm-text)
- (push (display-time-convert-am-pm am-pm t) tmp))
+ (push (display-time-details-am-pm details) tmp))
((eq elem 'timezone)
- (push time-zone tmp))
+ (push (display-time-details-time-zone details) tmp))
((eq elem 'load)
(push (display-time-convert-load load) tmp))
((eq elem 'load-text)
- (push (display-time-convert-load load t) tmp))
+ (push load tmp))
((eq elem 'mail)
(push (if mail (display-time-mail-sign)
(display-time-no-mail-sign)) tmp))
((eq elem 'mail-text)
- (push (if mail (display-time-mail-sign t)
- (display-time-no-mail-sign t)) tmp))
- ))
+ (push (if mail
+ display-time-mail-sign-string
+ display-time-no-mail-sign-string) tmp))))
;; We know that we have a list containing only of strings if
;; display-time-echo-area is t. So we construct this string from
;; the list. Else we just reverse the list and give it as result.
- (if (not display-time-echo-area) (setq result (reverse tmp))
- (while (setq elem (pop tmp))
- (setq result (concat elem result))))
- result))
-
-
-(defvar display-time-string-forms
- '((if display-time-day-and-date
- (format "%s %s %s " dayname monthname day)
- "")
- (format "%s:%s%s"
- (if display-time-24hr-format 24-hours 12-hours)
- minutes
- (if display-time-24hr-format "" am-pm))
- load
- (if mail " Mail" ""))
- "*It will only be used if display-time-compatible is t.
-A list of expressions governing display of the time in the mode line.
-This expression is a list of expressions that can involve the keywords
-`load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
-`seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
-and `time-zone' all alphabetic strings and `mail' a true/nil string value.
-
-For example, the form
-
- '((substring year -2) \"/\" month \"/\" day
- \" \" 24-hours \":\" minutes \":\" seconds
- (if time-zone \" (\") time-zone (if time-zone \")\"))
-
-would give mode line times like `94/12/30 21:07:48 (UTC)'.")
-
-(make-obsolete-variable 'display-time-string-forms
- "You should use the new facilities for `display-time'.
-Look at display-time-form-list.")
+ (setq tmp (nreverse tmp))
+ (if display-time-echo-area (mapconcat #'identity tmp "") tmp)))
(defun display-time-function ()
(let* ((now (current-time))
(nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536))
- (time (current-time-string now))
+ (display-time-details (make-display-time-details now))
(load (condition-case ()
(if (zerop (car (load-average))) ""
(let ((str (format " %03d" (car (load-average)))))
@@ -1027,42 +1009,22 @@
(setq display-time-server-down-time
(+ (nth 1 now) nowhigh))
;; Record that mail file is accessible.
- (setq display-time-server-down-time nil))))))
- (24-hours (substring time 11 13))
- (hour (string-to-int 24-hours))
- (12-hours (int-to-string (1+ (% (+ hour 11) 12))))
- (am-pm (if (>= hour 12) "pm" "am"))
- (minutes (substring time 14 16))
- (seconds (substring time 17 19))
- (time-zone (car (cdr (current-time-zone now))))
- (day (substring time 8 10))
- (year (substring time 20 24))
- (monthname (substring time 4 7))
- (month
- (cdr
- (assoc
- monthname
- '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
- ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
- ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
- (dayname (substring time 0 3)))
+ (setq display-time-server-down-time nil)))))))
(setq display-time-string
- (if display-time-compatible
- (mapconcat 'eval display-time-string-forms "")
- (display-time-evaluate-list)))
+ (display-time-evaluate-list display-time-details load mail))
;; This is inside the let binding, but we are not going to document
;; what variables are available.
(run-hooks 'display-time-hook))
(if display-time-echo-area
- (or (> (minibuffer-depth) 0)
- ;; don't stomp echo-area-buffer if reading from minibuffer now.
+ (or (> (minibuffer-depth) 0) ;; Don't stomp echo-area-buffer if reading
+ ;; from minibuffer now.
(save-excursion
(save-window-excursion
(select-window (minibuffer-window))
(erase-buffer)
- (indent-to (- (frame-width) (length display-time-string) 1))
- (insert display-time-string)
- (message (buffer-string)))))
+ (insert (format "%*s" (1- (frame-width)) display-time-string))
+ ;; Don't leave the time in view-lossage.
+ (display-message 'no-log (buffer-string)))))
(force-mode-line-update)
;; Do redisplay right now, if no input pending.
(sit-for 0)))
Repository URL: https://bitbucket.org/xemacs/time/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/cc-mode: acm: Refactor c-forward-token-2 with new function
c-forward-over-token-and-ws.
7 years, 2 months
Bitbucket
1 new commit in cc-mode:
https://bitbucket.org/xemacs/cc-mode/commits/e8b41be48ec5/
Changeset: e8b41be48ec5
User: acm
Date: 2017-10-22 13:55:40+00:00
Summary: Refactor c-forward-token-2 with new function c-forward-over-token-and-ws.
Use the new function directly in several places where c-forward-token-2
wouldn't move over the last token in the buffer. This caused an infinite loop
in c-restore-<>-properties.
* cc-engine.el (c-forward-over-token-and-ws): New function, extracted from
c-forward-token-2.
(c-forward-token-2): Refactor, calling the new function.
(c-restore-<>-properties): Fix infinite loop.
(c-forward-<>-arglist-recur, c-in-knr-argdecl)
(c-looking-at-or-maybe-in-bracelist): Call the new function directly in place
of c-forward-token-2.
* cc-cmds.el (c-defun-name) Call the new function directly in place of
c-forward-token-2.
* cc-fonts.el (c-font-lock-enclosing-decls): Call the new function directly in
place of c-forward-token-2.
Affected #: 3 files
diff -r 57b32f709a4f3f80c78071d67fec82b4cc629878 -r e8b41be48ec5204df18d51eca0924527e82d8ee1 cc-cmds.el
--- a/cc-cmds.el
+++ b/cc-cmds.el
@@ -1807,7 +1807,7 @@
;; struct, union, enum, or similar:
((looking-at c-type-prefix-key)
(let ((key-pos (point)))
- (c-forward-token-2 1) ; over "struct ".
+ (c-forward-over-token-and-ws) ; over "struct ".
(cond
((looking-at c-symbol-key) ; "struct foo { ..."
(buffer-substring-no-properties key-pos (match-end 0)))
diff -r 57b32f709a4f3f80c78071d67fec82b4cc629878 -r e8b41be48ec5204df18d51eca0924527e82d8ee1 cc-engine.el
--- a/cc-engine.el
+++ b/cc-engine.el
@@ -4305,6 +4305,47 @@
"\\w\\|\\s_\\|\\s\"\\|\\s|"
"\\w\\|\\s_\\|\\s\""))
+(defun c-forward-over-token-and-ws (&optional balanced)
+ "Move forward over a token and any following whitespace
+Return t if we moved, nil otherwise (i.e. we were at EOB, or a
+non-token or BALANCED is non-nil and we can't move). If we
+are at syntactic whitespace, move over this in place of a token.
+
+If BALANCED is non-nil move over any balanced parens we are at, and never move
+out of an enclosing paren.
+
+This function differs from `c-forward-token-2' in that it will move forward
+over the final token in a buffer, up to EOB."
+ (let ((jump-syntax (if balanced
+ c-jump-syntax-balanced
+ c-jump-syntax-unbalanced))
+ (here (point)))
+ (when
+ (condition-case nil
+ (cond
+ ((/= (point)
+ (progn (c-forward-syntactic-ws) (point)))
+ ;; If we're at whitespace, count this as the token.
+ t)
+ ((eobp) nil)
+ ((looking-at jump-syntax)
+ (goto-char (scan-sexps (point) 1))
+ t)
+ ((looking-at c-nonsymbol-token-regexp)
+ (goto-char (match-end 0))
+ t)
+ ((save-restriction
+ (widen)
+ (looking-at c-nonsymbol-token-regexp))
+ nil)
+ (t
+ (forward-char)
+ t))
+ (error (goto-char here)
+ nil))
+ (c-forward-syntactic-ws)
+ t)))
+
(defun c-forward-token-2 (&optional count balanced limit)
"Move forward by tokens.
A token is defined as all symbols and identifiers which aren't
@@ -4334,15 +4375,11 @@
(if (< count 0)
(- (c-backward-token-2 (- count) balanced limit))
- (let ((jump-syntax (if balanced
- c-jump-syntax-balanced
- c-jump-syntax-unbalanced))
- (last (point))
- (prev (point)))
-
- (if (zerop count)
- ;; If count is zero we should jump if in the middle of a token.
- (c-end-of-current-token))
+ (let ((here (point))
+ (last (point)))
+ (when (zerop count)
+ ;; If count is zero we should jump if in the middle of a token.
+ (c-end-of-current-token))
(save-restriction
(if limit (narrow-to-region (point-min) limit))
@@ -4356,43 +4393,15 @@
;; Moved out of bounds. Make sure the returned count isn't zero.
(progn
(if (zerop count) (setq count 1))
- (goto-char last))
-
- ;; Use `condition-case' to avoid having the limit tests
- ;; inside the loop.
- (condition-case nil
- (while (and
- (> count 0)
- (progn
- (setq last (point))
- (cond ((looking-at jump-syntax)
- (goto-char (scan-sexps (point) 1))
- t)
- ((looking-at c-nonsymbol-token-regexp)
- (goto-char (match-end 0))
- t)
- ;; `c-nonsymbol-token-regexp' above should always
- ;; match if there are correct tokens. Try to
- ;; widen to see if the limit was set in the
- ;; middle of one, else fall back to treating
- ;; the offending thing as a one character token.
- ((and limit
- (save-restriction
- (widen)
- (looking-at c-nonsymbol-token-regexp)))
- nil)
- (t
- (forward-char)
- t))))
- (c-forward-syntactic-ws)
- (setq prev last
- count (1- count)))
- (error (goto-char last)))
-
- (when (eobp)
- (goto-char prev)
- (setq count (1+ count)))))
-
+ (goto-char here))
+ (while (and
+ (> count 0)
+ (c-forward-over-token-and-ws balanced)
+ (not (eobp)))
+ (setq last (point)
+ count (1- count)))
+ (if (eobp)
+ (goto-char last))))
count)))
(defun c-backward-token-2 (&optional count balanced limit)
@@ -6437,7 +6446,8 @@
(not (eq (c-get-char-property (point) 'c-type)
'c-decl-arg-start)))))))
(or (c-forward-<>-arglist nil)
- (c-forward-token-2)))))
+ (c-forward-over-token-and-ws)
+ (goto-char c-new-END)))))
;; Functions to handle C++ raw strings.
@@ -7153,7 +7163,7 @@
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type))
- (c-forward-token-2))))
+ (c-forward-over-token-and-ws))))
(c-forward-syntactic-ws)
@@ -9731,8 +9741,8 @@
;; identifiers?
(progn
(goto-char before-lparen)
- (c-forward-token-2) ; to first token inside parens
(and
+ (c-forward-over-token-and-ws) ; to first token inside parens
(setq id-start (c-on-identifier)) ; Must be at least one.
(catch 'id-list
(while
@@ -9744,7 +9754,7 @@
ids)
(c-forward-syntactic-ws)
(eq (char-after) ?\,))
- (c-forward-token-2)
+ (c-forward-over-token-and-ws)
(unless (setq id-start (c-on-identifier))
(throw 'id-list nil)))
(eq (char-after) ?\)))))
@@ -10534,10 +10544,10 @@
((and after-type-id-pos
(save-excursion
(when (eq (char-after) ?\;)
- (c-forward-token-2 1 t))
+ (c-forward-over-token-and-ws t))
(setq bufpos (point))
(when (looking-at c-opt-<>-sexp-key)
- (c-forward-token-2)
+ (c-forward-over-token-and-ws)
(when (and (eq (char-after) ?<)
(c-get-char-property (point) 'syntax-table))
(c-go-list-forward nil after-type-id-pos)
diff -r 57b32f709a4f3f80c78071d67fec82b4cc629878 -r e8b41be48ec5204df18d51eca0924527e82d8ee1 cc-fonts.el
--- a/cc-fonts.el
+++ b/cc-fonts.el
@@ -1730,7 +1730,7 @@
(c-syntactic-skip-backward "^;{}" decl-search-lim)
(c-forward-syntactic-ws)
(setq in-typedef (looking-at c-typedef-key))
- (if in-typedef (c-forward-token-2))
+ (if in-typedef (c-forward-over-token-and-ws))
(when (and c-opt-block-decls-with-vars-key
(looking-at c-opt-block-decls-with-vars-key))
(goto-char ps-elt)
Repository URL: https://bitbucket.org/xemacs/cc-mode/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
commit/XEmacs: kehoea: Use elisp_maphash(), #'apropos-internal,
PREDICATE can call Lisp
7 years, 2 months
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/3fa6bfc3ea4b/
Changeset: 3fa6bfc3ea4b
User: kehoea
Date: 2017-10-19 05:47:13+00:00
Summary: Use elisp_maphash(), #'apropos-internal, PREDICATE can call Lisp
src/ChangeLog addition:
2017-10-19 Aidan Kehoe <kehoea(a)parhasard.net>
* symbols.c (Fapropos_internal):
PREDICATE can call Lisp, use elisp_maphash() instead of
elisp_maphash_unsafe() in this function.
Affected #: 2 files
diff -r 95a188885942f52fda8d85b7f132163a90fd8943 -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2017-10-19 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * symbols.c (Fapropos_internal):
+ PREDICATE can call Lisp, use elisp_maphash() instead of
+ elisp_maphash_unsafe() in this function.
+
2017-10-17 Aidan Kehoe <kehoea(a)parhasard.net>
* sequence.c (position):
diff -r 95a188885942f52fda8d85b7f132163a90fd8943 -r 3fa6bfc3ea4bb6bf9f2b354b9c5927232e23d7b0 src/symbols.c
--- a/src/symbols.c
+++ b/src/symbols.c
@@ -195,7 +195,7 @@
closure.predicate = predicate;
closure.accumulation = Qnil;
GCPRO1 (closure.accumulation);
- elisp_maphash_unsafe (apropos_mapper, package, &closure);
+ elisp_maphash (apropos_mapper, package, &closure);
closure.accumulation = list_sort (closure.accumulation,
check_string_lessp_nokey, Qnil, Qnil);
UNGCPRO;
Repository URL: https://bitbucket.org/xemacs/xemacs/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.