Mercurial > emacs
comparison src/xdisp.c @ 30216:394c884dc496
(eval_form): GCPRO argument sexpr.
(call_function): New function.
(handle_single_display_prop): Use call_function and FUNCTIONP
instead of checking whether if font_height is a symbol and
using eval_form.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Fri, 14 Jul 2000 13:56:56 +0000 |
parents | bade676e0950 |
children | c56062542bae |
comparison
equal
deleted
inserted
replaced
30215:4e401f4a55aa | 30216:394c884dc496 |
---|---|
1047 | 1047 |
1048 /*********************************************************************** | 1048 /*********************************************************************** |
1049 Lisp form evaluation | 1049 Lisp form evaluation |
1050 ***********************************************************************/ | 1050 ***********************************************************************/ |
1051 | 1051 |
1052 /* Error handler for eval_form. */ | 1052 /* Error handler for eval_form and call_function. */ |
1053 | 1053 |
1054 static Lisp_Object | 1054 static Lisp_Object |
1055 eval_handler (arg) | 1055 eval_handler (arg) |
1056 Lisp_Object arg; | 1056 Lisp_Object arg; |
1057 { | 1057 { |
1065 Lisp_Object | 1065 Lisp_Object |
1066 eval_form (sexpr) | 1066 eval_form (sexpr) |
1067 Lisp_Object sexpr; | 1067 Lisp_Object sexpr; |
1068 { | 1068 { |
1069 int count = specpdl_ptr - specpdl; | 1069 int count = specpdl_ptr - specpdl; |
1070 struct gcpro gcpro1; | |
1070 Lisp_Object val; | 1071 Lisp_Object val; |
1072 | |
1073 GCPRO1 (sexpr); | |
1071 specbind (Qinhibit_redisplay, Qt); | 1074 specbind (Qinhibit_redisplay, Qt); |
1072 val = internal_condition_case_1 (Feval, sexpr, Qerror, eval_handler); | 1075 val = internal_condition_case_1 (Feval, sexpr, Qerror, eval_handler); |
1076 UNGCPRO; | |
1077 return unbind_to (count, val); | |
1078 } | |
1079 | |
1080 | |
1081 /* Call function ARGS[0] with arguments ARGS[1] to ARGS[NARGS - 1]. | |
1082 Return the result, or nil if something went wrong. */ | |
1083 | |
1084 Lisp_Object | |
1085 call_function (nargs, args) | |
1086 int nargs; | |
1087 Lisp_Object *args; | |
1088 { | |
1089 int count = specpdl_ptr - specpdl; | |
1090 Lisp_Object val; | |
1091 struct gcpro gcpro1; | |
1092 | |
1093 GCPRO1 (args[0]); | |
1094 gcpro1.nvars = nargs; | |
1095 specbind (Qinhibit_redisplay, Qt); | |
1096 val = internal_condition_case_2 (Ffuncall, nargs, args, Qerror, | |
1097 eval_handler); | |
1098 UNGCPRO; | |
1073 return unbind_to (count, val); | 1099 return unbind_to (count, val); |
1074 } | 1100 } |
1075 | 1101 |
1076 | 1102 |
1077 | 1103 |
2371 int steps = XINT (XCAR (XCDR (it->font_height))); | 2397 int steps = XINT (XCAR (XCDR (it->font_height))); |
2372 if (EQ (XCAR (it->font_height), Qplus)) | 2398 if (EQ (XCAR (it->font_height), Qplus)) |
2373 steps = - steps; | 2399 steps = - steps; |
2374 it->face_id = smaller_face (it->f, it->face_id, steps); | 2400 it->face_id = smaller_face (it->f, it->face_id, steps); |
2375 } | 2401 } |
2376 else if (SYMBOLP (it->font_height)) | 2402 else if (FUNCTIONP (it->font_height)) |
2377 { | 2403 { |
2378 /* Call function with current height as argument. | 2404 /* Call function with current height as argument. |
2379 Value is the new height. */ | 2405 Value is the new height. */ |
2380 Lisp_Object form, height; | 2406 Lisp_Object args[2], height; |
2381 struct gcpro gcpro1; | |
2382 | 2407 |
2383 height = face->lface[LFACE_HEIGHT_INDEX]; | 2408 args[0] = it->font_height; |
2384 form = Fcons (it->font_height, Fcons (height, Qnil)); | 2409 args[1] = face->lface[LFACE_HEIGHT_INDEX]; |
2385 GCPRO1 (form); | 2410 height = call_function (2, args); |
2386 height = eval_form (form); | 2411 |
2387 if (NUMBERP (height)) | 2412 if (NUMBERP (height)) |
2388 new_height = XFLOATINT (height); | 2413 new_height = XFLOATINT (height); |
2389 UNGCPRO; | |
2390 } | 2414 } |
2391 else if (NUMBERP (it->font_height)) | 2415 else if (NUMBERP (it->font_height)) |
2392 { | 2416 { |
2393 /* Value is a multiple of the canonical char height. */ | 2417 /* Value is a multiple of the canonical char height. */ |
2394 struct face *face; | 2418 struct face *face; |