commit/XEmacs: kehoea: Use a face, show more context around open parenthesis, #'blink-matching-open
11 years
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/94a6b8fbd56e/
Changeset: 94a6b8fbd56e
User: kehoea
Date: 2013-12-17 19:49:52
Summary: Use a face, show more context around open parenthesis, #'blink-matching-open
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (blink-matching-open):
When showing the opening parenthesis in the minibiffer, use the
isearch face for it, in case there are multiple parentheses in the
text shown.
When writing moderately involved macros, it's often not enough
just to show the backquote context before the parenthesis
(e.g. ＠,.`). Skip over that when searching for useful context in
the same way we skip over space and tab.
* simple.el (message):
* simple.el (lmessage):
If there are no ARGS, don't call #'format. This allows extent
information to be passed through to the minibuffer.
It's probably better still to update #'format to preserve extent
info.
Affected #: 2 files
diff -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea -r 94a6b8fbd56e98dd8d90de2b793cea1c5fd21353 lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
＠＠ -1,3 +1,20 ＠＠
+2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * simple.el (blink-matching-open):
+ When showing the opening parenthesis in the minibiffer, use the
+ isearch face for it, in case there are multiple parentheses in the
+ text shown.
+ When writing moderately involved macros, it's often not enough
+ just to show the backquote context before the parenthesis
+ (e.g. ＠,.`). Skip over that when searching for useful context in
+ the same way we skip over space and tab.
+ * simple.el (message):
+ * simple.el (lmessage):
+ If there are no ARGS, don't call #'format. This allows extent
+ information to be passed through to the minibuffer.
+ It's probably better still to update #'format to preserve extent
+ info.
+
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
diff -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea -r 94a6b8fbd56e98dd8d90de2b793cea1c5fd21353 lisp/simple.el
--- a/lisp/simple.el
+++ b/lisp/simple.el
＠＠ -3304,9 +3304,10 ＠＠
(save-excursion
(save-restriction
(if blink-matching-paren-distance
- (narrow-to-region (max (point-min)
- (- (point) blink-matching-paren-distance))
- oldpos))
+ (narrow-to-region
+ (max (point-min)
+ (- (point) blink-matching-paren-distance))
+ oldpos))
(condition-case ()
(let ((parse-sexp-ignore-comments
(and parse-sexp-ignore-comments
＠＠ -3322,46 +3323,75 ＠＠
(matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
- (progn
- (goto-char blinkpos)
- (if (pos-visible-in-window-p)
- (and blink-matching-paren-on-screen
- (progn
- (auto-show-make-point-visible)
- (sit-for blink-matching-delay)))
- (goto-char blinkpos)
- (lmessage 'command "Matches %s"
- ;; Show what precedes the open in its line, if anything.
- (if (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (buffer-substring (progn (beginning-of-line) (point))
- (1+ blinkpos))
- ;; Show what follows the open in its line, if anything.
- (if (save-excursion
- (forward-char 1)
- (skip-chars-forward " \t")
- (not (eolp)))
- (buffer-substring blinkpos
- (progn (end-of-line) (point)))
- ;; Otherwise show the previous nonblank line,
- ;; if there is one.
- (if (save-excursion
- (skip-chars-backward "\n \t")
- (not (bobp)))
- (concat
- (buffer-substring (progn
- (skip-chars-backward "\n \t")
- (beginning-of-line)
- (point))
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- ;; Replace the newline and other whitespace with `...'.
- "..."
- (buffer-substring blinkpos (1+ blinkpos)))
- ;; There is nothing to show except the char itself.
- (buffer-substring blinkpos (1+ blinkpos))))))))
+ (labels
+ ((buffer-substring-highlight-blinkpos (start end)
+ ;; Sometimes there are sufficiently many
+ ;; parentheses on a line that it's *very*
+ ;; useful to see exactly which is the match.
+ (let* ((string (buffer-substring start end))
+ (extent (make-extent (- blinkpos start)
+ (1+ (- blinkpos start))
+ string)))
+ (set-extent-face extent 'isearch)
+ (set-extent-property extent 'duplicable t)
+ string))
+ (before-backquote-context ()
+ ;; Just showing the backquote context is often not
+ ;; informative enough, if you're writing vaguely
+ ;; complex macros. Move past it.
+ (skip-chars-backward "`,＠.")))
+ (declare (inline before-backquote-context))
+ (goto-char blinkpos)
+ (if (pos-visible-in-window-p)
+ (and blink-matching-paren-on-screen
+ (progn
+ (auto-show-make-point-visible)
+ (sit-for blink-matching-delay)))
+ (goto-char blinkpos)
+ (lmessage
+ 'command
+ (concat
+ "Matches "
+ ;; Show what precedes the open in its line, if
+ ;; anything.
+ (if (save-excursion
+ (before-backquote-context)
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (buffer-substring-highlight-blinkpos
+ (progn (beginning-of-line) (point))
+ (1+ blinkpos))
+ ;; Show what follows the open in its line, if
+ ;; anything.
+ (if (save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring-highlight-blinkpos
+ (progn (before-backquote-context) (point))
+ (progn (end-of-line (point))))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ (if (save-excursion
+ (skip-chars-backward "\n \t")
+ (not (bobp)))
+ (concat
+ (buffer-substring
+ (progn (skip-chars-backward "\n \t")
+ (beginning-of-line)
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace
+ ;; with `...'.
+ "..."
+ (buffer-substring-highlight-blinkpos
+ blinkpos (1+ blinkpos)))
+ ;; There is nothing to show except the char
+ ;; itself.
+ (buffer-substring-highlight-blinkpos
+ blinkpos (1+ blinkpos)))))))))
(cond (mismatch
(display-message 'no-log "Mismatched parentheses"))
((not blink-matching-paren-distance)
＠＠ -4501,9 +4531,9 ＠＠
(if (and (null fmt) (null args))
(prog1 nil
(clear-message nil))
- (let ((str (apply 'format fmt args)))
- (display-message 'message str)
- str)))
+ (let ((string (if args (apply 'format fmt args) fmt)))
+ (display-message 'message string)
+ string)))
(defun lmessage (label fmt &rest args)
"Print a one-line message at the bottom of the frame.
＠＠ -4514,10 +4544,9 ＠＠
(if (and (null fmt) (null args))
(prog1 nil
(clear-message label nil))
- (let ((str (apply 'format fmt args)))
- (display-message label str)
- str)))
-
+ (let ((string (if args (apply 'format fmt args) fmt)))
+ (display-message label string)
+ string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warning code ;;
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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: Add #'write-sequence, on the model of #'write-char, API from Common Lisp.
11 years
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/cd4f5f1f1f4c/
Changeset: cd4f5f1f1f4c
User: kehoea
Date: 2013-12-17 18:29:10
Summary: Add #'write-sequence, on the model of #'write-char, API from Common Lisp.
src/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h:
* lisp.h (PARSE_KEYWORDS_8):
Correct this in cases where we can have noticeably fewer arguments
than KEYWORDS_OFFSET, check whether nargs > pk_offset.
Declare check_sequence_range in this header.
* print.c:
* print.c (Fwrite_sequence) New:
Write a sequence to a stream, in the same way #'write-char and
#'terpri do. API from Common Lisp, not GNU, so while there is some
char-int confoundance, it's more limited than usual with GNU APIs.
* print.c (syms_of_print):
Make it available.
* sequence.c (check_sequence_range):
Export this to other files.
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
* cl-extra.el (write-string): New.
* cl-extra.el (write-line): New.
Add these here, implemented in terms of #'write-sequence in print.c.
tests/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Up max-lisp-eval-depth when compiling this file, some of what
we're doing in testing #'write-sequence is demanding.
* automated/lisp-tests.el (make-circular-list):
New argument VALUE, the car of the conses to create.
* automated/lisp-tests.el:
Test #'write-sequence, #'write-string, #'write-line with function,
buffer and marker STREAMs; test argument types, keyword argument
ranges and values.
Affected #: 8 files
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea lisp/ChangeLog
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
＠＠ -1,3 +1,10 ＠＠
+2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el:
+ * cl-extra.el (write-string): New.
+ * cl-extra.el (write-line): New.
+ Add these here, implemented in terms of #'write-sequence in print.c.
+
2013-09-15 Mats Lidell <matsl(a)cxemacs.org>
* files.el (mode-require-final-newline): Variable synced from
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea lisp/cl-extra.el
--- a/lisp/cl-extra.el
+++ b/lisp/cl-extra.el
＠＠ -618,6 +618,38 ＠＠
;; files to do the same, multiple times.
(eval-when-compile (or (cl-compiling-file) (load "cl-macs")))
+;; XEmacs, functions from Common Lisp.
+(defun* write-string (string &optional output-stream &key (start 0) end)
+ "Output STRING to stream OUTPUT-STREAM.
+
+OUTPUT-STREAM defaults to the value of `standard-output', which see.
+
+Keywords:start and :end, if given, specify indices of a subsequence
+of STRING to output. They default to 0 and nil, meaning write the
+entire string.
+
+Returns STRING (not the subsequence of STRING that has been written to
+OUTPUT-STREAM)."
+ (check-type string string)
+ (write-sequence string output-stream :start start :end end))
+
+(defun* write-line (string &optional output-stream &key (start 0) end)
+ "Output STRING, followed by a newline, to OUTPUT-STREAM.
+
+STRING must be a string. OUTPUT-STREAM defaults to the value of
+`standard-output' (which see).
+
+Keywords:start and :end, if given, specify indices of a subsequence
+of STRING to output. They default to 0 and nil, meaning write the
+entire string.
+
+Returns STRING (note, not the subsequence of STRING that has been written to
+OUTPUT-STREAM)."
+ (check-type string string)
+ (prog1
+ (write-sequence string output-stream :start start :end end)
+ (terpri output-stream)))
+
;; Implementation limits.
;; XEmacs; call cl-float-limits at dump time.
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -1,3 +1,20 ＠＠
+2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lisp.h:
+ * lisp.h (PARSE_KEYWORDS_8):
+ Correct this in cases where we can have noticeably fewer arguments
+ than KEYWORDS_OFFSET, check whether nargs > pk_offset.
+ Declare check_sequence_range in this header.
+ * print.c:
+ * print.c (Fwrite_sequence) New:
+ Write a sequence to a stream, in the same way #'write-char and
+ #'terpri do. API from Common Lisp, not GNU, so while there is some
+ char-int confoundance, it's more limited than usual with GNU APIs.
+ * print.c (syms_of_print):
+ Make it available.
+ * sequence.c (check_sequence_range):
+ Export this to other files.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* number.h:
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea src/lisp.h
--- a/src/lisp.h
+++ b/src/lisp.h
＠＠ -3633,7 +3633,7 ＠＠
Elemcount pk_i = nargs - 1, pk_offset = keywords_offset; \
Boolint pk_allow_other_keys = allow_other_keys; \
\
- if ((nargs - pk_offset) & 1) \
+ if ((nargs - pk_offset) & 1 && (nargs > pk_offset)) \
{ \
if (!allow_other_keys \
&& !(pk_allow_other_keys \
＠＠ -5307,6 +5307,9 ＠＠
EXFUN (Fsubseq, 3);
EXFUN (Fvalid_plist_p, 1);
+extern void check_sequence_range (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+
extern Boolint check_eq_nokey (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
extern Boolint check_lss_key_car (Lisp_Object, Lisp_Object, Lisp_Object,
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea src/print.c
--- a/src/print.c
+++ b/src/print.c
＠＠ -143,6 +143,8 ＠＠
Lisp_Object Qdisplay_error;
Lisp_Object Qprint_message_label;
+Lisp_Object Qwrite_sequence;
+
/* Force immediate output of all printed data. Used for debugging. */
int print_unbuffered;
＠＠ -838,6 +840,180 ＠＠
return character;
}
+DEFUN ("write-sequence", Fwrite_sequence, 1, MANY, 0, /*
+Output string, list, vector or bit-vector SEQUENCE to STREAM.
+
+STREAM defaults to the value of `standard-output', which see.
+
+Keywords:start and :end, if given, specify indices of a subsequence
+of SEQUENCE to output. They default to 0 and nil, meaning write the
+entire sequence.
+
+Elements of SEQUENCE can be characters (all are accepted by this function,
+though they may be corrupted depending on the coding system associated with
+STREAM) or integers below #x100, which are treated as equivalent to the
+characters with the corresponding code. This function is from Common Lisp,
+rather GNU Emacs API, so GNU Emacs' character-integer equivalence doesn't
+hold.
+
+Returns SEQUENCE (not the subsequence of SEQUENCE that has been written to
+STREAM).
+
+arguments: (SEQUENCE &optional STREAM &key (START 0) END)
+*/
+ (int nargs, Lisp_Object *args))
+{
+ Lisp_Object sequence = args[0], stream = (nargs > 1) ? args[1] : Qnil;
+ Lisp_Object reloc = Qnil;
+ Charcount starting = 0, ending = 1 + MOST_POSITIVE_FIXNUM;
+ Ibyte *nonreloc = NULL, *all = NULL, *allptr = all;
+ Bytecount bstart = 0, blen = 0;
+ Elemcount ii = 0;
+
+ PARSE_KEYWORDS_8 (Qwrite_sequence, nargs, args, 2, (start, end),
+ (start = Qzero), 2, 0);
+
+ CHECK_SEQUENCE (sequence);
+ CHECK_NATNUM (start);
+
+ if (!NILP (end))
+ {
+ CHECK_NATNUM (end);
+ }
+
+ stream = canonicalize_printcharfun (stream);
+
+ if (BIGNUMP (start) || (BIGNUMP (end)))
+ {
+ /* None of the sequences will have bignum lengths. */
+ check_sequence_range (sequence, start, end, Flength (sequence));
+
+ RETURN_NOT_REACHED (sequence);
+ }
+
+ starting = XFIXNUM (start);
+ if (FIXNUMP (end))
+ {
+ ending = XFIXNUM (end);
+ }
+
+ if (STRINGP (sequence))
+ {
+ Ibyte *stringp = XSTRING_DATA (sequence);
+ Ibyte *strend = stringp + XSTRING_LENGTH (sequence);
+
+ reloc = sequence;
+
+ for (ii = 0; ii < starting && stringp < strend; ++ii)
+ {
+ INC_IBYTEPTR (stringp);
+ }
+
+ if (ii != starting)
+ {
+ /* Bad value for start. */
+ check_sequence_range (sequence, start, end,
+ Flength (sequence));
+ RETURN_NOT_REACHED (sequence);
+ }
+
+ bstart = stringp - XSTRING_DATA (sequence);
+
+ for (; ii < ending && stringp < strend; ++ii)
+ {
+ INC_IBYTEPTR (stringp);
+ }
+
+ if (ii != ending && ending != (1 + MOST_POSITIVE_FIXNUM))
+ {
+ /* Bad value for end. */
+ check_sequence_range (sequence, start, end,
+ Flength (sequence));
+ RETURN_NOT_REACHED (sequence);
+ }
+
+ blen = stringp - (XSTRING_DATA (sequence) + bstart);
+ }
+ else
+ {
+ Lisp_Object length = Flength (sequence);
+
+ check_sequence_range (sequence, start, end, length);
+ ending = NILP (end) ? XFIXNUM (length) : XFIXNUM (end);
+
+ if (VECTORP (sequence))
+ {
+ Lisp_Object *vdata = XVECTOR_DATA (sequence);
+ /* Worst case scenario; all characters, all the longest possible. More
+ likely: lots of small integers. */
+ nonreloc = allptr
+ = alloca_ibytes (((ending - starting)) * MAX_ICHAR_LEN);
+
+ for (ii = starting; ii < ending; ++ii)
+ {
+ if (!CHARP (vdata[ii]))
+ {
+ check_integer_range (vdata[ii], Qzero, make_fixnum (0xff));
+ }
+
+ allptr += set_itext_ichar (allptr,
+ XCHAR_OR_CHAR_INT (vdata[ii]));
+ }
+ }
+ else if (CONSP (sequence))
+ {
+ /* Worst case scenario; all characters, all the longest
+ possible. More likely: lots of small integers. */
+ nonreloc = allptr
+ = alloca_ibytes (((ending - starting)) * MAX_ICHAR_LEN);
+ ii = 0;
+ {
+ EXTERNAL_LIST_LOOP_2 (elt, sequence)
+ {
+ if (ii >= starting)
+ {
+ if (ii >= ending)
+ {
+ break;
+ }
+
+ if (!CHARP (elt))
+ {
+ check_integer_range (elt, Qzero, make_fixnum (0xff));
+ }
+ allptr += set_itext_ichar (allptr,
+ XCHAR_OR_CHAR_INT (elt));
+ }
+ ++ii;
+ }
+ }
+ }
+ else if (BIT_VECTORP (sequence))
+ {
+ Ibyte one [MAX_ICHAR_LEN];
+ Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence);
+
+ nonreloc = allptr
+ = alloca_ibytes (((ending - starting) *
+ (set_itext_ichar (one, (Ichar)1))));
+ for (ii = starting; ii < ending; ++ii)
+ {
+ allptr += set_itext_ichar (allptr, bit_vector_bit (vv, ii));
+ }
+ }
+ else if (NILP (sequence))
+ {
+ nonreloc = allptr = alloca_ibytes (1);
+ }
+
+ bstart = 0;
+ blen = allptr - nonreloc;
+ }
+
+ output_string (stream, nonreloc, reloc, bstart, blen);
+ return sequence;
+}
+
void
temp_output_buffer_setup (Lisp_Object bufname)
{
＠＠ -2977,6 +3153,7 ＠＠
DEFSYMBOL (Qdisplay_error);
DEFSYMBOL (Qprint_message_label);
+ DEFSYMBOL (Qwrite_sequence);
DEFSUBR (Fprin1);
DEFSUBR (Fprin1_to_string);
＠＠ -2986,6 +3163,7 ＠＠
DEFSUBR (Fdisplay_error);
DEFSUBR (Fterpri);
DEFSUBR (Fwrite_char);
+ DEFSUBR (Fwrite_sequence);
DEFSUBR (Falternate_debugging_output);
DEFSUBR (Fset_device_clear_left_side);
DEFSUBR (Fdevice_left_side_clear_p);
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea src/sequence.c
--- a/src/sequence.c
+++ b/src/sequence.c
＠＠ -44,7 +44,7 ＠＠
invalid_state_2 ("object modified while traversing it", func, object);
}
-static void
+void
check_sequence_range (Lisp_Object sequence, Lisp_Object start,
Lisp_Object end, Lisp_Object length)
{
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
＠＠ -1,3 +1,15 ＠＠
+2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Up max-lisp-eval-depth when compiling this file, some of what
+ we're doing in testing #'write-sequence is demanding.
+ * automated/lisp-tests.el (make-circular-list):
+ New argument VALUE, the car of the conses to create.
+ * automated/lisp-tests.el:
+ Test #'write-sequence, #'write-string, #'write-line with function,
+ buffer and marker STREAMs; test argument types, keyword argument
+ ranges and values.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (character):
diff -r 72a9467f93fc5510ba331627ca9581719053c51c -r cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el
+++ b/tests/automated/lisp-tests.el
＠＠ -29,6 +29,9 ＠＠
;;; See test-harness.el for instructions on how to run these tests.
(eval-when-compile
+ ;; The labels below give trouble with a max-lisp-eval-depth of less than
+ ;; about 2000, work around that:
+ (setq max-lisp-eval-depth (max 2000 max-lisp-eval-depth))
(condition-case nil
(require 'test-harness)
(file-error
＠＠ -102,12 +105,16 ＠＠
(Assert (eq (elt my-bit-vector 2) 0))
)
-(defun make-circular-list (length)
- "Create evil emacs-crashing circular list of length LENGTH"
+(defun make-circular-list (length &optional value)
+ "Create evil emacs-crashing circular list of length LENGTH.
+
+Optional VALUE is the value to go into the cars. If nil, some non-nil value
+will be used to make debugging easier."
(let ((circular-list
(make-list
length
- 'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
+ (or value
+ 'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike))))
(setcdr (last circular-list) circular-list)
circular-list))
＠＠ -2867,8 +2874,10 ＠＠
#'(lambda (object) (if (fixnump object) 1 0)) list))
(string (map 'string
#'(lambda (object) (or (and (fixnump object)
- (int-char object))
- (decode-char 'ucs #x20ac))) list))
+ (int-char object))
+ (decode-char 'ucs #x20ac)
+ ?\x20))
+ list))
(gensym (gensym)))
(Assert (null (find 'not-in-it list)))
(Assert (null (find 'not-in-it vector)))
＠＠ -3119,4 +3128,327 ＠＠
(map nil #'set-marker markers fixnums)
(Assert-arith-equivalences markers "with Euro sign restored"))))
+;;-----------------------------------------------------
+;; Test #'write-sequence and friends.
+;;-----------------------------------------------------
+
+(macrolet
+ ((Assert-write-results (function context &key short-string long-string
+ sequences-too output-stream
+ clear-output get-last-output)
+ "Check correct output in CONTEXT for `write-sequence' and friends."
+ (let* ((short-bit-vector (map 'bit-vector #'logand short-string
+ (make-circular-list 1 1)))
+ (long-bit-vector (map 'bit-vector #'logand long-string
+ (make-circular-list 1 1)))
+ (short-bit-vector-string
+ (map #'string #'int-char short-bit-vector))
+ (long-bit-vector-string
+ (map #'string #'int-char long-bit-vector)))
+ `(progn
+ (,clear-output ,output-stream)
+ (,function ,short-string ,output-stream)
+ (Assert (equal ,short-string
+ (,get-last-output ,output-stream
+ ,(length short-string)))
+ ,(format "checking %s with short string, %s"
+ function context))
+ ,＠(when sequences-too
+ `((,clear-output ,output-stream)
+ (,function ,(vconcat short-string) ,output-stream)
+ (Assert (equal ,short-string
+ (,get-last-output ,output-stream
+ ,(length short-string)))
+ ,(format "checking %s with short vector, %s"
+ function context))
+ (,clear-output ,output-stream)
+ (,function ',(append short-string nil) ,output-stream)
+ (Assert (equal ,short-string
+ (,get-last-output ,output-stream
+ ,(length short-string)))
+ ,(format "checking %s with short list, %s"
+ function context))
+ (,clear-output ,output-stream)
+ (,function ,short-bit-vector ,output-stream)
+ (Assert (equal ,short-bit-vector-string
+ (,get-last-output
+ ,output-stream
+ ,(length short-bit-vector-string)))
+ ,(format
+ "checking %s with short bit-vector, %s"
+ function context))
+ (,clear-output ,output-stream)
+ (,function ,long-bit-vector ,output-stream)
+ (Assert (equal ,long-bit-vector-string
+ (,get-last-output
+ ,output-stream
+ ,(length long-bit-vector-string)))
+ ,(format
+ "checking %s with long bit-vector, %s"
+ function context))))
+ ,(cons
+ 'progn
+ (loop
+ for (subseq-start subseq-end description)
+ in `((0 ,(length short-string) "trivial range")
+ (4 7 "harder range"))
+ nconc
+ `((,clear-output ,output-stream)
+ (,function ,short-string ,output-stream :start ,subseq-start
+:end ,subseq-end)
+ (Assert
+ (equal ,(subseq short-string subseq-start subseq-end)
+ (,get-last-output ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with short string, %s, %s"
+ function context description))
+ ,＠(when sequences-too
+ `((,clear-output ,output-stream)
+ (,function ,(vconcat short-string) ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq short-string subseq-start subseq-end)
+ (,get-last-output ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with short vector, %s, %s"
+ function context description))
+ (,clear-output ,output-stream)
+ (,function ',(append short-string nil) ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq short-string subseq-start subseq-end)
+ (,get-last-output
+ ,output-stream
+ ,(- subseq-end subseq-start )))
+ ,(format "checking %s with short list, %s, %s"
+ function context description))
+ (,clear-output ,output-stream)
+ (,function ,short-bit-vector ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq short-bit-vector-string subseq-start
+ subseq-end)
+ (,get-last-output ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with short bit-vector, %s, %s"
+ function context description)))))))
+ ,(cons
+ 'progn
+ (loop
+ for (subseq-start subseq-end description)
+ in `((0 ,(length long-string) "trivial range")
+ (4 90 "harder range"))
+ nconc
+ `((,clear-output ,output-stream)
+ (,function ,long-string ,output-stream :start ,subseq-start
+:end ,subseq-end)
+ (Assert
+ (equal ,(subseq long-string subseq-start subseq-end)
+ (,get-last-output ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with long string, %s, %s"
+ function context description))
+ ,＠(when sequences-too
+ `((,clear-output ,output-stream)
+ (,function ,(vconcat long-string) ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq long-string subseq-start subseq-end)
+ (,get-last-output
+ ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with long vector, %s, %s"
+ function context description))
+ (,clear-output ,output-stream)
+ (,function ',(append long-string nil) ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq long-string subseq-start subseq-end)
+ (,get-last-output ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format "checking %s with long list, %s, %s"
+ function context description))
+ (,clear-output ,output-stream)
+ (,function ,long-bit-vector ,output-stream
+:start ,subseq-start :end ,subseq-end)
+ (Assert
+ (equal ,(subseq long-bit-vector-string
+ subseq-start subseq-end)
+ (,get-last-output
+ ,output-stream
+ ,(- subseq-end subseq-start)))
+ ,(format
+ "checking %s with long bit-vector, %s, %s"
+ function context description)))))))
+ (,clear-output ,output-stream))))
+ (test-write-string (function &key sequences-too worry-about-newline)
+ (let* ((short-string "hello there")
+ (long-string
+ (decode-coding-string
+ (concat
+ "\xd8\xb3\xd9\x84\xd8\xa7\xd9\x85 \xd8\xb9\xd9\x84"
+ "\xdb\x8c\xda\xa9\xd9\x85\x2c \xd8\xa7\xd8\xb3\xd9"
+ "\x85 \xd9\x85\xd9\x86 \xd8\xa7\xdb\x8c\xd8\xaf\xd9"
+ "\x86 \xda\xa9\xdb\x8c\xd9\x88 \xd8\xa7\xd8\xb3\xd8"
+ "\xaa\x2e \xd9\x85\xd9\x86 \xd8\xa7\xdb\x8c\xd8\xb1"
+ "\xd9\x84\xd9\x86\xd8\xaf\xdb\x8c \xd8\xa7\xd9\x85"
+ "\x2c \xd9\x88 \xd9\x85\xd9\x86 \xd8\xaf\xd8\xb1 "
+ "\xd8\xa8\xdb\x8c\xd9\x85\xd8\xa7\xd8\xb1\xd8\xb3"
+ "\xd8\xaa\xd8\xa7\xd9\x86 \xda\xa9\xd8\xa7\xd8\xb1"
+ "\xd9\x85\xdb\x8c\xe2\x80\x8c\xda\xa9\xd9\x86\xd9"
+ "\x85\x2e")
+ (if (featurep 'mule) 'utf-8 'raw-text-unix)))
+ (long-string (concat long-string long-string long-string
+ long-string long-string long-string
+ long-string long-string long-string
+ long-string long-string long-string)))
+ `(with-temp-buffer
+ (let* ((long-string ,long-string)
+ (stashed-data
+ (get-buffer-create
+ (generate-new-buffer-name " *stash*")))
+ (function-output-stream
+ (apply-partially
+ #'(lambda (buffer character)
+ (insert-char character 1 nil buffer))
+ stashed-data))
+ (marker-buffer
+ (get-buffer-create
+ (generate-new-buffer-name " *for-marker*")))
+ (marker-base-position 40)
+ (marker
+ (progn
+ (insert-char ?\xff 90 nil marker-buffer)
+ (set-marker (make-marker) 40 marker-buffer))))
+ (unwind-protect
+ (labels
+ ((clear-buffer (buffer)
+ (delete-region (point-min buffer) (point-max buffer)
+ buffer))
+ (clear-stashed-data (ignore)
+ (delete-region (point-min stashed-data)
+ (point-max stashed-data)
+ stashed-data))
+ (clear-marker-data (marker)
+ (delete-region marker-base-position marker
+ (marker-buffer marker)))
+ (buffer-output (buffer length)
+ (and (> (point buffer) length)
+ (buffer-substring (- (point buffer) length)
+ (point buffer) buffer)))
+ (stashed-data-output (ignore length)
+ (and (> (point stashed-data) length)
+ (buffer-substring (- (point stashed-data)
+ length)
+ (point stashed-data)
+ stashed-data)))
+ (marker-data (marker length)
+ (and (> marker length)
+ (buffer-substring (- marker length) marker
+ (marker-buffer marker))))
+ (buffer-output-sans-newline (buffer length)
+ (and (> (point buffer) (+ length 1))
+ (buffer-substring (- (point buffer) length 1)
+ (1- (point buffer)))))
+ (stashed-data-output-sans-newline (ignore length)
+ (and (> (point stashed-data) (+ length 1))
+ (buffer-substring (- (point stashed-data)
+ length 1)
+ (1- (point stashed-data))
+ stashed-data)))
+ (marker-data-sans-newline (marker length)
+ (and (> marker (+ length 1))
+ (buffer-substring (- marker length 1)
+ (1- marker)
+ (marker-buffer marker)))))
+ (Check-Error wrong-number-of-arguments (,function))
+ (,(if (subrp (symbol-function function))
+ 'progn
+ 'Implementation-Incomplete-Expect-Failure)
+ (Check-Error wrong-number-of-arguments
+ (,function ,short-string
+ (current-buffer) :start))
+ (Check-Error wrong-number-of-arguments
+ (,function ,short-string
+ (current-buffer) :start 0
+ :end nil :start)))
+ (Check-Error invalid-keyword-argument
+ (,function ,short-string
+ (current-buffer)
+:test #'eq))
+ (Check-Error wrong-type-argument (,function pi))
+ ,＠(if sequences-too
+ `((Check-Error
+ args-out-of-range
+ (,function (vector most-positive-fixnum)))
+ (Check-Error
+ args-out-of-range
+ (,function (list most-positive-fixnum)))
+ ,＠(if (featurep 'mule)
+ `((Check-Error
+ args-out-of-range
+ (,function
+ (vector
+ (char-int
+ (decode-char 'ucs #x20ac))))))))
+ `((Check-Error wrong-type-argument
+ (,function
+ ',(append short-string nil)))
+ (Check-Error wrong-type-argument
+ (,function
+ ,(vconcat long-string)))
+ (Check-Error wrong-type-argument
+ (,function #*010010001010101))))
+ (Check-Error wrong-type-argument
+ (,function ,short-string (current-buffer)
+:start 0.0))
+ (Check-Error wrong-type-argument
+ (,function ,short-string (current-buffer)
+:end 4.0))
+ (Check-Error invalid-function
+ (,function ,short-string pi))
+ (Check-Error args-out-of-range
+ (,function ,short-string (current-buffer)
+:end ,(1+ (length short-string))))
+ (Check-Error args-out-of-range
+ (,function ,short-string nil
+:start
+ ,(1+ (length short-string))))
+ ;; Not checked here; output to a stdio stream, output
+ ;; to an lstream, output to a frame.
+ (Assert-write-results
+ ,function "buffer point" :short-string ,short-string
+:long-string ,long-string :sequences-too ,sequences-too
+:output-stream (current-buffer)
+:clear-output clear-buffer
+:get-last-output
+ ,(if worry-about-newline 'buffer-output-sans-newline
+ 'buffer-output))
+ (Assert-write-results
+ ,function "function output" :short-string ,short-string
+:long-string ,long-string :sequences-too ,sequences-too
+:output-stream function-output-stream
+:clear-output clear-stashed-data
+:get-last-output
+ ,(if worry-about-newline
+ 'stashed-data-output-sans-newline
+ 'stashed-data-output))
+ (Assert-write-results
+ ,function "marker output" :short-string ,short-string
+:long-string ,long-string :sequences-too ,sequences-too
+:output-stream marker :clear-output clear-marker-data
+:get-last-output ,(if worry-about-newline
+ 'marker-data-sans-newline
+ 'marker-data)))
+ (kill-buffer stashed-data)
+ (kill-buffer marker-buffer)))))))
+ (test-write-string write-sequence :sequences-too t)
+ (test-write-string write-string :sequences-too nil)
+ (test-write-string write-line :worry-about-newline t :sequences-too nil))
+
;;; end of lisp-tests.el
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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Only make promote_args_lazy() available if WITH_NUMBER_TYPES. #'min
11 years
Aidan Kehoe
Aidan Kehoe
Ar an séú lá déag de mí na Nollaig, scríobh Stephen J. Turnbull:
> Aidan Kehoe writes:
> >
> > APPROVE COMMIT
> >
> > NOTE: This patch has been committed.
>
> I think you broke the buildbot(s).
Thanks for the mail. For some reason my non-WITH_NUMBER_TYPES C++ build
didn’t choke like these various non-WITH_NUMBER_TYPES bot builds did, though
it surely should have.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1387126918 0
# Node ID 72a9467f93fc5510ba331627ca9581719053c51c
# Parent f22989bb76320d7d68b84212f765e77d01567b11
Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
src/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* number.h:
Only make promote_args_lazy() available on builds
WITH_NUMBER_TYPES, in case linking complains about promote_args()
not being available.
tests/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (character):
Remove a debugging statement from this.
diff -r f22989bb7632 -r 72a9467f93fc src/ChangeLog
--- a/src/ChangeLog Sun Dec 15 10:38:19 2013 +0000
+++ b/src/ChangeLog Sun Dec 15 17:01:58 2013 +0000
＠＠ -1,3 +1,10 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * number.h:
+ Only make promote_args_lazy() available on builds
+ WITH_NUMBER_TYPES, in case linking complains about promote_args()
+ not being available.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_arithcompare):
diff -r f22989bb7632 -r 72a9467f93fc src/number.h
--- a/src/number.h Sun Dec 15 10:38:19 2013 +0000
+++ b/src/number.h Sun Dec 15 17:01:58 2013 +0000
＠＠ -384,6 +384,8 ＠＠
extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+#ifdef WITH_NUMBER_TYPES
+
/* promote_args() *always* converts a marker argument to a fixnum.
Unfortunately, for a marker with byte position N, getting the (character)
＠＠ -409,7 +411,6 ＠＠
return (enum lazy_number_type) promote_args (obj1, obj2);
}
-#ifdef WITH_NUMBER_TYPES
DECLARE_INLINE_HEADER (
int
non_fixnum_number_p (Lisp_Object object))
diff -r f22989bb7632 -r 72a9467f93fc tests/ChangeLog
--- a/tests/ChangeLog Sun Dec 15 10:38:19 2013 +0000
+++ b/tests/ChangeLog Sun Dec 15 17:01:58 2013 +0000
＠＠ -1,3 +1,8 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (character):
+ Remove a debugging statement from this.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/face-tests.el:
diff -r f22989bb7632 -r 72a9467f93fc tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sun Dec 15 10:38:19 2013 +0000
+++ b/tests/automated/lisp-tests.el Sun Dec 15 17:01:58 2013 +0000
＠＠ -3091,7 +3091,6 ＠＠
context)))
markers))))
(with-temp-buffer
- (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*"))
(loop for ii from 0 to 100
do (progn
(insert " " character " " character " " character " "
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit/XEmacs: kehoea: Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
11 years
Bitbucket
Bitbucket
1 new commit in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/72a9467f93fc/
Changeset: 72a9467f93fc
User: kehoea
Date: 2013-12-15 18:01:58
Summary: Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
src/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* number.h:
Only make promote_args_lazy() available on builds
WITH_NUMBER_TYPES, in case linking complains about promote_args()
not being available.
tests/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (character):
Remove a debugging statement from this.
Affected #: 4 files
diff -r f22989bb76320d7d68b84212f765e77d01567b11 -r 72a9467f93fc5510ba331627ca9581719053c51c src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -1,3 +1,10 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * number.h:
+ Only make promote_args_lazy() available on builds
+ WITH_NUMBER_TYPES, in case linking complains about promote_args()
+ not being available.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_arithcompare):
diff -r f22989bb76320d7d68b84212f765e77d01567b11 -r 72a9467f93fc5510ba331627ca9581719053c51c src/number.h
--- a/src/number.h
+++ b/src/number.h
＠＠ -384,6 +384,8 ＠＠
extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+#ifdef WITH_NUMBER_TYPES
+
/* promote_args() *always* converts a marker argument to a fixnum.
Unfortunately, for a marker with byte position N, getting the (character)
＠＠ -409,7 +411,6 ＠＠
return (enum lazy_number_type) promote_args (obj1, obj2);
}
-#ifdef WITH_NUMBER_TYPES
DECLARE_INLINE_HEADER (
int
non_fixnum_number_p (Lisp_Object object))
diff -r f22989bb76320d7d68b84212f765e77d01567b11 -r 72a9467f93fc5510ba331627ca9581719053c51c tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
＠＠ -1,3 +1,8 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el (character):
+ Remove a debugging statement from this.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/face-tests.el:
diff -r f22989bb76320d7d68b84212f765e77d01567b11 -r 72a9467f93fc5510ba331627ca9581719053c51c tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el
+++ b/tests/automated/lisp-tests.el
＠＠ -3091,7 +3091,6 ＠＠
context)))
markers))))
(with-temp-buffer
- (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*"))
(loop for ii from 0 to 100
do (progn
(insert " " character " " character " " character " "
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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Check (featurep 'font-mgr) before calling fontconfig functions, tests
11 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1387103899 0
# Node ID f22989bb76320d7d68b84212f765e77d01567b11
# Parent ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913
Check (featurep 'font-mgr) before calling fontconfig functions, tests
tests/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/face-tests.el:
Only test fontconfig if the font-mgr feature is available, avoid
errors when it isn't.
diff -r ffc0c5a66ab1 -r f22989bb7632 tests/ChangeLog
--- a/tests/ChangeLog Sun Dec 15 10:26:31 2013 +0000
+++ b/tests/ChangeLog Sun Dec 15 10:38:19 2013 +0000
＠＠ -1,3 +1,9 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/face-tests.el:
+ Only test fontconfig if the font-mgr feature is available, avoid
+ errors when it isn't.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r ffc0c5a66ab1 -r f22989bb7632 tests/automated/face-tests.el
--- a/tests/automated/face-tests.el Sun Dec 15 10:26:31 2013 +0000
+++ b/tests/automated/face-tests.el Sun Dec 15 10:38:19 2013 +0000
＠＠ -29,76 +29,74 ＠＠
;; Test fontconfig
-(let* ((test-name-parts
- '("Bitstream Vera Sans Mono-16"
- "familylang=en"
- "style=Roman"
- "stylelang=en"
- "fullname=Bitstream Vera Sans Mono"
- "fullnamelang=en"
- "slant=0"
- "weight=80"
- "width=100"
- "pixelsize=21.3174"
- "spacing=100"
- "foundry=bitstream"
- "antialias=True"
- "hintstyle=3"
- "hinting=True"
- "verticallayout=False"
- "autohint=False"
- "globaladvance=True"
- "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf"
- "index=0"
- "outline=True"
- "scalable=True"
- "dpi=95.9282"
- "rgba=0"
- "scale=1"
- "minspace=False"
- "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) "
- "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za"
- "fontversion=131072"
- "fontformat=TrueType"
- "embolden=False"
- "embeddedbitmap=True"
- "decorative=False"
- "lcdfilter=1"
- "namelang=en"
- "prgname=xemacs"
- "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d"
- "postscriptname=BitstreamVeraSansMono-Roman"))
- (test-name-degenerate "")
- (test-name-trivial (nth 0 test-name-parts))
- (test-name-short
- (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts)))
- (test-name-long (mapconcat #'identity
- (append (subseq test-name-parts 0 26)
- (subseq test-name-parts 27))
- ":"))
- (test-name-full (mapconcat #'identity test-name-parts ":"))
- )
- (labels ((try (fontname)
- (fc-name-unparse (fc-name-parse fontname)))
- (try-harder (fontname)
- (fc-name-unparse (fc-name-parse-harder fontname))))
- (Assert (string= test-name-degenerate (try test-name-degenerate)))
- (Assert (string= test-name-degenerate (try-harder test-name-degenerate)))
- (Assert (string= test-name-trivial (try test-name-trivial)))
- (Assert (string= test-name-trivial (try-harder test-name-trivial)))
- ;; Note when the `try' form fails, the `try-harder' form returns a
- ;; shorter name.
- (Check-Error 'invalid-argument
- (string= test-name-short (try test-name-short)))
- (Assert (string= test-name-trivial (try-harder test-name-short)))
- (Assert (string= test-name-long (try test-name-long)))
- (Assert (string= test-name-long (try-harder test-name-long)))
- ;; Note when the `try' form fails, the `try-harder' form returns a
- ;; shorter name.
- (Check-Error 'invalid-argument
- (string= test-name-full (try test-name-full)))
- (Assert (string= test-name-long (try-harder test-name-full)))
- ) ; labels
- ) ; let
+(when (featurep 'font-mgr)
+ (let* ((test-name-parts
+ '("Bitstream Vera Sans Mono-16"
+ "familylang=en"
+ "style=Roman"
+ "stylelang=en"
+ "fullname=Bitstream Vera Sans Mono"
+ "fullnamelang=en"
+ "slant=0"
+ "weight=80"
+ "width=100"
+ "pixelsize=21.3174"
+ "spacing=100"
+ "foundry=bitstream"
+ "antialias=True"
+ "hintstyle=3"
+ "hinting=True"
+ "verticallayout=False"
+ "autohint=False"
+ "globaladvance=True"
+ "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf"
+ "index=0"
+ "outline=True"
+ "scalable=True"
+ "dpi=95.9282"
+ "rgba=0"
+ "scale=1"
+ "minspace=False"
+ "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) "
+ "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za"
+ "fontversion=131072"
+ "fontformat=TrueType"
+ "embolden=False"
+ "embeddedbitmap=True"
+ "decorative=False"
+ "lcdfilter=1"
+ "namelang=en"
+ "prgname=xemacs"
+ "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d"
+ "postscriptname=BitstreamVeraSansMono-Roman"))
+ (test-name-degenerate "")
+ (test-name-trivial (nth 0 test-name-parts))
+ (test-name-short
+ (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts)))
+ (test-name-long (mapconcat #'identity
+ (append (subseq test-name-parts 0 26)
+ (subseq test-name-parts 27))
+ ":"))
+ (test-name-full (mapconcat #'identity test-name-parts ":")))
+ (labels ((try (fontname)
+ (fc-name-unparse (fc-name-parse fontname)))
+ (try-harder (fontname)
+ (fc-name-unparse (fc-name-parse-harder fontname))))
+ (Assert (string= test-name-degenerate (try test-name-degenerate)))
+ (Assert (string= test-name-degenerate (try-harder test-name-degenerate)))
+ (Assert (string= test-name-trivial (try test-name-trivial)))
+ (Assert (string= test-name-trivial (try-harder test-name-trivial)))
+ ;; Note when the `try' form fails, the `try-harder' form returns a
+ ;; shorter name.
+ (Check-Error 'invalid-argument
+ (string= test-name-short (try test-name-short)))
+ (Assert (string= test-name-trivial (try-harder test-name-short)))
+ (Assert (string= test-name-long (try test-name-long)))
+ (Assert (string= test-name-long (try-harder test-name-long)))
+ ;; Note when the `try' form fails, the `try-harder' form returns a
+ ;; shorter name.
+ (Check-Error 'invalid-argument
+ (string= test-name-full (try test-name-full)))
+ (Assert (string= test-name-long (try-harder test-name-full))))))
;;; end face-tests.el
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Return a fixnum as documented with marker arg, #'max, #'min
11 years
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1387101448 0
# Node ID 3bfcdeb65578e17883ff14fb2b0463bf1a723d74
# Parent 4e69b24a23011918b25ad7a1ed3d38f6f22c6704
Return a fixnum as documented with marker arg, #'max, #'min
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c (Fmax):
* data.c (Fmin):
When an argument is a marker or a character, and WITH_NUMBER_TYPES
is defined, return a fixnum in these functions as is documented
and as the non-NUMBER_TYPES code does.
diff -r 4e69b24a2301 -r 3bfcdeb65578 src/ChangeLog
--- a/src/ChangeLog Mon Oct 28 16:03:53 2013 +0100
+++ b/src/ChangeLog Sun Dec 15 09:57:28 2013 +0000
＠＠ -1,3 +1,11 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * data.c (Fmax):
+ * data.c (Fmin):
+ When an argument is a marker or a character, and WITH_NUMBER_TYPES
+ is defined, return a fixnum in these functions as is documented
+ and as the non-NUMBER_TYPES code does.
+
2013-09-10 Stephen J. Turnbull <stephen(a)xemacs.org>
* font-mgr.c: Fix a bunch of comments and reformat some docstrings.
diff -r 4e69b24a2301 -r 3bfcdeb65578 src/data.c
--- a/src/data.c Mon Oct 28 16:03:53 2013 +0100
+++ b/src/data.c Sun Dec 15 09:57:28 2013 +0000
＠＠ -1891,7 +1891,6 ＠＠
{
#ifdef WITH_NUMBER_TYPES
REGISTER int i, maxindex = 0;
- Lisp_Object comp1, comp2;
while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
＠＠ -1901,33 +1900,33 ＠＠
args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- comp1 = args[maxindex];
- comp2 = args[i];
- switch (promote_args (&comp1, &comp2))
+ switch (promote_args (args + maxindex, args + i))
{
case FIXNUM_T:
- if (XREALFIXNUM (comp1) < XREALFIXNUM (comp2))
+ if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGNUM
case BIGNUM_T:
- if (bignum_lt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2)))
+ if (bignum_lt (XBIGNUM_DATA (args[maxindex]),
+ XBIGNUM_DATA (args[i])))
maxindex = i;
break;
#endif
#ifdef HAVE_RATIO
case RATIO_T:
- if (ratio_lt (XRATIO_DATA (comp1), XRATIO_DATA (comp2)))
+ if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i])))
maxindex = i;
break;
#endif
case FLOAT_T:
- if (XFLOAT_DATA (comp1) < XFLOAT_DATA (comp2))
+ if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGFLOAT
case BIGFLOAT_T:
- if (bigfloat_lt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2)))
+ if (bigfloat_lt (XBIGFLOAT_DATA (args[maxindex]),
+ XBIGFLOAT_DATA (args[i])))
maxindex = i;
break;
#endif
＠＠ -1988,7 +1987,6 ＠＠
{
#ifdef WITH_NUMBER_TYPES
REGISTER int i, minindex = 0;
- Lisp_Object comp1, comp2;
while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
＠＠ -1998,33 +1996,34 ＠＠
args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- comp1 = args[minindex];
- comp2 = args[i];
- switch (promote_args (&comp1, &comp2))
+ switch (promote_args (args + minindex, args + i))
{
case FIXNUM_T:
- if (XREALFIXNUM (comp1) > XREALFIXNUM (comp2))
+ if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGNUM
case BIGNUM_T:
- if (bignum_gt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2)))
+ if (bignum_gt (XBIGNUM_DATA (args[minindex]),
+ XBIGNUM_DATA (args[i])))
minindex = i;
break;
#endif
#ifdef HAVE_RATIO
case RATIO_T:
- if (ratio_gt (XRATIO_DATA (comp1), XRATIO_DATA (comp2)))
+ if (ratio_gt (XRATIO_DATA (args[minindex]),
+ XRATIO_DATA (args[i])))
minindex = i;
break;
#endif
case FLOAT_T:
- if (XFLOAT_DATA (comp1) > XFLOAT_DATA (comp2))
+ if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGFLOAT
case BIGFLOAT_T:
- if (bigfloat_gt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2)))
+ if (bigfloat_gt (XBIGFLOAT_DATA (args[minindex]),
+ XBIGFLOAT_DATA (args[i])))
minindex = i;
break;
#endif
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[XEMACS PATCH] Be lazy about calling marker_position() in bytecode_arithcompare()
11 years
Aidan Kehoe
Aidan Kehoe
PATCH 21.5
This change improves performance for VM with large folder a little, though
it’s not a complete solution. In particular, when hitting q in a modified
folder with index files turned on and non-ASCII bytes in the buffer,
#'vm-sort-compare-physical-order is called about 5 N times for N messages,
giving 10 N calls to marker-position, which is expensive.
This shows up as char-byte conversion in XEmacs profiling, and my below
change improves this, such that the majority of the time in the described
context is now in #'write-file-internal, not char-byte conversion.
diff -r 4e69b24a2301 src/bytecode.c
--- a/src/bytecode.c Mon Oct 28 16:03:53 2013 +0100
+++ b/src/bytecode.c Sun Dec 01 11:16:59 2013 +0000
＠＠ -287,7 +287,7 ＠＠
bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
{
#ifdef WITH_NUMBER_TYPES
- switch (promote_args (&obj1, &obj2))
+ switch (promote_args_lazy (&obj1, &obj2))
{
case FIXNUM_T:
{
＠＠ -306,6 +306,13 ＠＠
case BIGFLOAT_T:
return bigfloat_cmp (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
#endif
+ case MARKER_T:
+ {
+ Bytebpos ival1 = byte_marker_position (obj1);
+ Bytebpos ival2 = byte_marker_position (obj2);
+ return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
+ }
+
default: /* FLOAT_T */
{
double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2);
＠＠ -320,7 +327,19 ＠＠
if (FIXNUMP (obj1)) ival1 = XFIXNUM (obj1);
else if (CHARP (obj1)) ival1 = XCHAR (obj1);
- else if (MARKERP (obj1)) ival1 = marker_position (obj1);
+ else if (MARKERP (obj1))
+ {
+ /* Handle markers specially, since #'marker-position can be O(N): */
+ if (MARKERP (obj2)
+ && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer))
+ {
+ Bytebpos ival1 = byte_marker_position (obj1);
+ Bytebpos ival2 = byte_marker_position (obj2);
+ return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
+ }
+
+ ival1 = marker_position (obj1);
+ }
else goto arithcompare_float;
if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2);
diff -r 4e69b24a2301 src/data.c
--- a/src/data.c Mon Oct 28 16:03:53 2013 +0100
+++ b/src/data.c Sun Dec 01 11:16:59 2013 +0000
＠＠ -936,10 +936,10 ＠＠
{ \
obj1 = args[i - 1]; \
obj2 = args[i]; \
- switch (promote_args (&obj1, &obj2)) \
+ switch (promote_args_lazy (&obj1, &obj2)) \
{ \
case FIXNUM_T: \
- if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \
+ if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \
return Qnil; \
break; \
BIGNUM_CASE (op) \
＠＠ -949,11 +949,20 ＠＠
return Qnil; \
break; \
BIGFLOAT_CASE (op) \
+ case MARKER_T: \
+ if (!(byte_marker_position (obj1) c_op \
+ byte_marker_position (obj2))) \
+ return Qnil; \
+ break; \
} \
} \
return Qt; \
}
#else /* !WITH_NUMBER_TYPES */
+/* We don't convert markers lazily here, although we could. It's more
+ important that we do this lazily in bytecode, which is the case; see
+ bytecode_arithcompare().
+ */
#define ARITHCOMPARE_MANY(c_op,op) \
{ \
int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \
diff -r 4e69b24a2301 src/number.h
--- a/src/number.h Mon Oct 28 16:03:53 2013 +0100
+++ b/src/number.h Sun Dec 01 11:16:59 2013 +0000
＠＠ -373,11 +373,40 ＠＠
EXFUN (Fcanonicalize_number, 1);
-enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};
+#define NUMBER_TYPES(prefix) prefix##FIXNUM_T, prefix##BIGNUM_T, \
+ prefix##RATIO_T, prefix##FLOAT_T, prefix##BIGFLOAT_T
+
+enum number_type { NUMBER_TYPES() };
+enum lazy_number_type { NUMBER_TYPES(LAZY_), MARKER_T };
extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+/* promote_args() *always* converts a marker argument to an integer.
+
+ Unfortunately, for a marker with byte position N, getting the (character)
+ marker position is O(N). Getting the character position isn't necessary
+ for bytecode_arithcompare() if two markers being compared are in the same
+ buffer, comparing the byte position is enough.
+
+ It is necessary for those operations implemented by bytecode_arithop(),
+ though, with the exception that Bmax and Bmin could be changed to call
+ marker-position once rather than twice. */
+DECLARE_INLINE_HEADER (
+enum lazy_number_type
+promote_args_lazy (Lisp_Object *obj1, Lisp_Object *obj2))
+{
+ if (MARKERP (*obj1) && MARKERP (*obj2) &&
+ XMARKER (*obj1)->buffer == XMARKER (*obj2)->buffer)
+ {
+ return MARKER_T;
+ }
+
+ return (enum lazy_number_type) promote_args (obj1, obj2);
+}
+
+#undef NUMBER_TYPES
+
#ifdef WITH_NUMBER_TYPES
DECLARE_INLINE_HEADER (
int
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
commit/XEmacs: 3 new changesets
11 years
Bitbucket
Bitbucket
3 new commits in XEmacs:
https://bitbucket.org/xemacs/xemacs/commits/3bfcdeb65578/
Changeset: 3bfcdeb65578
User: kehoea
Date: 2013-12-15 10:57:28
Summary: Return a fixnum as documented with marker arg, #'max, #'min
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c (Fmax):
* data.c (Fmin):
When an argument is a marker or a character, and WITH_NUMBER_TYPES
is defined, return a fixnum in these functions as is documented
and as the non-NUMBER_TYPES code does.
Affected #: 2 files
diff -r 4e69b24a23011918b25ad7a1ed3d38f6f22c6704 -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -1,3 +1,11 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * data.c (Fmax):
+ * data.c (Fmin):
+ When an argument is a marker or a character, and WITH_NUMBER_TYPES
+ is defined, return a fixnum in these functions as is documented
+ and as the non-NUMBER_TYPES code does.
+
2013-09-10 Stephen J. Turnbull <stephen(a)xemacs.org>
* font-mgr.c: Fix a bunch of comments and reformat some docstrings.
diff -r 4e69b24a23011918b25ad7a1ed3d38f6f22c6704 -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 src/data.c
--- a/src/data.c
+++ b/src/data.c
＠＠ -1891,7 +1891,6 ＠＠
{
#ifdef WITH_NUMBER_TYPES
REGISTER int i, maxindex = 0;
- Lisp_Object comp1, comp2;
while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
＠＠ -1901,33 +1900,33 ＠＠
args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- comp1 = args[maxindex];
- comp2 = args[i];
- switch (promote_args (&comp1, &comp2))
+ switch (promote_args (args + maxindex, args + i))
{
case FIXNUM_T:
- if (XREALFIXNUM (comp1) < XREALFIXNUM (comp2))
+ if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGNUM
case BIGNUM_T:
- if (bignum_lt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2)))
+ if (bignum_lt (XBIGNUM_DATA (args[maxindex]),
+ XBIGNUM_DATA (args[i])))
maxindex = i;
break;
#endif
#ifdef HAVE_RATIO
case RATIO_T:
- if (ratio_lt (XRATIO_DATA (comp1), XRATIO_DATA (comp2)))
+ if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i])))
maxindex = i;
break;
#endif
case FLOAT_T:
- if (XFLOAT_DATA (comp1) < XFLOAT_DATA (comp2))
+ if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGFLOAT
case BIGFLOAT_T:
- if (bigfloat_lt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2)))
+ if (bigfloat_lt (XBIGFLOAT_DATA (args[maxindex]),
+ XBIGFLOAT_DATA (args[i])))
maxindex = i;
break;
#endif
＠＠ -1988,7 +1987,6 ＠＠
{
#ifdef WITH_NUMBER_TYPES
REGISTER int i, minindex = 0;
- Lisp_Object comp1, comp2;
while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
＠＠ -1998,33 +1996,34 ＠＠
args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- comp1 = args[minindex];
- comp2 = args[i];
- switch (promote_args (&comp1, &comp2))
+ switch (promote_args (args + minindex, args + i))
{
case FIXNUM_T:
- if (XREALFIXNUM (comp1) > XREALFIXNUM (comp2))
+ if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGNUM
case BIGNUM_T:
- if (bignum_gt (XBIGNUM_DATA (comp1), XBIGNUM_DATA (comp2)))
+ if (bignum_gt (XBIGNUM_DATA (args[minindex]),
+ XBIGNUM_DATA (args[i])))
minindex = i;
break;
#endif
#ifdef HAVE_RATIO
case RATIO_T:
- if (ratio_gt (XRATIO_DATA (comp1), XRATIO_DATA (comp2)))
+ if (ratio_gt (XRATIO_DATA (args[minindex]),
+ XRATIO_DATA (args[i])))
minindex = i;
break;
#endif
case FLOAT_T:
- if (XFLOAT_DATA (comp1) > XFLOAT_DATA (comp2))
+ if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGFLOAT
case BIGFLOAT_T:
- if (bigfloat_gt (XBIGFLOAT_DATA (comp1), XBIGFLOAT_DATA (comp2)))
+ if (bigfloat_gt (XBIGFLOAT_DATA (args[minindex]),
+ XBIGFLOAT_DATA (args[i])))
minindex = i;
break;
#endif
https://bitbucket.org/xemacs/xemacs/commits/ffc0c5a66ab1/
Changeset: ffc0c5a66ab1
User: kehoea
Date: 2013-12-15 11:26:31
Summary: Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
src/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecode.c (bytecode_arithcompare):
* bytecode.c (bytecode_arithop):
Call promote_args_lazy () in these two functions, only converting
markers to fixnums if absolutely necessary (since that is ON with
large, mule buffers).
* data.c (BIGNUM_CASE):
* data.c (RATIO_CASE):
* data.c (BIGFLOAT_CASE):
* data.c (ARITHCOMPARE_MANY):
Call promote_args_lazy () here too if WITH_NUMBER_TYPES is defined.
We're not doing the equivalent with the non-NUMBER_TYPES code, but
that's mostly fine, we are doing it in the bytecode.
* number.h:
* number.h (NUMBER_TYPES):
* number.h (promote_args_lazy):
Add this, returning LAZY_MARKER_T if both arguments are markers
that point to the same buffer.
tests/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Test arithmetic comparisons with markers, check the type of the
returned values for #'min and #'max.
Affected #: 6 files
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/ChangeLog
--- a/src/ChangeLog
+++ b/src/ChangeLog
＠＠ -1,3 +1,25 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecode.c (bytecode_arithcompare):
+ * bytecode.c (bytecode_arithop):
+ Call promote_args_lazy () in these two functions, only converting
+ markers to fixnums if absolutely necessary (since that is ON with
+ large, mule buffers).
+
+ * data.c (BIGNUM_CASE):
+ * data.c (RATIO_CASE):
+ * data.c (BIGFLOAT_CASE):
+ * data.c (ARITHCOMPARE_MANY):
+ Call promote_args_lazy () here too if WITH_NUMBER_TYPES is defined.
+ We're not doing the equivalent with the non-NUMBER_TYPES code, but
+ that's mostly fine, we are doing it in the bytecode.
+
+ * number.h:
+ * number.h (NUMBER_TYPES):
+ * number.h (promote_args_lazy):
+ Add this, returning LAZY_MARKER_T if both arguments are markers
+ that point to the same buffer.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* data.c (Fmax):
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/bytecode.c
--- a/src/bytecode.c
+++ b/src/bytecode.c
＠＠ -287,25 +287,32 ＠＠
bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
{
#ifdef WITH_NUMBER_TYPES
- switch (promote_args (&obj1, &obj2))
+ switch (promote_args_lazy (&obj1, &obj2))
{
- case FIXNUM_T:
+ case LAZY_FIXNUM_T:
{
EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2);
return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
}
#ifdef HAVE_BIGNUM
- case BIGNUM_T:
+ case LAZY_BIGNUM_T:
return bignum_cmp (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
#endif
#ifdef HAVE_RATIO
- case RATIO_T:
+ case LAZY_RATIO_T:
return ratio_cmp (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
#endif
#ifdef HAVE_BIGFLOAT
- case BIGFLOAT_T:
+ case LAZY_BIGFLOAT_T:
return bigfloat_cmp (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
#endif
+ case LAZY_MARKER_T:
+ {
+ Bytebpos ival1 = byte_marker_position (obj1);
+ Bytebpos ival2 = byte_marker_position (obj2);
+ return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
+ }
+
default: /* FLOAT_T */
{
double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2);
＠＠ -320,7 +327,19 ＠＠
if (FIXNUMP (obj1)) ival1 = XFIXNUM (obj1);
else if (CHARP (obj1)) ival1 = XCHAR (obj1);
- else if (MARKERP (obj1)) ival1 = marker_position (obj1);
+ else if (MARKERP (obj1))
+ {
+ /* Handle markers specially, since #'marker-position can be O(N): */
+ if (MARKERP (obj2)
+ && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer))
+ {
+ Bytebpos ival1 = byte_marker_position (obj1);
+ Bytebpos ival2 = byte_marker_position (obj2);
+ return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
+ }
+
+ ival1 = marker_position (obj1);
+ }
else goto arithcompare_float;
if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2);
＠＠ -365,9 +384,29 ＠＠
bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
{
#ifdef WITH_NUMBER_TYPES
- switch (promote_args (&obj1, &obj2))
+ switch (promote_args_lazy (&obj1, &obj2))
{
- case FIXNUM_T:
+ case LAZY_MARKER_T:
+ {
+ switch (opcode)
+ {
+ case Bmax:
+ return make_fixnum (marker_position
+ ((byte_marker_position (obj1)
+ < byte_marker_position (obj2)) ?
+ obj2 : obj1));
+ case Bmin:
+ return make_fixnum (marker_position
+ ((byte_marker_position (obj1)
+ > byte_marker_position (obj2)) ?
+ obj2 : obj1));
+ default:
+ obj1 = make_fixnum (marker_position (obj1));
+ obj2 = make_fixnum (marker_position (obj2));
+ /* FALLTHROUGH */
+ }
+ }
+ case LAZY_FIXNUM_T:
{
EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2);
switch (opcode)
＠＠ -395,7 +434,7 ＠＠
return make_integer (ival1);
}
#ifdef HAVE_BIGNUM
- case BIGNUM_T:
+ case LAZY_BIGNUM_T:
switch (opcode)
{
case Bplus:
＠＠ -426,7 +465,7 ＠＠
return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
#endif
#ifdef HAVE_RATIO
- case RATIO_T:
+ case LAZY_RATIO_T:
switch (opcode)
{
case Bplus:
＠＠ -453,7 +492,7 ＠＠
return make_ratio_rt (scratch_ratio);
#endif
#ifdef HAVE_BIGFLOAT
- case BIGFLOAT_T:
+ case LAZY_BIGFLOAT_T:
bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (obj1),
XBIGFLOAT_GET_PREC (obj2)));
switch (opcode)
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/data.c
--- a/src/data.c
+++ b/src/data.c
＠＠ -899,7 +899,7 ＠＠
#ifdef HAVE_BIGNUM
#define BIGNUM_CASE(op) \
- case BIGNUM_T: \
+ case LAZY_BIGNUM_T: \
if (!bignum_##op (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))) \
return Qnil; \
break;
＠＠ -909,7 +909,7 ＠＠
#ifdef HAVE_RATIO
#define RATIO_CASE(op) \
- case RATIO_T: \
+ case LAZY_RATIO_T: \
if (!ratio_##op (XRATIO_DATA (obj1), XRATIO_DATA (obj2))) \
return Qnil; \
break;
＠＠ -919,7 +919,7 ＠＠
#ifdef HAVE_BIGFLOAT
#define BIGFLOAT_CASE(op) \
- case BIGFLOAT_T: \
+ case LAZY_BIGFLOAT_T: \
if (!bigfloat_##op (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))) \
return Qnil; \
break;
＠＠ -936,24 +936,33 ＠＠
{ \
obj1 = args[i - 1]; \
obj2 = args[i]; \
- switch (promote_args (&obj1, &obj2)) \
+ switch (promote_args_lazy (&obj1, &obj2)) \
{ \
- case FIXNUM_T: \
- if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \
+ case LAZY_FIXNUM_T: \
+ if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \
return Qnil; \
break; \
BIGNUM_CASE (op) \
RATIO_CASE (op) \
- case FLOAT_T: \
+ case LAZY_FLOAT_T: \
if (!(XFLOAT_DATA (obj1) c_op XFLOAT_DATA (obj2))) \
return Qnil; \
break; \
BIGFLOAT_CASE (op) \
+ case LAZY_MARKER_T: \
+ if (!(byte_marker_position (obj1) c_op \
+ byte_marker_position (obj2))) \
+ return Qnil; \
+ break; \
} \
} \
return Qt; \
}
#else /* !WITH_NUMBER_TYPES */
+/* We don't convert markers lazily here, although we could. It's more
+ important that we do this lazily in bytecode, which is the case; see
+ bytecode_arithcompare().
+ */
#define ARITHCOMPARE_MANY(c_op,op) \
{ \
int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 src/number.h
--- a/src/number.h
+++ b/src/number.h
＠＠ -373,11 +373,42 ＠＠
EXFUN (Fcanonicalize_number, 1);
-enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T};
+#define NUMBER_TYPES(prefix) prefix##FIXNUM_T, prefix##BIGNUM_T, \
+ prefix##RATIO_T, prefix##FLOAT_T, prefix##BIGFLOAT_T
+
+enum number_type { NUMBER_TYPES() };
+enum lazy_number_type { NUMBER_TYPES(LAZY_), LAZY_MARKER_T };
+
+#undef NUMBER_TYPES
extern enum number_type get_number_type (Lisp_Object);
extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
+/* promote_args() *always* converts a marker argument to a fixnum.
+
+ Unfortunately, for a marker with byte position N, getting the (character)
+ marker position is O(N). Getting the character position isn't necessary
+ for bytecode_arithcompare() if two markers being compared are in the same
+ buffer, comparing the byte position is enough.
+
+ Similarly, min and max don't necessarily need to have their arguments
+ converted from markers, though we have always promised up to this point
+ that the result is a fixnum rather than a marker, and that's what we're
+ continuing to do. */
+
+DECLARE_INLINE_HEADER (
+enum lazy_number_type
+promote_args_lazy (Lisp_Object *obj1, Lisp_Object *obj2))
+{
+ if (MARKERP (*obj1) && MARKERP (*obj2) &&
+ XMARKER (*obj1)->buffer == XMARKER (*obj2)->buffer)
+ {
+ return LAZY_MARKER_T;
+ }
+
+ return (enum lazy_number_type) promote_args (obj1, obj2);
+}
+
#ifdef WITH_NUMBER_TYPES
DECLARE_INLINE_HEADER (
int
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
＠＠ -1,3 +1,9 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Test arithmetic comparisons with markers, check the type of the
+ returned values for #'min and #'max.
+
2013-09-15 Mats Lidell <matsl(a)xemacs.org>
* automated/files-tests.el: New file. Test new states in
diff -r 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el
+++ b/tests/automated/lisp-tests.el
＠＠ -3041,4 +3041,83 ＠＠
(macroexpand '(with-second-arguments)))))
(with-both-arguments (list))))
+;; Test arithmetic comparisons of markers and operations on markers. Most
+;; relevant with Mule, but also worth doing on non-Mule.
+(let ((character (if (featurep 'mule) (decode-char 'ucs #x20ac) ?\xff))
+ (translation (make-char-table 'generic))
+ markers fixnums)
+ (macrolet
+ ((Assert-arith-equivalences (markers context)
+ `(progn
+ (Assert (apply #'> markers)
+ ,(concat "checking #'> correct with long arguments list, "
+ context))
+ (Assert 0 ,context)
+ (Assert (apply #'< (reverse markers))
+ ,(concat "checking #'< correct with long arguments list, "
+ context))
+ (map-plist #'(lambda (object1 object2)
+ (Assert (> object1 object2)
+ ,(concat
+ "checking markers correctly ordered, >, "
+ context))
+ (Assert (< object2 object1)
+ ,(concat
+ "checking markers correctly ordered, <, "
+ context)))
+ markers)
+ ;; OK, so up to this point there has been no need for byte-char
+ ;; conversion. The following requires it, though:
+ (map-plist #'(lambda (object1 object2)
+ (Assert
+ (= (max object1 object2) object1)
+ ,(concat
+ "checking max correct, two markers, " context))
+ (Assert
+ (= (min object1 object2) object2)
+ ,(concat
+ "checking min, correct, two markers, " context))
+ ;; It is probably reasonable to change this design
+ ;; decision.
+ (Assert
+ (fixnump (max object1 object2))
+ ,(concat
+ "checking fixnum conversion as documented, max, "
+ context))
+ (Assert
+ (fixnump (min object1 object2))
+ ,(concat
+ "checking fixnum conversion as documented, min, "
+ context)))
+ markers))))
+ (with-temp-buffer
+ (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*"))
+ (loop for ii from 0 to 100
+ do (progn
+ (insert " " character " " character " " character " "
+ character "\n")
+ (insert character)
+ (push (copy-marker (1- (point)) t) markers)
+ (insert ?\x20)
+ (push (copy-marker (1- (point)) t) markers)))
+ (Assert-arith-equivalences markers "with Euro sign")
+ ;; Save the markers as fixnum character positions:
+ (setq fixnums (mapcar #'marker-position markers))
+ ;; Check that the equivalences work with the fixnums, while we
+ ;; have them:
+ (Assert-arith-equivalences fixnums "fixnums, with Euro sign")
+ ;; Now, transform the characters that may be problematic to ASCII,
+ ;; check our equivalences still hold.
+ (put-char-table character ?\x7f translation)
+ (translate-region (point-min) (point-max) translation)
+ ;; Sigh, restore the markers #### shouldn't the insertion and
+ ;; deletion code do this?!
+ (map nil #'set-marker markers fixnums)
+ (Assert-arith-equivalences markers "without Euro sign")
+ ;; Restore the problematic character.
+ (put-char-table ?\x7f character translation)
+ (translate-region (point-min) (point-max) translation)
+ (map nil #'set-marker markers fixnums)
+ (Assert-arith-equivalences markers "with Euro sign restored"))))
+
;;; end of lisp-tests.el
https://bitbucket.org/xemacs/xemacs/commits/f22989bb7632/
Changeset: f22989bb7632
User: kehoea
Date: 2013-12-15 11:38:19
Summary: Check (featurep 'font-mgr) before calling fontconfig functions, tests
tests/ChangeLog addition:
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/face-tests.el:
Only test fontconfig if the font-mgr feature is available, avoid
errors when it isn't.
Affected #: 2 files
diff -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 -r f22989bb76320d7d68b84212f765e77d01567b11 tests/ChangeLog
--- a/tests/ChangeLog
+++ b/tests/ChangeLog
＠＠ -1,3 +1,9 ＠＠
+2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/face-tests.el:
+ Only test fontconfig if the font-mgr feature is available, avoid
+ errors when it isn't.
+
2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 -r f22989bb76320d7d68b84212f765e77d01567b11 tests/automated/face-tests.el
--- a/tests/automated/face-tests.el
+++ b/tests/automated/face-tests.el
＠＠ -29,76 +29,74 ＠＠
;; Test fontconfig
-(let* ((test-name-parts
- '("Bitstream Vera Sans Mono-16"
- "familylang=en"
- "style=Roman"
- "stylelang=en"
- "fullname=Bitstream Vera Sans Mono"
- "fullnamelang=en"
- "slant=0"
- "weight=80"
- "width=100"
- "pixelsize=21.3174"
- "spacing=100"
- "foundry=bitstream"
- "antialias=True"
- "hintstyle=3"
- "hinting=True"
- "verticallayout=False"
- "autohint=False"
- "globaladvance=True"
- "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf"
- "index=0"
- "outline=True"
- "scalable=True"
- "dpi=95.9282"
- "rgba=0"
- "scale=1"
- "minspace=False"
- "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) "
- "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za"
- "fontversion=131072"
- "fontformat=TrueType"
- "embolden=False"
- "embeddedbitmap=True"
- "decorative=False"
- "lcdfilter=1"
- "namelang=en"
- "prgname=xemacs"
- "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d"
- "postscriptname=BitstreamVeraSansMono-Roman"))
- (test-name-degenerate "")
- (test-name-trivial (nth 0 test-name-parts))
- (test-name-short
- (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts)))
- (test-name-long (mapconcat #'identity
- (append (subseq test-name-parts 0 26)
- (subseq test-name-parts 27))
- ":"))
- (test-name-full (mapconcat #'identity test-name-parts ":"))
- )
- (labels ((try (fontname)
- (fc-name-unparse (fc-name-parse fontname)))
- (try-harder (fontname)
- (fc-name-unparse (fc-name-parse-harder fontname))))
- (Assert (string= test-name-degenerate (try test-name-degenerate)))
- (Assert (string= test-name-degenerate (try-harder test-name-degenerate)))
- (Assert (string= test-name-trivial (try test-name-trivial)))
- (Assert (string= test-name-trivial (try-harder test-name-trivial)))
- ;; Note when the `try' form fails, the `try-harder' form returns a
- ;; shorter name.
- (Check-Error 'invalid-argument
- (string= test-name-short (try test-name-short)))
- (Assert (string= test-name-trivial (try-harder test-name-short)))
- (Assert (string= test-name-long (try test-name-long)))
- (Assert (string= test-name-long (try-harder test-name-long)))
- ;; Note when the `try' form fails, the `try-harder' form returns a
- ;; shorter name.
- (Check-Error 'invalid-argument
- (string= test-name-full (try test-name-full)))
- (Assert (string= test-name-long (try-harder test-name-full)))
- ) ; labels
- ) ; let
+(when (featurep 'font-mgr)
+ (let* ((test-name-parts
+ '("Bitstream Vera Sans Mono-16"
+ "familylang=en"
+ "style=Roman"
+ "stylelang=en"
+ "fullname=Bitstream Vera Sans Mono"
+ "fullnamelang=en"
+ "slant=0"
+ "weight=80"
+ "width=100"
+ "pixelsize=21.3174"
+ "spacing=100"
+ "foundry=bitstream"
+ "antialias=True"
+ "hintstyle=3"
+ "hinting=True"
+ "verticallayout=False"
+ "autohint=False"
+ "globaladvance=True"
+ "file=/usr/X11/lib/X11/fonts/TTF/VeraMono.ttf"
+ "index=0"
+ "outline=True"
+ "scalable=True"
+ "dpi=95.9282"
+ "rgba=0"
+ "scale=1"
+ "minspace=False"
+ "charset= |>^1!|>^1!P0oWQ |>^1!|>^1!|>^1!!!!%#gfN8.!!B7%ggR6OF3y?4!!K?& !!!)$ 9;*f! !!!.% !!!)$!!!!# !!#0GM>RAd#y#fx !!!W5 !!#3H !!!!& !!#6I<UKaX!!!?+!!!%#!!!!X !!#AL !!!1& !!+u{!!!!) "
+ "lang=aa|ay|bi|br|ch|co|da|de|en|es|et|eu|fi|fj|fo|fr|fur|fy|gd|gl|gv|ho|ia|id|ie|io|is|it|lb|mg|nb|nds|nl|nn|no|nr|nso|oc|om|pt|rm|sma|smj|so|sq|ss|st|sv|sw|tl|tn|tr|ts|uz|vo|vot|wa|xh|yap|zu|an|crh|fil|ht|jv|kj|ku-tr|kwm|li|ms|ng|pap-an|pap-aw|rn|rw|sc|sg|sn|su|za"
+ "fontversion=131072"
+ "fontformat=TrueType"
+ "embolden=False"
+ "embeddedbitmap=True"
+ "decorative=False"
+ "lcdfilter=1"
+ "namelang=en"
+ "prgname=xemacs"
+ "hash=sha256\\:da4281dc7db17a3dfce64a62ced92875c5895340055ec8ba24a3914eb97b349d"
+ "postscriptname=BitstreamVeraSansMono-Roman"))
+ (test-name-degenerate "")
+ (test-name-trivial (nth 0 test-name-parts))
+ (test-name-short
+ (concat (nth 0 test-name-parts) ":" (nth 26 test-name-parts)))
+ (test-name-long (mapconcat #'identity
+ (append (subseq test-name-parts 0 26)
+ (subseq test-name-parts 27))
+ ":"))
+ (test-name-full (mapconcat #'identity test-name-parts ":")))
+ (labels ((try (fontname)
+ (fc-name-unparse (fc-name-parse fontname)))
+ (try-harder (fontname)
+ (fc-name-unparse (fc-name-parse-harder fontname))))
+ (Assert (string= test-name-degenerate (try test-name-degenerate)))
+ (Assert (string= test-name-degenerate (try-harder test-name-degenerate)))
+ (Assert (string= test-name-trivial (try test-name-trivial)))
+ (Assert (string= test-name-trivial (try-harder test-name-trivial)))
+ ;; Note when the `try' form fails, the `try-harder' form returns a
+ ;; shorter name.
+ (Check-Error 'invalid-argument
+ (string= test-name-short (try test-name-short)))
+ (Assert (string= test-name-trivial (try-harder test-name-short)))
+ (Assert (string= test-name-long (try test-name-long)))
+ (Assert (string= test-name-long (try-harder test-name-long)))
+ ;; Note when the `try' form fails, the `try-harder' form returns a
+ ;; shorter name.
+ (Check-Error 'invalid-argument
+ (string= test-name-full (try test-name-full)))
+ (Assert (string= test-name-long (try-harder test-name-full))))))
;;; end face-tests.el
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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
Autoload `compilation-error-regexp-alist-alist'
11 years
Michael Sperber
Michael Sperber
Some packages refer to `compilation-error-regexp-alist-alist', and get
sad when it's not autloaded.
I'll push on Saturday if nobody objects.
2013-12-12 Michael Sperber <mike(a)xemacs.org>
* compile.el (compilation-error-regexp-alist-alist): Make it autoloaded.
--
Regards,
Mike
diff --git a/compile.el b/compile.el
--- a/compile.el
+++ b/compile.el
＠＠ -153,6 +153,7 ＠＠
nil))
compilation-error-regexp-alist-alist))))
+;;;###autoload
(defvar compilation-error-regexp-alist-alist
'(
;; NOTE! See also grep-regexp-alist, below.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
commit/xemacs-base: sperber: Autoload `compilation-error-regexp-alist-alist'.
11 years
Bitbucket
Bitbucket
1 new commit in xemacs-base:
https://bitbucket.org/xemacs/xemacs-base/commits/db82ab2d46e0/
Changeset: db82ab2d46e0
User: sperber
Date: 2013-12-14 14:32:57
Summary: Autoload `compilation-error-regexp-alist-alist'.
2013-12-12 Michael Sperber <mike(a)xemacs.org>
* compile.el (compilation-error-regexp-alist-alist): Make it autoloaded.
Affected #: 2 files
diff -r 3ce73a39bc7ac7cd1db105bf61c1e88582a55138 -r db82ab2d46e07fcadc37e5445deeec5323c25a07 ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
＠＠ -1,3 +1,7 ＠＠
+2013-12-12 Michael Sperber <mike(a)xemacs.org>
+
+ * compile.el (compilation-error-regexp-alist-alist): Make it autoloaded.
+
2013-12-14 Mats Lidell <matsl(a)xemacs.org>
* Makefile (ELCS): Add rcfiles.elc so it is built and installed.
diff -r 3ce73a39bc7ac7cd1db105bf61c1e88582a55138 -r db82ab2d46e07fcadc37e5445deeec5323c25a07 compile.el
--- a/compile.el
+++ b/compile.el
＠＠ -153,6 +153,7 ＠＠
nil))
compilation-error-regexp-alist-alist))))
+;;;###autoload
(defvar compilation-error-regexp-alist-alist
'(
;; NOTE! See also grep-regexp-alist, below.
Repository URL: https://bitbucket.org/xemacs/xemacs-base/
--
This is a commit notification from bitbucket.org. You are receiving
this because you have the service enabled, addressing the recipient of
this email.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments